App-Dochazka-REST

 view release on metacpan or  search on metacpan

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

    fetch_intervals_by_eid_and_tsrange
    generate_interval_summary
);
use App::Dochazka::REST::Model::Lock qw(
    fetch_locks_by_eid_and_tsrange
);
use App::Dochazka::REST::Model::Privhistory qw( get_privhistory );
use App::Dochazka::REST::Model::Schedhistory qw( get_schedhistory );
use App::Dochazka::REST::Model::Schedintvls;
use App::Dochazka::REST::Model::Schedule qw( get_all_schedules );
use App::Dochazka::REST::Model::Shared qw( 
    canonicalize_date
    canonicalize_tsrange
    load_multiple
    priv_by_eid
    schedule_by_eid
    select_set_of_single_scalar_rows
    split_tsrange
    timestamp_delta_plus
);
use App::Dochazka::REST::ResourceDefs;
use App::Dochazka::REST::Shared qw( :ALL );  # all the shared_* functions
use App::Dochazka::REST::Holiday qw(
    holidays_and_weekends
    holidays_in_daterange
);
use Data::Dumper;
use File::Path qw( mkpath rmtree );
use Module::Runtime qw( use_module );
use Params::Validate qw( :all );
use Try::Tiny;
use Web::MREST::InitRouter qw( $router $resources );
use Web::MREST::Util qw( pod_to_html pod_to_text );

use parent 'App::Dochazka::REST::Auth';




=head1 NAME

App::Dochazka::REST::Dispatch - Implementation of top-level resources




=head1 DESCRIPTION

This module contains the C<init_router> method as well as all the resource
handlers referred to in the resource definitions.



=head1 PACKAGE VARIABLES

This module uses some package variables, which are essentially constants, to do
its work.

=cut

my $fail = $CELL->status_not_ok;
my %iue_dispatch = (
    'insert_employee' => \&shared_insert_employee,
    'update_employee' => \&shared_update_employee,
);



=head1 FUNCTIONS

=cut

=head2 init

This function is called by C<bin/mrest>.

=cut

sub init {
    $log->debug("Entering " . __PACKAGE__. "::init");
    App::Dochazka::REST::ConnBank::init_singleton();

    my $status = App::Dochazka::REST::reset_mason_dir();
    return $status unless $status->ok;
    my $comp_root = $status->payload;

    # get Mason components from database and write them to filesystem
    $status = get_all_components( $dbix_conn );
    if ( $status->ok and $status->code eq 'DISPATCH_RECORDS_FOUND' ) {
        foreach my $comp ( @{ $status->payload } ) {
            $comp->create_file;
        }
    }
}


=head2 init_router

The "router" (i.e., L<Path::Router> instance) is initialized when the first
request comes in, as a first step before any processing of the request takes
place.

This happens when L<Web::MREST::Resource> calls the C<init_router> method.

L<App::Dochazka::REST> implements its own C<init_router> method, overriding the
default one in L<Web::MREST::InitRouter>.

=cut

sub init_router {
    $log->debug("Entering " . __PACKAGE__. "::init_router");
    return if ref( $router ) and $router->can( 'match' );
    $router = Path::Router->new;
    App::Dochazka::REST::ResourceDefs::load();
}


=head2 Top-level handlers

These are largely (but not entirely) copy-pasted from L<Web::MREST::Dispatch>.

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

        $pl->{'documentation'} = pod_to_text( $docs );
    }
    return $CELL->status_ok( 'DISPATCH_ONLINE_DOCUMENTATION', payload => $pl );
}


=head3 handler_echo

Echo request body back in the response

=cut

sub handler_echo {
    my ( $self, $pass ) = @_;
    $log->debug( "Entering " . __PACKAGE__ . "::handler_echo, pass number $pass" );
    
    # first pass
    return 1 if $pass == 1;

    # second pass
    return $CELL->status_ok( "ECHO_REQUEST_ENTITY", payload =>
       $self->context->{'request_entity'} );
}


=head3 handler_forbidden

Handler for 'forbidden' resource.

=cut

sub handler_forbidden {
    my ( $self, $pass ) = @_;
    $log->debug( "Entering " . __PACKAGE__ . "::handler_forbidden, pass number $pass" );
    
    # first pass
    return 1 if $pass == 1;

    # second pass
    $self->mrest_declare_status( explanation => 'Resource forbidden by definition', permanent => 1 );
    return $fail;
}


=head3 handler_holiday_tsrange

Handler for 'holiday/:tsrange' resource.

=cut

