File Coverage

blib/lib/Acrux/DBI/Res.pm

Criterion	Covered	Total	%
statement	18	64	28.1
branch	0	18	0.0
condition	0	4	0.0
subroutine	6	27	22.2
pod	20	20	100.0
total	44	133	33.0

package Acrux::DBI::Res;
use strict;
use utf8;

=encoding utf8

=head1 NAME

Acrux::DBI::Res - Results of your database queries

=head1 SYNOPSIS

    use Acrux::DBI::Res;

    my $res = Acrux::DBI::Res->new(sth => $sth);

    $res->collection->map(sub { $_->{foo} })->shuffle->join("\n")->say;

=head1 DESCRIPTION

Class to works with results of your database queries

=head2 new

    my $res = Acrux::DBI::Res->new( sth => $sth, dbi => $dbi );

Construct a new Acrux::DBI::Res object

=head1 ATTRIBUTES

This method implements the following attributes

=head2 dbi

    my $dbi = $res->dbi;
    $res = $res->dbi(Acrux::DBI->new);

L object these results belong to.

=head2 sth

    my $sth  = $res->sth;
    $res = $res->sth($sth);

L statement handle results are fetched from

=head1 METHODS

This class implements the following methods

=head2 affected_rows

    my $affected = $res->affected_rows;

Number of affected rows by the query. For example

    UPDATE testtable SET id = 1 WHERE id = 1

would return 1

=head2 array

    my $array = $res->array;

Fetch one row from L and return it as an array reference

    # [
    #   'foo', 'bar', 'baz'
    # ]

See also L

=head2 arrays

    my $arrays = $res->arrays;

Fetch all rows from L and return them as an array of arrays

    # [
    #   [ 'foo', 'bar', 'baz' ],
    #   [ 'qux', 'quux' ],
    # ]

See also L

=head2 collection

    my $collection = $res->collection;

Fetch all rows from L and return them as a L object containing hash references

    # Process all rows at once
    say $res->collection->reduce(sub { $a + $b->{money} }, 0);

=head2 collection_list

    my $collection_list = $res->collection_list;

Fetch all rows from L and return them as a L object containing array references

    # Process all rows at once
    say $res->collection_list->reduce(sub { $a + $b->[3] }, 0);

=head2 columns

    my $columns = $res->columns;

Return column names as an array reference

    # Names of all columns
    say for @{$res->columns};

=head2 err

    my $err = $res->err;

Error code received

=head2 errstr

    my $errstr = $res->errstr;

Error message received

=head2 finish

    $res->finish;

Indicate that you are finished with L and will not be fetching all the remaining rows

=head2 hash

    my $hash = $res->hash;

Fetch one row from L and return it as a hash reference

    # {
    #   'foo' => 1,
    #   'bar' => 'one',
    # }

See also L

=head2 hashed_by

    my $hash = $res->hashed_by( $key_field );
    my $hash = $res->hashed_by( 'id' );

This method returns a reference to a hash containing a key for each distinct
value of the C<$key_field> column that was fetched.
For each key the corresponding value is a reference to a hash containing
all the selected columns and their values, as returned by C

For example:

    my $hash = $res->hashed_by( 'id' );

    # {
    #   1 => {
    #      'id'   => 1,
    #      'name' => 'foo'
    #   },
    #   2 => {
    #      'id'   => 2,
    #      'name' => 'bar'
    #   }
    # }

See L for details

See also L

=head2 hashes

    my $hashes = $res->hashes;

Fetch all rows from L and return them as an array containing hash references

    # [
    #   {
    #      'id'   => 1,
    #      'name' => 'foo'
    #   },
    #   {
    #      'id'   => 2,
    #      'name' => 'bar'
    #   }
    # ]

=head2 last_insert_id

    my $last_id = $res->last_insert_id;

That value of C column if executed query was C in a table with
C column

=head2 more_results

    do {
      my $columns = $res->columns;
      my $arrays = $res->arrays;
    } while ($res->more_results);

Handle multiple results

=head2 rows

    my $num = $res->rows;

Number of rows

=head2 state

    my $state = $res->state;

Error state received

=head2 text

    my $text = $res->text;

Fetch all rows from L and turn them into a table with L.

=head1 HISTORY

See C file

=head1 TO DO

See C file

=head1 SEE ALSO

L, L, L, L, L

=head1 AUTHOR

Serż Minus (Sergey Lepenkov) L [e-mail]

=head1 COPYRIGHT

Copyright (C) 1998-2026 D&D Corporation

=head1 LICENSE

This program is distributed under the terms of the Artistic License Version 2.0

See the C file or L for details

=cut

use Carp qw/croak/;
use Mojo::Collection;
use Mojo::JSON qw(from_json);
use Mojo::Util qw(tablify);

sub new {
    my $class = shift;
    my $args = scalar(@_) ? scalar(@_) > 1 ? {@_} : {%{$_[0]}} : {};
    my $sth = $args->{sth};
       croak 'Invalid STH' unless ref($sth);
    my $self  = bless {
            sth     => $sth,
            dbi     => undef,
            driver  => '',
            affected_rows => $args->{affected_rows} || 0,
        }, $class;
    $self->dbi($args->{dbi});
    return $self;
}

sub sth {
    my $self = shift;
    if (scalar(@_) >= 1) {
        $self->{sth} = shift;
        return $self;
    }
    return $self->{sth};
}
sub dbi {
    my $self = shift;
    if (scalar(@_) >= 1) {
        my $dbi = $self->{dbi} = shift;
        $self->{driver} = $dbi ? ($dbi->dbh->{Driver}{Name} || '') : '';
        return $self;
    }
    return $self->{dbi};
}
sub state { shift->sth->state }
sub err { shift->sth->err }
sub errstr { shift->sth->errstr }
sub finish { shift->sth->finish }

# Main Accessors
sub array { return shift->sth->fetchrow_arrayref() } # See CTK::DBI::record
sub arrays { return shift->sth->fetchall_arrayref() } # See CTK::DBI::table
sub collection_list { return Mojo::Collection->new(shift->sth->fetchall_arrayref()) }
sub columns { return shift->sth->{NAME} }
sub hash { return shift->sth->fetchrow_hashref() } # See CTK::DBI::recordh
sub hashes { return shift->sth->fetchall_arrayref({}) }
sub collection { return Mojo::Collection->new(@{(shift->sth->fetchall_arrayref({}))}) }
sub rows { shift->sth->rows }
sub text { tablify shift->arrays }
sub affected_rows { shift->{affected_rows} }
sub more_results { shift->sth->more_results }
sub last_insert_id {
    my $self = shift;
    return $self->sth->last_insert_id() if $self->sth->can('last_insert_id');
    my $liid = sprintf('%s_insertid', $self->{driver});
    return $self->sth->{$liid};
}
sub hashed_by { # See CTK::DBI::tableh
    my $self = shift;
    my $key_field = shift; # See keys (http://search.cpan.org/~timb/DBI-1.607/DBI.pm#fetchall_hashref)
    return unless defined($key_field);
    return $self->sth->fetchall_hashref($key_field)
}

sub DESTROY {
    my $self = shift;
    return unless my $sth = $self->{sth};
    $sth->finish;
}

1;

__END__