view release on metacpan or  search on metacpan

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

Analogous method to L<App::Dochazka::REST::Model::Activity/"load_by_aid">.

FIXME: add unit tests

=cut

sub load_by_sec_id {
    my $self = shift;
    my ( $conn, $sec_id ) = validate_pos( @_, 
        { isa => 'DBIx::Connector' },
        { type => SCALAR },
    );
    $log->debug( "Entering " . __PACKAGE__ . "::load_by_sec_id with argument $sec_id" );

    return load( 
        conn => $conn,
        class => __PACKAGE__, 
        sql => $site->SQL_EMPLOYEE_SELECT_BY_SEC_ID,
        keys => [ $sec_id ], 
    );
}


=head2 priv_change_during_range

Given a DBIx::Connector object and a tsrange, returns a non-negative integer
value signifying the number of times the employee's priv level changed during the
given range.

=cut

sub priv_change_during_range {
    my $self = shift;
    my ( $conn, $tsr ) = validate_pos( @_, 
        { isa => 'DBIx::Connector' },
        { type => SCALAR },
    );
    $log->debug( "Entering " . __PACKAGE__ . "::priv_change_during_range with argument $tsr" );
    $log->debug( "EID is " . $self->eid );

    my $status = select_single(
        conn => $conn, 
        sql => $site->SQL_EMPLOYEE_PRIV_CHANGE_DURING_RANGE, 
        keys => [ $self->eid, $tsr ], 
    );
    return _privsched_change_during_range_result( "SQL_EMPLOYEE_PRIV_CHANGE_DURING_RANGE", $status );
}

sub _privsched_change_during_range_result {
    my ( $sql_stmt, $status ) = @_;
    $log->debug( "Entering " . __PACKAGE__ . "::_privsched_change_during_range_result with status " .
                  Dumper $status );
    # there should always be a single record, and it should be either 0 or 1
    if ( ref( $status->payload ) ne 'ARRAY' ) {
        die "Unexpected _privsched_change_during_range_result: status payload is not an array!";
    }
    my ( $plval ) = validate_pos( @{ $status->payload },
        {
           type => SCALAR,
           callbacks => {
               'non-negative integer' => sub { $_[0] >= 0 }
           }
        },
    );
    return $plval;
}


=head2 privhistory_at_timestamp

Given a DBIx::Connector object and a string that must be a timestamp (or a
tsrange), returns an L<App::Dochazka::REST::Model::Privhistory> object
containing the privhistory record applicable to the employee as of the
timestamp (or the lower bound of the tsrange). If there is no such record, the
object's properties will be undefined.

NOTE: be careful that the argument really is a valid timestamp or tsrange. If
it isn't valid, the DBD::Pg error will be logged and the return value will be
undef (not a L<App::Dochazka::REST::Model::Schedhistory> object whose
properties are set to undef).

=cut

sub privhistory_at_timestamp {
    my $self = shift;
    my ( $conn, $arg ) = validate_pos( @_, 
        { isa => 'DBIx::Connector' },
        { type => SCALAR },
    );
    $log->debug( "Entering " . __PACKAGE__ . "::privhistory_at_timestamp with argument $arg" );
    $log->debug( "EID is " . $self->eid );

    # if it looks like a tsrange, use tsrange, otherwise use timestamp
    my $sql = ( $arg =~ m/[[(].*,.*[])]/ )
        ? $site->SQL_EMPLOYEE_PRIVHISTORY_AT_TSRANGE
        : $site->SQL_EMPLOYEE_PRIVHISTORY_AT_TIMESTAMP;

    my $status = select_single(
        conn => $conn, 
        sql => $sql,
        keys => [ $self->eid, $arg ], 
    );
    return undef unless $status->ok;

    $log->debug( 'privhistory_at_timestamp: database said: ' . Dumper( $status->payload ) );

    return App::Dochazka::REST::Model::Privhistory->spawn(
        phid => $status->payload->[0],
        eid  => $status->payload->[1],
        priv  => $status->payload->[2],
        effective  => $status->payload->[3],
        remark  => $status->payload->[4],
    );
}


=head2 schedule_change_during_range

Given a DBIx::Connector object and a tsrange, returns a non-negative integer
value signifying the number of times the employee's schedule changed during the