App-Dochazka-REST

 view release on metacpan or  search on metacpan

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

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 );

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

database.

=cut

sub priv_by_eid {
    my ( $conn, $eid, $ts ) = validate_pos( @_, 
        { isa => 'DBIx::Connector' },
        { type => SCALAR },
        { type => SCALAR|UNDEF, optional => 1 } 
    );
    #$log->debug( "priv_by_eid: EID is " . (defined( $eid ) ? $eid : 'undef') . " - called from " . (caller)[1] . " line " . (caller)[2] );
    return _st_by_eid( $conn, 'priv', $eid, $ts );
}


=head2 schedule_by_eid

Given an EID, and, optionally, a timestamp, returns the SID of the employee's
schedule as of that timestamp, or as of "now" if no timestamp was given.

=cut

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

        # no timestamp given
        if ( $st eq 'priv' ) {
            $sql = $site->SQL_EMPLOYEE_CURRENT_PRIV;
        } elsif ( $st eq 'schedule' ) {
            $sql = $site->SQL_EMPLOYEE_CURRENT_SCHEDULE;
        } 
        @args = ( $sql, undef, $eid );
    }

    $log->debug("About to run SQL statement $sql with parameter $eid - " . 
                " called from " . (caller)[1] . " line " . (caller)[2] );

    my $status;
    try {
        $conn->run( fixup => sub {
            ( $row ) = $_->selectrow_array( @args );
        } );
    } catch {
        $log->debug( 'Encountered DBI error' );
        $status = $CELL->status_err( 'DOCHAZKA_DBI_ERR', args => [ $_ ] );
    };

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

If the HTTP result code is 200, the return value will be a status object, undef
otherwise.

=cut

sub req {
    my ( $test, $code, $user, $method, $resource, $json ) = validate_pos( @_, 1, 1, 1, 1, 1, 0 );

    if ( ref( $test ) ne 'Plack::Test::MockHTTP' ) {
        diag( "Plack::Test::MockHTTP object not passed to 'req' from " . (caller)[1] . " line " . (caller)[2] );
        BAIL_OUT(0);
    }

    # assemble request
    my %pl = (
        Accept => 'application/json',
        Content_Type => 'application/json',
    );
    if ( $json ) {
        $pl{'Content'} = $json;

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

Check that the resource has on-line documentation (takes Plack::Test object
and resource name without quotes)

=cut

sub docu_check {
    my ( $test, $resource ) = @_;
    #diag( "Entering " . __PACKAGE__ . "::docu_check with argument $resource" );

    if ( ref( $test ) ne 'Plack::Test::MockHTTP' ) {
        diag( "Plack::Test::MockHTTP object not passed to 'req' from " . (caller)[1] . " line " . (caller)[2] );
        BAIL_OUT(0);
    }

    my $tn = "docu_check $resource ";
    my $t = 0;
    my ( $docustr, $docustr_len );
    #
    # - straight 'docu/pod' resource
    my $status = req( $test, 200, 'demo', 'POST', '/docu/pod', "\"$resource\"" );
    is( $status->level, 'OK', $tn . ++$t );

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

    );

    hash_the_password( $PROPS );

    my $emp = App::Dochazka::REST::Model::Employee->spawn( $PROPS );
    is( ref($emp), 'App::Dochazka::REST::Model::Employee', 'create_bare_employee 1' );

    my $status = $emp->insert( $faux_context );
    if ( $status->not_ok ) {
        diag( "Employee insert method returned NOT_OK status in create_bare_employee" );
        diag( "test automation function, which was called from " . (caller)[1] . " line " . (caller)[2] );
        diag( "with arguments: " . Dumper( $PROPS ) );
        diag( "Full status returned by employee insert method:" );
        diag( Dumper $status );
        BAIL_OUT(0);
    }
    is( $status->level, "OK", 'create_bare_employee 2' );
    my $employee_object = $status->payload;
    is( ref( $employee_object ), 'App::Dochazka::REST::Model::Employee' );

    return $employee_object;

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

Loads the EID into a new Employee object and calls that object's delete method.

=cut

sub delete_bare_employee {
    my $eid = shift;  
    note( "delete testing employee with EID $eid" );
    my $status = App::Dochazka::REST::Model::Employee->load_by_eid( $dbix_conn, $eid );
    if ( $status->not_ok ) {
        diag( "Employee load_by_eid method returned NOT_OK status in delete_bare_employee" );
        diag( "test automation function, which was called from " . (caller)[1] . " line " . (caller)[2] );
        diag( "with EID $eid" );
        diag( "Full status returned by Employee load_by_eid method:" );
        diag( Dumper $status );
        BAIL_OUT(0);
    }
    is( $status->level, 'OK', 'delete_bare_employee 1' );
    my $emp = $status->payload;
    $status = $emp->delete( $faux_context );
    if ( $status->not_ok ) {
        diag( Dumper $status );

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

    my ( $rv, $errstr );
    try {
        $conn->run( fixup => sub {
            $rv = $_->do($sql);
        });
    } catch {
        $errstr = $_;
    };
    if ( $errstr ) {
        diag( "Unexpected error in test_sql_success: $errstr" );
        diag( "Called from " . (caller)[1] . " line " . (caller)[2] );
        BAIL_OUT(0);
    }
    is( $rv, $expected_rv, "successfully executed $sql" );
}

sub test_sql_failure {
    my ( $conn, $expected_err, $sql ) = @_;
    my ( $rv, $errstr );
    try {
        $conn->run( fixup => sub {