• Files
• Commits
• Log
• Graph
• Stats

package Local::DBIx::Simple::Result;

# new methods row(), column(), value()
# patched hash() and array() to auto_inflate dates and return in DBIx::Simple
# default scalar (href), or in list context using wantarray()

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 DateTime::Format::MySQL;
use Data::Printer alias => 'ddp';
use Data::Dumper;

our $NO_AUTO_DATE_INFLATION; # to suppress auto-date-inflation in caller class

# 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) unless $NO_AUTO_DATE_INFLATION;
    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) unless $NO_AUTO_DATE_INFLATION;
    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 {
    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);
        } # 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
	}
    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;