package Local::DBIx::Simple::Result; =BEGIN # README ================================================================================ * new methods row(), column(), value() * patched hash() and array() to auto_inflate dates and return a DBIx::Simple default scalar (href), or in list context using wantarray() * set $Local::DBIx::Simple::NO_AUTO_DATE_INFLATION=1 to suppress date(time) auto-inflation to DateTime object * set $Local::DBIx::Simple::Result::STRINGIFY_DATETIME=1 to return $o->datetime ================================================================================ =cut BEGIN { # fix for DBIx::Simple::Result being in same file as DBIx::Simple & not in @INC: require DBIx::Simple; $INC{'DBIx/Simple/Result.pm'} = $INC{'DBIx/Simple.pm'}; } use parent 'DBIx::Simple::Result'; use Scalar::Util qw(looks_like_number); use Data::Printer alias => 'ddp'; use DateTime::Format::MySQL; use Data::Dumper; our $NO_AUTO_DATE_INFLATION; # to suppress auto-date-inflation in caller class our $STRINGIFY_DATETIME; # to return datetime string rather that dt object # returns hash or hashref (DBIx::Simple only returns hashref): sub hash { # warn $NO_AUTO_DATE_INFLATION; # set in calling class if required my $self = shift; my $href = $self->SUPER::hash(@_); # p $href; $self->_autoinflate_dates($href); return wantarray ? %$href : $href; } # returns array or arrayref (DBIx::Simple only returns arrayref): sub array { my $self = shift; my $aref = $self->SUPER::array(@_); $self->_autoinflate_dates($aref); return wantarray ? @$aref : $aref; } # ==== provide some DBIx::Simple::Result methods as more obvious names ========= # single value: sub value { my $val = shift->SUPER::list(@_); return $val } # list in scalar context # more obvious name for 'list': sub row { shift->SUPER::list(@_) } # more obvious name for 'flat' (can't use 'list'): sub column { shift->SUPER::flat(@_) } # ============================================================================== sub _autoinflate_dates { #------------------------------------------------------------------------------- return 0 if $NO_AUTO_DATE_INFLATION; #------------------------------------------------------------------------------- my ($self, $data) = @_; # ddp $self; ddp $data; my $re = qr!\d{4}-\d{2}-\d{2}(\s\d{2}:\d{2}:\d{2})?!; # uses date(time) regex to determine whether value is a date (ie pattern not col def): my $to_datetime = sub { my $val = shift || return; # ddp $val; if ( my ($date) = $val =~ m!\A($re)\Z! ) { $val = length $date > 10 # ie date + time ? DateTime::Format::MySQL->parse_datetime($date) : DateTime::Format::MySQL->parse_date($date); $val = sprintf "%s", $val if $STRINGIFY_DATETIME; # quoting forces string } # warn Dumper $val; ddp stringifies DT object return $val; }; =begin # alternative method using column data-type (doesn't work for Reporter): my $col_types = $self->col_types; # ddp $col_types; my $to_datetime = sub { my $val = shift || return; # ddp $val; return lc $col_types->{$val} eq 'timestamp' ? DateTime::Format::MySQL->parse_timestamp($val) : lc $col_types->{$val} eq 'datetime' ? DateTime::Format::MySQL->parse_datetime($val) : lc $col_types->{$val} eq 'date' ? DateTime::Format::MySQL->parse_date($val) : $val; }; =cut if ( ref $data eq 'HASH' ) { $data->{$_} = &$to_datetime($data->{$_}) for keys %$data; # ddp $data; } elsif ( ref $data eq 'ARRAY' ) { # ddp $data; $_ = &$to_datetime($_) for @$data; } else { # assume single value (so can't handle true array) $data = &$to_datetime($data); # TODO: adapt for eg list() in array context } # ddp $data; return $data; } sub col_types { my $self = shift; # decode for MySQL column TYPE (integers): my %type_map = ( 1 => 'enum', 4 => 'integer', 9 => 'date', 11 => 'datetime', 12 => 'varchar', ); my @names = @{ $self->attr('NAME') }; ddp @names; my @types = @{ $self->attr('TYPE') }; ddp @types; my %h; # sqlite returns types as VARCHAR, DATE, etc, MySQL returns integers: @h{@names} = ( grep looks_like_number($_), @types ) ? map $type_map{$_}, @types : @types; ddp %h; return \%h; } 1;