sub handler_holiday_tsrange {
    my ( $self, $pass ) = @_;
    $log->debug( "Entering " . __PACKAGE__ . "::handler_holiday_tsrange, pass number $pass" );
    
    # first pass
    if ( $pass == 1 ) {
        my $status = split_tsrange( 
            $self->context->{'dbix_conn'},
            $self->context->{'mapping'}->{'tsrange'},
        );
        if ( $status->not_ok ) {
            $status->{'http_code'} = ( $status->code eq 'DOCHAZKA_DBI_ERR' )
                ? 500 
                : 400;
            $self->mrest_declare_status( $status );
            return 0;
        }
        my $datereg = qr/(\d+-\d+-\d+)/;
        my ( $begin ) = $status->payload->[0] =~ $datereg;
        my ( $end ) = $status->payload->[1] =~ $datereg;
        if ( ! defined( $begin ) or ! defined( $end ) ) {
            $self->mrest_declare_status( 
                level => 'ERR', 
                code => 400,
                explanation => 'DISPATCH_UNBOUNDED_TSRANGE',
            );
            return 0;
        }
        $self->context->{'stashed_daterange'} = { 
                "begin" => $begin, 
                "end" => $end,
        };
    }

    # second pass
    return $CELL->status_ok( 'DOCHAZKA_HOLIDAYS_AND_WEEKENDS_IN_TSRANGE',
        tsrange => $self->context->{'mapping'}->{'tsrange'},
        payload => holidays_and_weekends( %{ $self->context->{'stashed_daterange'} } )
    );
}


=head3 handler_param

Handler for 'param/:type/:param' resource.

=cut

