view release on metacpan or  search on metacpan

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

# *************************************************************************
# Copyright (c) 2014-2017, SUSE LLC
#
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
# 1. Redistributions of source code must retain the above copyright notice,
# this list of conditions and the following disclaimer.
#
# 2. Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# 3. Neither the name of SUSE LLC nor the names of its contributors may be
# used to endorse or promote products derived from this software without
# specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
# *************************************************************************

package App::Dochazka::REST::Model::Shared;

use 5.012;
use strict;
use warnings;

use App::CELL qw( $CELL $log $meta $site );
use Data::Dumper;
use JSON;
use Params::Validate qw( :all );
use Try::Tiny;




=head1 NAME

App::Dochazka::REST::Model::Shared - functions shared by several modules within
the data model




=head1 SYNOPSIS

    use App::Dochazka::REST::Model::Shared;

    ...




=head1 EXPORTS

=cut 

use Exporter qw( import );
our @EXPORT_OK = qw( 
    canonicalize_date
    canonicalize_ts
    canonicalize_tsrange
    cud 
    cud_generic
    decode_schedule_json 
    get_history
    load 
    load_multiple 
    noof 
    priv_by_eid 
    schedule_by_eid 
    select_single 
    select_set_of_single_scalar_rows
    split_tsrange
    timestamp_delta_minus
    timestamp_delta_plus
    tsrange_intersection
    tsrange_equal
);




=head1 FUNCTIONS


=head2 canonicalize_date

Given a string that PostgreSQL might recognize as a date, pass it to
the database via the SQL statement:

    SELECT CAST( ? AS date )

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

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

    my ( $t ) = validate_pos( @_, { type => SCALAR } );
    my $pkg = (caller)[0];

    return sub {
        my ( $conn, $s_key ) = @_;
        require Try::Tiny;
        my $routine = "load_by_$t";
        my ( $status, $txt );
        $log->debug( "Entered $t" . "_exists with search key $s_key" );
        try {
            no strict 'refs';
            $status = $pkg->$routine( $conn, $s_key );
        } catch {
            $txt = "Function " . $pkg . "::test_exists was generated with argument $t, " .
                "so it tried to call $routine, resulting in exception $_";
            $status = $CELL->status_crit( $txt );
        };
        if ( ! defined( $status ) or $status->level eq 'CRIT' ) {
            die $txt;
        }
        #$log->debug( "Status is " . Dumper( $status ) );
        return $status->payload if $status->ok;
        return;
    }
}


=head2 noof

Given a L<DBIx::Connector> object and the name of a data model table, returns
the total number of records in the table.

    activities employees intervals locks privhistory schedhistory
    schedintvls schedules tempintvls

On failure, returns undef.

=cut

sub noof {
    my ( $conn, $table ) = validate_pos( @_, 
        { isa => 'DBIx::Connector' },
        { type => SCALAR } 
    );

    return unless grep { $table eq $_; } qw( activities employees intervals locks
            privhistory schedhistory schedintvls schedules tempintvls );

    my $count;
    try {
        $conn->run( fixup => sub {
            ( $count ) = $_->selectrow_array( "SELECT count(*) FROM $table" );
        } );
    } catch {
        $CELL->status_crit( 'DOCHAZKA_DBI_ERR', args => [ $_ ] );
    };
    return $count;
}


=head2 priv_by_eid

Given an EID, and, optionally, a timestamp, returns the employee's priv
level as of that timestamp, or as of "now" if no timestamp was given. The
priv level will default to 'passerby' if it can't be determined from the
database.