view release on metacpan or  search on metacpan

lib/App/Dochazka/REST/Model/Shared.pm  view on Meta::CPAN

    die "AAAAAAAAAAAHHHHH! Engulfed by the abyss" unless $sk and $sql and $tsr;

    $result->{'history'} = [];
    try {
        $conn->run( fixup => sub {
            my $sth = $_->prepare( $sql );
            $sth->execute( $sk, $tsr );
            while( defined( my $tmpres = $sth->fetchrow_hashref() ) ) {
                push @{ $result->{'history'} }, $tmpres;
            }
        } );
    } catch {
        $status = $CELL->status_err( 'DOCHAZKA_DBI_ERR', args => [ $_ ] );
    };
    return $status if defined $status;

    my $counter = scalar @{ $result->{'history'} };
    return ( $counter ) 
        ? $CELL->status_ok( 'DISPATCH_RECORDS_FOUND', 
            args => [ $counter ], payload => $result, count => $counter ) 
        : $CELL->status_notice( 'DISPATCH_NO_RECORDS_FOUND', 
            payload => $result, count => $counter );
}


=head2 load

Load a database record into an object based on an SQL statement and a set of
search keys. The search key must be an exact match: this function returns only
1 or 0 records.  Call, e.g., like this:

    my $status = load( 
        conn => $conn,
        class => __PACKAGE__, 
        sql => $site->DOCHAZKA_SQL_SOME_STATEMENT,
        keys => [ 44 ]
    ); 

The status object will be one of the following:

=over

=item * 1 record found

Level C<OK>, code C<DISPATCH_RECORDS_FOUND>, payload: object of type 'class'

=item * 0 records found

Level C<NOTICE>, code C<DISPATCH_NO_RECORDS_FOUND>, payload: none

=item * Database error

Level C<ERR>, code C<DOCHAZKA_DBI_ERR>, text: error message, payload: none

=back

=cut

sub load {
    # get and verify arguments
    my %ARGS = validate( @_, { 
        conn => { isa => 'DBIx::Connector' },
        class => { type => SCALAR }, 
        sql => { type => SCALAR }, 
        keys => { type => ARRAYREF }, 
    } );

    # consult the database; N.B. - select may only return a single record
    my ( $hr, $status );
    try {
        $ARGS{'conn'}->run( fixup => sub {
            $hr = $_->selectrow_hashref( $ARGS{'sql'}, undef, @{ $ARGS{'keys'} } );
        } );
    } catch {
        $status = $CELL->status_err( 'DOCHAZKA_DBI_ERR', args => [ $_ ] );
    };

    # report the result
    return $status if $status;
    return $CELL->status_ok( 'DISPATCH_RECORDS_FOUND', args => [ '1' ],
        payload => $ARGS{'class'}->spawn( %$hr ), count => 1 ) if defined $hr;
    return $CELL->status_notice( 'DISPATCH_NO_RECORDS_FOUND', count => 0 );
}


=head2 load_multiple

Load multiple database records based on an SQL statement and a set of search
keys. Example:

    my $status = load_multiple( 
        conn => $conn,
        class => __PACKAGE__, 
        sql => $site->DOCHAZKA_SQL_SOME_STATEMENT,
        keys => [ 'rom%' ] 
    ); 

The return value will be a status object, the payload of which will be an
arrayref containing a set of objects. The objects are constructed by calling
$ARGS{'class'}->spawn

For convenience, a 'count' property will be included in the status object.

=cut

sub load_multiple {
    # get and verify arguments
    my %ARGS = validate( @_, { 
        conn => { isa => 'DBIx::Connector' },
        class => { type => SCALAR }, 
        sql => { type => SCALAR }, 
        keys => { type => ARRAYREF }, 
    } );
    $log->debug( "Entering " . __PACKAGE__ . "::load_multiple" );

    my $status;
    my $results = [];
    try {
        $ARGS{'conn'}->run( fixup => sub {
            my $sth = $_->prepare( $ARGS{'sql'} );
            my $bc = 0;
            map {
                $bc += 1;
                $sth->bind_param( $bc, $_ || undef );
            } @{ $ARGS{'keys'} };
            $sth->execute();
            # assuming they are objects, spawn them and push them onto @results
            while( defined( my $tmpres = $sth->fetchrow_hashref() ) ) {
                push @$results, $ARGS{'class'}->spawn( %$tmpres );
            }
        } );
    } catch {
        $status = $CELL->status_err( 'DOCHAZKA_DBI_ERR', args => [ $_ ] );
    };
    return $status if defined $status;

    my $counter = scalar @$results;
    $status = ( $counter )
        ? $CELL->status_ok( 'DISPATCH_RECORDS_FOUND', 
            args => [ $counter ], payload => $results, count => $counter, keys => $ARGS{'keys'} )
        : $CELL->status_notice( 'DISPATCH_NO_RECORDS_FOUND',
            payload => $results, count => $counter );
    #$log->debug( Dumper $status );
    return $status;
}


=head2 make_test_exists

Returns coderef for a function, 'test_exists', that performs a simple
true/false check for existence of a record matching a scalar search key.  The
record must be an exact match (no wildcards).

Takes one argument: a type string C<$t> which is concatenated with the string
'load_by_' to arrive at the name of the function to be called to execute the
search.

The returned function takes a single argument: the search key (a scalar value).
If a record matching the search key is found, the corresponding object
(i.e. a true value) is returned. If such a record does not exist, 'undef' (a
false value) is returned. If there is a DBI error, the error text is logged
and undef is returned.

=cut

sub make_test_exists {