• Files
• Commits
• Log
• Graph
• Stats

package Local::DBIx::Lite::ResultSet;

# provides hash, hashes, array, arrays, map, map_hashes, list, flat to DBIx::Lite::ResultSet
# used by Local::DBIxLite

use parent 'DBIx::Lite::ResultSet';

use Modern::Perl;
use Data::Printer alias => 'ddp';
use Data::Dumper;

# returns single hash or hashref:
sub hash {
    my $ref = $_[0]->single->hashref; # ddp $ref;
	return wantarray ? %$ref : $ref;
}

# returns array(ref):
sub array {
   my $self = shift; # DBIx::Lite::ResultSet object

    my $cols = $self->column_names; # _debug($cols);
    my $data = $self->single->hashref; # _debug($ref);
    
    my @vals = @{$data}{@$cols}; # _debug(@vals);
    return wantarray ? @vals : \@vals; # DBIx::Simple only returns arrayref
}

# returns array (or ref to array) of arrayrefs:
sub arrays {
    my $self = shift; # DBIx::Lite::ResultSet object
    
    my $cols = $self->column_names; # _debug($cols);
    my @all  = $self->all; # array of DBIx::Lite::Row objects
    
    my @data = map {
        [ @{ $_->hashref }{ @$cols } ];
    } @all;
    return wantarray ? @data : \@data;
}

# returns array (or ref to array) of hashrefs:
sub hashes {
    my @all = $_[0]->all; # array of DBIx::Lite::Row objects

	my @data = map $_->hashref, @all; # _debug(@data);
    return wantarray ? @data : \@data;
}

# returns single table col as array or arrayref
sub flat {
    my $self = shift; # _debug($rs); # DBIx::Lite::ResultSet object

    my $col = $self->{select}->[0]; # _debug($col);
    my @all = $self->all; # array of DBIx::Lite::Row objects
 
    my @data = map $_->get($col), @all;
    return wantarray ? @data : \@data;
}

# intended as single row query, return list in array context or last value for scalar:
sub list {
    my @data = $_[0]->array; # _debug(@data);
    return wantarray ? @data : $data[-1];
}

# returns hash(ref) map of 2 cols:
sub map {
    my $self = shift; # DBIx::Lite::ResultSet object
    
    my $cols = $self->{select};    
    my @all  = $self->all; # array of DBIx::Lite::Row objects
    
    my %map = map {
        @{ $_->hashref }{ @$cols };
    } @all; # _debug(%map);
    return wantarray ? %map : \%map;
}

# adapted from DBIx::Simple::map_hashes:
sub map_hashes {
    my ($self, $keyname) = @_; # ddp $keyname;
    Carp::croak('Key column name not optional') unless defined $keyname;

    my @rows = $self->hashes; # _debug(@rows); # array of hashrefs
    Carp::croak(qq!Key column name "$keyname" not found!)
        unless grep { defined $_->{$keyname} } @rows; # defined in case zeros
    
    # create array of $keyname vals & delete corresponding key/val from each href: 
    my @keys = map { delete $_->{$keyname} } @rows; # ddp @keys;    
    
    my %data; # hash of @rows hrefs, indexed by @keys:
    @data{@keys} = @rows; # _debug(%data);
    return wantarray ? %data : \%data;
}

# adapted from DBIx::Simple::map_arrays:
sub map_arrays {
    my ($self, $keyindex) = @_; # p $keyindex; # position in array to create hash key
    Carp::croak('Key index value not optional') unless defined $keyindex;
    
    # $keyindex += 0; # will croak if not number, and necessary if $keyindex defined?
    
    my @rows = $self->arrays; # ddp @rows;
    Carp::croak(qq!Key index value "$keyindex" not found!)
        unless grep { defined $_->[$keyindex] } @rows; # defined in case zeros

    my @keys = map { splice @$_, $keyindex, 1 } @rows;
    
    my %data;
    @data{@keys} = @rows;
    return wantarray ? %data : \%data;
}

# modifies @_ directly; must supply separate $var(s), not @list 
# eg ->into( my($a,$b) ): 
sub into { # warn Dumper @_;
	my ($self, @vars) = @_;

    my @data = $self->array; # _debug(@data);

	{ # match DBIx::Simple bind_cols error message:
		my $x = scalar @vars;
		my $y = scalar @data;
		die 'into() method called with '.$x.' values but '.$y.' are needed' 
			if $x != $y;
	}
	
    # return \@data; # how DBIx::Simple returns - doesn't work here
    my $i = 1; # array index counter, starts at 1 to preserve $_[0]
    $_[$i++] = $_ for @data;
}

sub _debug { ddp @_ }

1;