view release on metacpan or  search on metacpan

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

    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
given range.

=cut

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

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


=head2 schedhistory_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::Schedhistory> object
containing the history 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 schedhistory_at_timestamp {
    my $self = shift;
    my ( $conn, $arg ) = validate_pos( @_, 
        { isa => 'DBIx::Connector' },
        { type => SCALAR },
    );
    $log->debug( "Entering " . __PACKAGE__ . "::schedhistory_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_SCHEDHISTORY_AT_TSRANGE
        : $site->SQL_EMPLOYEE_SCHEDHISTORY_AT_TIMESTAMP;

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

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

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


=head2 team_nicks

Given a L<DBIx::Connector> object, return a status object that, if successful,
will contain in the payload a list of employees whose supervisor is the
employee corresponding to C<$self>.

=cut

sub team_nicks {
    my $self = shift;
    my ( $conn ) = validate_pos( @_,
        { isa => 'DBIx::Connector' },
    );
    $log->debug( "Entering " . __PACKAGE__ . "::team_nicks for employee " . ( $self->nick || 'undefined' ) );

    # no EID, no team
    return $CELL->status_ok( 'TEAM', payload => [] ) unless $self->eid;

    # if nick not populated, get it
    $self->load_by_eid( $conn, $self->eid ) unless $self->nick =~ /\S+/;

    my $status = select_set_of_single_scalar_rows( 
        'conn' => $conn,
        'sql' => $site->SQL_EMPLOYEE_SELECT_TEAM,
        'keys' => [ $self->eid ],
    );
    return $status unless $status->ok;
    return $CELL->status_ok( 
        'DISPATCH_LIST_EMPLOYEE_NICKS_TEAM',
        args => [ $self->nick ],
        payload => $status->payload,
    );
}


=head2 has_reports