sub handler_param {
    my ( $self, $pass ) = @_;
    $log->debug( "Entering " . __PACKAGE__ . "::handler_param, pass number $pass" );

    # get parameters
    my $method = $self->context->{'method'};
    my $mapping = $self->context->{'mapping'};
    my ( $type, $param );
    if ( $mapping ) {
        $type = $self->context->{'mapping'}->{'type'};
        $param = $self->context->{'mapping'}->{'param'};
    } else {
        die "AAAHAHAHAAHAAHAAAAAAAA! no mapping?? in handler_param_get";
    }
    my $resource_name = $self->context->{'resource_name'};

    my ( $bool, $param_obj );
    if ( $type eq 'meta' ) {
        $param_obj = $meta;
    } elsif ( $type eq 'core' ) {
        $param_obj = $core;
    } elsif ( $type eq 'site' ) {
        $param_obj = $site;

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

    $log->debug( "Entering " . __PACKAGE__ . "::handler_post_employee_self (pass $pass)" ); 

    # first pass
    return 1 if $pass == 1;
    
    # second pass
    my $context = $self->context;
    return $fail unless shared_employee_acl_part2( $self );
    return shared_update_employee( 
        $self,
        $context->{'current_obj'}, 
        $context->{'request_entity'} 
    );
}


=head3 handler_delete_employee_eid

Handler for 'DELETE employee/eid/:eid' resource.

=cut

sub handler_delete_employee_eid {
    my ( $self, $pass ) = @_;
    $log->debug( "Entering " . __PACKAGE__ . "::handler_delete_employee_eid" ); 

    # first pass
    if ( $pass == 1 ) {
        return $self->handler_get_employee_eid( $pass );
    }

    # second pass
    my $context = $self->context;
    return $context->{'stashed_employee_object'}->delete( $context );
}


=head3 handler_get_employee_eid

Handler for 'GET employee/eid/:eid'

=cut

sub handler_get_employee_eid {
    my ( $self, $pass ) = @_;
    $log->debug( "Entering " . __PACKAGE__ . "::handler_get_employee_eid" ); 
    return shared_get_employee( $self, $pass, 'EID', $self->context->{'mapping'}->{'eid'} );
}


=head3 _ldap_sync_pass1

=cut

sub _ldap_sync_pass1 {
    my ( $self, $emp ) = @_;
    $log->debug( "Entering " . __PACKAGE__ . "::_ldap_sync_pass1" ); 

    my $status = $emp->ldap_sync();
    $log->debug( "ldap_sync status: " . Dumper( $status ) );
    if ( $status->not_ok ) {
        if ( $status->code eq 'DOCHAZKA_LDAP_SYSTEM_USER_NOSYNC' ) {
            # system user - 403
            $status->{'http_code'} = 403;
        } else {
            $status->{'http_code'} = 404;
        }
        $self->mrest_declare_status( $status );
        return 0;
    }
    $self->context->{'stashed_employee_object'} = $emp;
    return 1;
}


=head3 handler_get_employee_ldap

Handler for 'GET employee/nick/:nick/ldap' resource.

=cut

sub handler_get_employee_ldap {
    my ( $self, $pass ) = @_;
    $log->debug( "Entering " . __PACKAGE__ . "::handler_get_employee_ldap" ); 

    my $context = $self->context;
    my $nick = $context->{'mapping'}->{'nick'};

    if ( $pass == 1 ) {
        my $emp = App::Dochazka::REST::Model::Employee->spawn(
            'nick' => $nick,
            'sync' => 1,
        );
        return $self->_ldap_sync_pass1( $emp );
    }

    return $CELL->status_ok( 'DOCHAZKA_LDAP_LOOKUP', payload => $context->{'stashed_employee_object'} );
}


=head3 handler_put_employee_ldap

Handler for 'PUT employee/nick/:nick/ldap' resource.

=cut

sub handler_put_employee_ldap {
    my ( $self, $pass ) = @_;
    $log->debug( "Entering " . __PACKAGE__ . "::handler_put_employee_ldap" ); 

    my $context = $self->context;
    $log->debug( "mapping " . Dumper( $context->{'mapping'} ) );
    my $nick = $context->{'mapping'}->{'nick'};
    my $status;

    # first pass
    if ( $pass == 1 ) {
        # determine if this is an insert or an update
        my $emp = shared_first_pass_lookup( $self, 'nick', $nick );
        $self->nullify_declared_status;
        return 0 unless shared_employee_acl_part1( $self, $emp );  # additional ACL checks

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

}


=head3 handler_get_employee_nick

Handler for 'GET employee/nick/:nick'

=cut

sub handler_get_employee_nick {
    my ( $self, $pass ) = @_;
    $log->debug( "Entering " . __PACKAGE__ . "::handler_get_employee_nick" ); 
    return shared_get_employee( $self, $pass, 'nick', $self->context->{'mapping'}->{'nick'} );
}


=head3 handler_get_employee_sec_id

Handler for 'GET employee/sec_id/:sec_id'

=cut

sub handler_get_employee_sec_id {
    my ( $self, $pass ) = @_;
    $log->debug( "Entering " . __PACKAGE__ . "::handler_get_employee_sec_id" ); 
    return shared_get_employee( $self, $pass, 'sec_id', $self->context->{'mapping'}->{'sec_id'} );
}


=head3 handler_get_employee_search_nick

Handler for 'GET employee/search/nick/:key'

=cut

sub handler_get_employee_search_nick {
    my ( $self, $pass ) = @_;
    $log->debug( "Entering " . __PACKAGE__ . "::handler_get_employee_search_nick" ); 

    # first pass
    return 1 if $pass == 1;

    # second pass
    my $key = $self->context->{'mapping'}->{'key'};
    $key = "%$key%" unless $key =~ m/%/;
    my $status = $CELL->status_ok;
    $status = load_multiple(
        conn => $self->context->{'dbix_conn'},
        class => 'App::Dochazka::REST::Model::Employee',
        sql => $site->SQL_EMPLOYEE_SELECT_MULTIPLE_BY_NICK,
        keys => [ $key ],
    );
    # check for 404
    if ( $status->level eq 'NOTICE' and $status->code eq 'DISPATCH_NO_RECORDS_FOUND' ) {
        $self->mrest_declare_status( code => 404,
            explanation => "DISPATCH_SEARCH_EMPTY",
            args => [ 'employee', "nick LIKE $key" ],
        );
        return $fail;
    }
    return $status if $status->not_ok;

    # found some employee objects
    foreach my $emp ( @{ $status->payload } ) {
        $emp = $emp->TO_JSON;
    }
    return $status;
}


=head2 Genreport handlers

=head3 handler_genreport

Handler for the 'POST genreport' resource.

=cut

sub handler_genreport {
    my ( $self, $pass ) = @_;
    $log->debug( "Entering " . __PACKAGE__ . "::handler_genreport" ); 

    # first pass
    return 1 if $pass == 1;

    # second pass
    # - check that entity is kosher
    my $status = shared_entity_check( $self, 'path' );
    return $status unless $status->ok;
    my $context = $self->context;
    my $entity = $context->{'request_entity'};

    # - get path and look it up
    my $path = $entity->{'path'};
    my $comp = shared_first_pass_lookup( $self, 'path', $path );
    return $fail unless $path;
    delete $entity->{'path'};

    # - if there is a 'parameters' property, check that it is a hashref
    my $parameters;
    if ( $entity->{'parameters'} ) {
        $log->debug( "Vetting parameters: " . Dumper $entity->{'parameters'} ) ;
        if ( ref( $entity->{'parameters'} ) ne 'HASH' ) {
            $self->mrest_declare_status( 
                code => 400, 
                explanation => 'parameters must be given as key:value pairs'
            );
            return $fail;
        }
        # - convert $parameters hashref into $parameters arrayref for validation
        my $count = 0;
        foreach my $key ( keys %{ $entity->{'parameters'} } ) {
            $parameters->[$count] = $key;
            $count += 1;
            $parameters->[$count] = $entity->{'parameters'}->{$key};
            $count += 1;
        }
    }

    # - if there is a validations property, convert it into a hashref
    #   and check the parameters against it

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

        $ARGS{'tsrange'} = $context->{'mapping'}->{'tsrange'};
    }
    
    if ( $context->{'components'}->[0] eq 'priv' ) {
        return get_privhistory( $context, %ARGS );
    } elsif ( $context->{'components'}->[0] eq 'schedule' ) {
        return get_schedhistory( $context, %ARGS );
    }
}


=head3 handler_history_get_single

Handler method for GET requests on the '/{priv,schedule}/history/eid/..' and
'/{priv,schedule}/history/nick/..' resources (potentially returning
a single record).

=cut

sub handler_history_get_single {
    my ( $self, $pass ) = @_;
    $log->debug( "Entering " . __PACKAGE__ . "::handler_history_get_single" ); 

    my ( $context, $method, $mapping, undef, $ts, $key, $value ) = shared_history_init( $self->context );

    # first pass
    if ( $pass == 1 ) {
        my $emp = shared_first_pass_lookup( $self, $key, $value );
        return 0 unless $emp;
        $self->context->{'stashed_employee_obj'} = $emp;
        return 1;
    }

    # second pass
    my $prop = $context->{'components'}->[0];
    my $emp = $self->context->{'stashed_employee_obj'};
    my $status;
    if ( $prop eq 'priv' ) {
        $status = App::Dochazka::REST::Model::Privhistory->load_by_eid(
            $context->{'dbix_conn'},
            $emp->eid,
            $ts
        );
    } elsif ( $prop eq 'schedule' ) {
        $status = App::Dochazka::REST::Model::Schedhistory->load_by_eid(
            $context->{'dbix_conn'},
            $emp->eid,
            $ts
        );
    } else {
        die "BGUDFUUFF! Improper prop ->$prop<- seen!";
    }
    # - process return value
    if ( $status->level eq 'NOTICE' and $status->code eq 'DISPATCH_NO_RECORDS_FOUND' ) {
        my $tsmsg = ( $ts ) ? $ts : 'now';
        $self->mrest_declare_status(
            code => 404,
            explanation => "No $prop history for $key $value as of $tsmsg",
        );
        return $fail;
    } elsif ( $status->not_ok ) {
        $self->mrest_declare_status(
            code => 500,
            explanation => $status->text,
        );
        return $fail;
    }
    return $status;
}


=head3 handler_history_get_multiple

Handler method for GET requests on the '/{priv,schedule}/history/eid/..' and
'/{priv,schedule}/history/nick/..' resources (all potentially returning
multiple records).

=cut

sub handler_history_get_multiple {
    my ( $self, $pass ) = @_;
    $log->debug( "Entering " . __PACKAGE__ . "::handler_history_get_multiple" ); 

    my ( $context, $method, $mapping, $tsrange, undef, $key, $value ) = shared_history_init( $self->context );

    # first pass
    if ( $pass == 1 ) {
        my $emp = shared_first_pass_lookup( $self, $key, $value );
        return 0 unless $emp;
        $self->context->{'stashed_employee_obj'} = $emp;
        return 1;
    }

    # second pass
    my ( $class, $prop, undef ) = shared_get_class_prop_id( $context );
    my $emp = $self->context->{'stashed_employee_obj'};
    my $status = App::Dochazka::REST::Model::Shared::get_history( 
        $prop,
        $context->{'dbix_conn'},
        eid => $emp->eid,
        nick => $emp->nick, 
        tsrange => $tsrange, 
    );
    # - process return value
    if ( $status->level eq 'NOTICE' and $status->code eq 'DISPATCH_NO_RECORDS_FOUND' ) {
        $self->mrest_declare_status( code => 404, explanation => "No history for $key $value $tsrange" );
        return $fail;
    } elsif ( $status->not_ok ) {
        $self->mrest_declare_status( code => 500, explanation => $status->text );
        return $fail;
    }
    return $status;
}


=head3 handler_history_post

Handler method for POST requests on the '/{priv,schedule}/history/eid/..' and
'/{priv,schedule}/history/nick/..' resources.

=cut

sub handler_history_post {
    my ( $self, $pass ) = @_;
    $log->debug( "Entering " . __PACKAGE__ . "::handler_history_post" ); 

    my ( $context, undef, undef, undef, undef, $key, $value ) = shared_history_init( $self->context );

    # first pass
    if ( $pass == 1 ) {
        # get employee object from key+value
        my $emp = shared_first_pass_lookup( $self, $key, $value );
        return 0 unless $emp;
        $self->context->{'stashed_employee_obj'} = $emp;
        $self->context->{'post_is_create'} = 1;
        return 1;
    }

    # second pass
    my ( $class, $prop, $id ) = shared_get_class_prop_id( $context );
    my $emp = $context->{'stashed_employee_obj'};

    my $entity = $context->{'request_entity'};
    if ( $prop eq 'sid' ) {
        # we might have scode instead of sid in the entity
        if ( $entity->{'scode'} and not $entity->{'sid'} ) {
            my $sched = shared_first_pass_lookup( $self, 'scode', $entity->{'scode'} );
            if ( $sched ) {
                $entity->{'sid'} = $sched->sid;
            } else {
                $self->mrest_declare_status(
                    explanation => 'Schedule code ' . $entity->{'scode'} . ' not found',
                    permanent => 1,
                );
                return $fail;
            }
        }
    }

    # - check entity for presence of certain properties
    my $status = shared_entity_check( $self, $prop, 'effective' );
    return $status unless $status->ok;

    # - run the insert operation
    my $ho;
    try {
        $ho = $class->spawn( 
            eid => $emp->eid, 
            effective => $entity->{'effective'},
            $prop => $entity->{$prop},
            remark => $entity->{'remark'},
        );
    } catch {
        $log->crit($_);
        return $CELL->status_crit("DISPATCH_HISTORY_COULD_NOT_SPAWN", args => [ $_ ] );
    };
    $status = $ho->insert( $context );
    if ( $status->not_ok ) {
        $self->context->{'create_path'} = $status->level;
        if ( $status->code eq 'DOCHAZKA_MALFORMED_400' ) {
            return $self->mrest_declare_status(
                code => 400,
                explanation => "Check syntax of your request entity"
            );
        }
        return $self->mrest_declare_status(
            code => 500,
            explanation => $status->code,
            args => $status->args
        );
    }
    $self->context->{'create_path'} = '.../history/phid/' . ( $status->payload->{$id} || 'UNDEF' );
    return $status;
}


=head3 handler_history_get_phid

Handler for 'GET priv/history/phid/:phid'

=cut

sub handler_history_get_phid {
    my ( $self, $pass ) = @_;
    $log->debug( "Entering " . __PACKAGE__ . "::handler_history_get_phid" ); 

    # first pass
    if ( $pass == 1 ) {
        my $p_obj = shared_first_pass_lookup( $self, 'PHID', $self->context->{'mapping'}->{'phid'} );
        return 0 unless $p_obj;
        $self->context->{'stashed_history_object'} = $p_obj;
        return 1;
    }

    # second pass
    return $CELL->status_ok( 
        'DISPATCH_HISTORY_RECORD_FOUND', 
        payload => $self->context->{'stashed_history_object'},
    );
}


=head3 handler_history_post_phid

Handler for 'POST priv/history/phid/:phid'

=cut

sub handler_history_post_phid {
    my ( $self, $pass ) = @_;
    $log->debug( "Entering " . __PACKAGE__ . "::handler_history_post_phid" ); 

    # first pass
    if ( $pass == 1 ) {
        my $p_obj = shared_first_pass_lookup( $self, 'PHID', $self->context->{'mapping'}->{'phid'} );
        return 0 unless $p_obj;
        $self->context->{'stashed_history_object'} = $p_obj;
        return 1;

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

        my @ARGS = (
            $context->{'dbix_conn'},
            $emp->eid,
            $tsr,
        );
        my $method = $self->context->{'method'};
        my $resource = $self->context->{'resource_name'};
        $log->debug( "_handler_intlock: resource is $resource" );
        if ( $method eq 'GET' and $intlock eq 'Interval' ) {
            $status = fetch_intervals_by_eid_and_tsrange( @ARGS );
        } elsif ( $method eq 'GET' and $intlock eq 'Lock' ) {
            $status = fetch_locks_by_eid_and_tsrange( @ARGS );
        } elsif ( $method eq 'GET' and $intlock eq 'Summary' ) {
            $status = generate_interval_summary( @ARGS );
            if ( $status->level eq 'ERR' and 
                 $status->code eq 'DISPATCH_SUMMARY_ILLEGAL_TSRANGE' ) {
                $self->mrest_declare_status( 'code' => 400, 
                    'explanation' => $status->text );
                return 0;
            }
        } elsif ( $method eq 'DELETE' and $intlock eq 'Interval' ) {
            $status = delete_intervals_by_eid_and_tsrange( @ARGS );
        } else {
            die "AGACHCH!! Horrible, horrible: " . ( $intlock || "undef" );
        }
        if ( $status->level eq 'NOTICE' and $status->code eq 'DISPATCH_NO_RECORDS_FOUND' ) {
            $self->mrest_declare_status( explanation => 'DISPATCH_NOTHING_IN_TSRANGE',
                args => [ 'attendance intervals', $tsr ] 
            );
            return 0;
        }
        $context->{'stashed_attendance_status'} = $status;
        return 1;
    }

    # second pass
    return $context->{'stashed_attendance_status'};
}


=head3 handler_interval_new

Handler for 'POST interval/new'

=cut

sub handler_interval_new {
    my ( $self, $pass ) = @_;
    $log->debug( "Entering " . __PACKAGE__. "::handler_interval_new" ); 

    my $context = $self->context;

    # first pass
    if ( $pass == 1 ) {
        $context->{'post_is_create'} = 1;
        return 1;
    }
        
    # second pass
    my $status = shared_entity_check( $self, 'aid', 'intvl' );
    return $fail if $status->not_ok;

    if ( check_acl_context( $context )->not_ok ) {
        $self->mrest_declare_status( code => 403, explanation => 'DISPATCH_KEEP_TO_YOURSELF' );
        return $fail;
    }

    return shared_insert_interval( $self );
}


=head3 handler_post_interval_iid

Handler for 'POST interval/iid'.

=cut

sub handler_post_interval_iid {
    my ( $self, $pass ) = @_;
    $log->debug( "Entering " . __PACKAGE__. "::handler_post_interval_iid" ); 

    my $context = $self->context;

    # first pass
    return 1 if $pass == 1;

    # second pass
    # - get IID
    my $status = shared_entity_check( $self, 'iid' );
    return $fail unless $status->ok;
    my $iid = $context->{'request_entity'}->{'iid'};

    # - is there an interval with this IID?
    my $int = shared_first_pass_lookup( $self, 'IID', $iid );
    return $fail unless $int;

    # - additional ACL check
    if ( ! acl_check_is_me( $self, 'eid' => $int->eid ) ) {
        $self->mrest_declare_status( code => 403, explanation => "DISPATCH_KEEP_TO_YOURSELF" );
        return $fail;
    }

    # - perform the operation
    return shared_update_intlock( $self, $int, $context->{'request_entity'} );
}


=head3 handler_get_interval_iid

Handler for 'GET interval/iid/:iid' resource.

=cut

sub handler_get_interval_iid {
    my ( $self, $pass ) = @_;
    $log->debug( "Entering " . __PACKAGE__. "::handler_get_interval_iid" ); 

    my $context = $self->context;

    # first pass
    if ( $pass == 1 ) {

        # - get IID

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

    }

    # second pass
    my $int = $context->{'stashed_interval_object'};
    my $method = $context->{'method'};
    if ( $method =~ m/^(PUT)|(POST)$/ ) {
        return shared_update_intlock( $self, $int, $context->{'request_entity'} );
    } elsif ( $method eq 'DELETE' ) {
        return $int->delete( $context );
    }
    die "AAGAGAGGGGGGGGGGHHGHGHKD! method is " . ( $method || "undef" );
}


=head3 handler_get_interval_summary

Handler for  "GET interval/summary/eid/:eid/:tsrange"

=cut

sub handler_get_interval_summary {
    my ( $self, $pass ) = @_;
    $log->debug("Reached " . __PACKAGE__ . "::handler_get_interval_summary" );

    my $context = $self->context;

    # first pass
    if ( $pass == 1 ) {
        my $rv = $self->_handler_intlock( 'Summary', 'eid', $pass );
        return 0 unless $rv;
    }

    return $context->{'stashed_attendance_status'};
}



=head2 Lock handlers


=head3 handler_lock_new

Handler for 'POST lock/new'

=cut

sub handler_lock_new {
    my ( $self, $pass ) = @_;
    $log->debug( "Entering " . __PACKAGE__. "::handler_lock_new" ); 

    my $context = $self->context;

    # first pass
    if ( $pass == 1 ) {
        $context->{'post_is_create'} = 1;
        return 1;
    }
        
    # second pass
    my $status = shared_entity_check( $self, 'intvl' );
    return $fail if $status->not_ok;

    if ( check_acl_context( $context )->not_ok ) {
        $self->mrest_declare_status( code => 403, explanation => 'DISPATCH_KEEP_TO_YOURSELF' );
        return $fail;
    }

    return shared_insert_lock( $self );
}


=head3 handler_post_lock_lid

Handler for 'POST lock/lid'.

=cut

sub handler_post_lock_lid {
    my ( $self, $pass ) = @_;
    $log->debug( "Entering " . __PACKAGE__. "::handler_post_lock_lid" ); 

    my $context = $self->context;

    # first pass
    return 1 if $pass == 1;

    # second pass
    # - get LID
    my $status = shared_entity_check( $self, 'lid' );
    return $fail unless $status->ok;
    my $lid = $context->{'request_entity'}->{'lid'};

    # - is there a lock with this LID?
    my $lock = shared_first_pass_lookup( $self, 'LID', $lid );
    return $fail unless $lock;

    # - additional ACL check
    if ( ! acl_check_is_me( $self, 'eid' => $lock->eid ) ) {
        $self->mrest_declare_status( code => 403, explanation => "DISPATCH_KEEP_TO_YOURSELF" );
        return $fail;
    }

    # - perform the operation
    return shared_update_intlock( $self, $lock, $context->{'request_entity'} );
}


=head3 handler_get_lock_lid

Handler for 'GET lock/lid/:lid' resource.

=cut

sub handler_get_lock_lid {
    my ( $self, $pass ) = @_;
    $log->debug( "Entering " . __PACKAGE__. "::handler_get_lock_lid" ); 

    my $context = $self->context;

    # first pass
    if ( $pass == 1 ) {

        # - get LID

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


    # either tsrange or date_list, but not both
    my $tsdl = $self->_extract_date_list_or_tsrange( $entity );
    return $fail unless ref( $tsdl ) eq 'HASH';

    # clobber based on the resource ("scheduled" or "fillup")
    if ( $mode eq 'Fillup' ) {
        $clobber = 0;
        $dry_run = {};
    } elsif ( $mode eq 'Scheduled' ) {
        $clobber = 1;
        delete $entity->{'clobber'};
        $dry_run = { 'dry_run' => '1' };
        delete $entity->{'dry_run'};
        $supervisor_ok = 1;
    } else {
        die "ASSERTfillupscheduled";
    }

    # ACL check
    if ( $supervisor_ok ) {
        $acl_check = acl_check_is_me( $self, 'eid' => $emp->eid ) ||
                     acl_check_is_my_report( $self, 'eid' => $emp->eid );
    } else {
        $acl_check = acl_check_is_me( $self, 'eid' => $emp->eid );
    }
    if ( ! $acl_check ) {
        $self->mrest_declare_status( code => 403, explanation => "DISPATCH_KEEP_TO_YOURSELF" );
        return;
    }

    # create Fillup object
    my $fillup = App::Dochazka::REST::Fillup->new( 
        context => $context,
        emp_obj => $emp,
        clobber => $clobber,
        %$dry_run,
        %$tsdl,
        %$entity,
    );
    if ($mode eq 'Fillup') {
        $fillup->act_obj( $act );
    }
    if ( ! defined( $fillup ) or ref( $fillup ) ne 'App::Dochazka::REST::Fillup' ) {
        $self->mrest_declare_status( 
            code => 500, 
            explanation => "No Fillup object" 
        );
        return $fail;
    }
    if ( ! $fillup->constructor_status or
         ! $fillup->constructor_status->isa( 'App::CELL::Status' ) )
    {
        $self->mrest_declare_status( 
            code => 500, 
            explanation => "No constructor_status in Fillup object" 
        );
        return $fail;
    }
    $log->debug( "Fillup object created; constructor status is " . Dumper( $fillup->constructor_status ) );
    if ( $fillup->constructor_status->not_ok ) {
        my $status = $fillup->constructor_status;
        $status->{'http_code'} = ( $status->code eq 'DOCHAZKA_DBI_ERR' )
            ? 500 
            : 400;
        $self->mrest_declare_status( $status );
        return $fail;
    }
    
    my $status = $fillup->commit;
    if ( $status->not_ok ) {
        $self->mrest_declare_status( code => 500, explanation => $status->text );
        return $fail;
    }
    return $status;
}

# helper function to extract employee spec from request entity
# takes request entity hash and returns either undef on failure
# or Employee object on success
sub _extract_employee_spec {
    my ( $self, $entity ) = @_;
    $log->debug( "Entering " . __PACKAGE__ . "::_extract_employee_spec " .
                 "with entity " . Dumper( $entity ) );
    my ( $key, $value );
    # the key can be one and only one of the following: 
    # eid, nick, sec_id (in that order; additional keys are ignored)
    if ( $entity->{eid} ) {
        $key = 'eid';
        $value = $entity->{eid};
    } elsif ( $entity->{nick} ) {
        $key = 'nick';
        $value = $entity->{nick};
    } elsif ( $entity->{sec_id} ) {
        $key = 'sec_id';
        $value = $entity->{sec_id};
    } else {
        $self->mrest_declare_status(
            code => 404,
            explanation => "DISPATCH_EMPLOYEE_CANNOT_BE_DETERMINED"
        );
        return;
    }
    map { delete $entity->{$_} } ( 'eid', 'nick', 'sec_id' );
    my $emp = shared_first_pass_lookup( $self, $key, $value );
    return unless $emp->isa( 'App::Dochazka::REST::Model::Employee' );
    return $emp;
}

# helper function to extract activity spec from request entity
# takes request entity hash and returns either undef on failure
# or Activity object on success
sub _extract_activity_spec {
    my ( $self, $entity ) = @_;
    $log->debug( "Entering " . __PACKAGE__ . "::_extract_activity_spec " .
                 "with entity " . Dumper( $entity ) );
    my ( $key, $value );
    # the key can be one and only one of the following: 
    # aid, code, or nothing (in which case code defaults to "WORK")
    if ( $entity->{aid} ) {
        $key = 'aid';
        $value = $entity->{aid};
    } elsif ( $entity->{code} ) {
        $key = 'code';
        $value = $entity->{code};
    } else {
        $key = 'code';
        $value = 'WORK';
    }
    map { delete $entity->{$_} } ( 'aid', 'code' );
    my $act = shared_first_pass_lookup( $self, $key, $value );

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

        return;
    }

    if ( $entity->{date_list} ) {
        $dlts = { 'date_list' => $entity->{date_list} };
    } elsif ( $entity->{tsrange} ) {
        $dlts = { 'tsrange' => $entity->{tsrange} };
    } else {
        die "ASSERT AGCJDK!!!!!!DEE";
    }

    $log->debug( "_extract_date_list_or_tsrange returning " . Dumper $dlts );
    return $dlts;
}


=head3 handler_get_schedule_nick

=cut

sub handler_get_schedule_nick {
    my ( $self, $pass ) = @_;
    $log->debug( "Entering " . __PACKAGE__ . ":handler_get_schedule_nick" ); 
    return shared_get_privsched( $self, 'schedule', $pass, 'nick', $self->context->{'mapping'}->{'nick'} );
}


=head3 handler_get_schedule_self

=cut

sub handler_get_schedule_self {
    my ( $self, $pass ) = @_;
    $log->debug( "Entering " . __PACKAGE__ . ":handler_get_schedule_self" ); 
    return shared_get_privsched( $self, 'schedule', $pass, 'EID', $self->context->{'current'}->{'eid'} );
}


=head3 handler_schedule_new

Handler for the 'schedule/new' resource.

=cut

sub handler_schedule_new {
    my ( $self, $pass ) = @_;
    $log->debug( "Entering " . __PACKAGE__ . "::handler_schedule_new" ); 

    my $context = $self->context;

    # first pass
    if ( $pass == 1 ) {
        $context->{'post_is_create'} = 1;
        return 1;
    }

    # second pass
    my ( $status, $code );

    $status = shared_entity_check( $self, 'schedule' );
    return $fail if $status->not_ok;
    if ( ref( $context->{'request_entity'}->{'schedule'} ) ne "ARRAY" ) {
        $self->mrest_declare_status( code => 400, explanation => 'Check schedule syntax' );
        return $fail;
    }

    # first, spawn a Schedintvls object
    my $intvls = App::Dochazka::REST::Model::Schedintvls->spawn;
    $log->debug( "Spawned Schedintvls object " . Dumper( $intvls ) );

    # note that a SSID has been assigned
    my $ssid = $intvls->ssid;
    $log->debug("Spawned Schedintvls object with SSID $ssid");

    # assume that these are the intervals
    $intvls->{'intvls'} = $context->{'request_entity'}->{'schedule'};
    #
    # insert the intervals
    $status = $intvls->insert( $context->{'dbix_conn'} ); # schedintvls is not audited
    if ( $status->not_ok ) {
        $self->mrest_declare_status( code => 500, explanation => $status->text );
        return $fail;
    }
    $log->info( "schedule/new: Scratch intervals inserted" );

    #
    # convert the intervals to get the 'schedule' property
    $status = $intvls->load( $context->{'dbix_conn'} );
    if ( $status->not_ok ) {
        $intvls->delete( $context->{'dbix_conn'} );
        $self->mrest_declare_status( code => 400, explanation => $status->text );
        return $fail;
    }
    $log->info( "schedule/new: Scratch intervals converted" );

    #
    # spawn Schedule object
    my @ARGS = ( 'schedule' => $intvls->json );
    if ( my $scode = $context->{'request_entity'}->{'scode'} ) {
        push @ARGS, ( 'scode' => $scode );
    }
    my $sched = App::Dochazka::REST::Model::Schedule->spawn( @ARGS );
    #
    # insert schedule object to get SID
    $status = $sched->insert( $context );
    if ( $status->ok ) {
        if ( $status->code eq 'DOCHAZKA_SCHEDULE_EXISTS' ) {
            $self->context->{'create_path'} = '.../schedule/shid/' . $sched->sid;
            $code = 'DISPATCH_SCHEDULE_EXISTS';
            $log->info( "POST schedule/new: Returning existing schedule, unchanged" );
            $sched = $status->payload;
        } elsif ( $status->code eq 'DOCHAZKA_SCHEDULE_UPDATE_OK' ) {
            $self->context->{'create_path'} = '.../schedule/shid/' . $sched->sid;
            $code = 'DISPATCH_SCHEDULE_UPDATE_OK';
            $log->info( "POST schedule/new: Existing schedule updated" );
        } elsif ( $status->code eq 'DOCHAZKA_SCHEDULE_INSERT_OK' ) {
            $self->context->{'create_path'} = '.../schedule/shid/' . $sched->sid;
            $code = 'DISPATCH_SCHEDULE_INSERT_OK';
            $log->info( "POST schedule/new: New schedule inserted" );
        } else {
            die "AGGHGHG! could not handle App::Dochazka::REST::Model::Schedule->insert status: " 
                . Dumper( $status );
        }
    } else {
        $self->mrest_declare_status( code => 500, explanation => 
            "schedule/new: Model/Schedule.pm->insert failed: " . $status->text );
        $intvls->delete( $context->{'dbix_conn'} );
        return $fail;
    }
    #
    # delete the schedintvls object
    $status = $intvls->delete( $context->{'dbix_conn'} ); # schedintvls is not audited
    if ( $status->not_ok ) {
        $self->mrest_declare_status( code => 500, explanation => "Could not delete schedintvls: " . $status->text );
        return $fail;
    }
    $log->info( "schedule/new: scratch intervals deleted" );
    #
    # success
    return $CELL->status_ok( $code, payload => $sched->TO_JSON );
}


=head3 handler_get_schedule_sid

Handler for '/schedule/sid/:sid'

=cut

sub handler_get_schedule_sid {
    my ( $self, $pass ) = @_;
    $log->debug( "Entering " . __PACKAGE__ . ":handler_get_schedule_sid" ); 

    # first pass
    if ( $pass == 1 ) {
        my $sched = shared_first_pass_lookup( $self, 'SID', $self->context->{'mapping'}->{'sid'} );
        return 0 unless $sched;
        $self->context->{'stashed_schedule_object'} = $sched;
        return 1;
    }
    
    # second pass
    return $CELL->status_ok( 
        'DISPATCH_SCHEDULE_FOUND',
        payload => $self->context->{'stashed_schedule_object'},
    );
}


=head3 handler_put_schedule_sid

Handler for 'PUT schedule/sid/:sid'

=cut

sub handler_put_schedule_sid {
    my ( $self, $pass ) = @_;
    $log->debug( "Entering " . __PACKAGE__ . ":handler_put_schedule_sid" ); 

    my $context = $self->context;
    my $sid = $context->{'mapping'}->{'sid'};

    # first pass
    if ( $pass == 1 ) {
         my $sched = shared_first_pass_lookup( $self, 'SID', $sid );
         return 0 unless $sched;
         $context->{'stashed_schedule_object'} = $sched;
         return 1;
    }

    # run the update operation
    return shared_update_schedule( 
        $self,



( run in 0.393 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )