App-Dochazka-REST
view release on metacpan or search on metacpan
- Model/Employee.pm: return DISPATCH_NO_RECORDS_FOUND with status level 'NOTICE'
- t/dispatch/history.t: explore more possibilities for entering an invalid EID;
adapt to current state (status-triggered 404 errors)
- t/dispatch/interval.t: add basic tests for 'interval/self/:tsrange'
0.292 2014-11-19 16:40 CET
- dispatch/interval_Config.pm: enable _fetch_* dispatch targets
- sql/interval_Config.pm: add SQL_INTERVAL_SELECT_BY_EID_AND_TSRANGE
- Dispatch/Interval.pm: implement _fetch_* dispatch targets
- Model/Interval.pm: implement a fetch_by_eid_and_tsrange function
- Model/Shared.pm: load_multiple had no provision for binding parameters -
fixed
- t/dispatch/interval.t: add some basic tests for
'/interval/eid/:eid/:tsrange', 'interval/nick/:nick/:tsrange' and
'/interval/self/:tsrange'
0.293 2014-11-19 18:05 CET
- Dispatch/Interval.pm: let _new set EID to that of current user
if no EID specified in request body
- t/dispatch/interval.t: add tests under 'interval/new' resource
- Model/Interval.pm: sort concatenated set of intervals
- Model/Shared.pm: use tstzrange instead of tsrange
- t/model/interval_lock.t: test case for #46
0.513 2016-01-04 20:39 CET
- Implement feature "No database operations on partial intervals" (#47)
- config/: add DOCHAZKA_PARTIAL_INTERVAL_ILLEGAL_OPERATION message
- Model/Interval.pm: no database operations on partial intervals
- Implement "Test function to delete all attendance data" (#49)
- REST.pm: split insert initial set of activities code into separate function
- Model/Shared.pm->cud_generic(): make bind_params parameter optional
- REST/Test.pm: delete_all_attendance_data() function
- t/{dispatch,model}: use delete_all_attendance_data()
0.514 2016-01-05 11:41 CET
- Fix "INTERVAL DELETE operations clobber partial intervals" (#50)
- Model/Shared.pm: improve cud() and cud_generic() return status
- t/: adapt tests to current state
- config: SQL_INTERVAL_DELETE_BY_EID_AND_TSRANGE ignore partial intervals
- sql/interval_Config.pm: do not apply LIMIT when selecting partial intervals
- Dispatch.pm: fix a double my
lib/App/Dochazka/REST.pm view on Meta::CPAN
=cut
sub initialize_activities_table {
my $conn = shift;
my $status = $CELL->status_ok;
try {
$conn->txn( fixup => sub {
my $sth = $_->prepare( $site->SQL_ACTIVITY_INSERT );
foreach my $actdef ( @{ $site->DOCHAZKA_ACTIVITY_DEFINITIONS } ) {
$sth->bind_param( 1, $actdef->{code} );
$sth->bind_param( 2, $actdef->{long_desc} );
$sth->bind_param( 3, 'dbinit' );
$sth->execute;
}
} );
} catch {
$status = $CELL->status_err( 'DOCHAZKA_DBI_ERR', args => [ $_ ] );
};
return $status;
}
lib/App/Dochazka/REST.pm view on Meta::CPAN
# insert initial set of activities
$status = initialize_activities_table( $conn );
# insert initial set of components
try {
$conn->txn( fixup => sub {
my $sth = $_->prepare( $site->SQL_COMPONENT_INSERT );
foreach my $actdef ( @{ $site->DOCHAZKA_COMPONENT_DEFINITIONS } ) {
$actdef->{'validations'} = undef unless exists( $actdef->{'validations'} );
$sth->bind_param( 1, $actdef->{path} );
$sth->bind_param( 2, $actdef->{source} );
$sth->bind_param( 3, $actdef->{acl} );
$sth->bind_param( 4, $actdef->{validations} );
$sth->execute;
}
} );
} catch {
$status = $CELL->status_err( 'DOCHAZKA_DBI_ERR', args => [ $_ ] );
};
return $status unless $status->ok;
# if auditing is enabled, create the audit triggers
if ( $site->DOCHAZKA_AUDITING ) {
lib/App/Dochazka/REST.pm view on Meta::CPAN
sub get_eid_of {
my ( $conn, @nicks ) = @_;
$log->debug( "Entering " . __PACKAGE__ . "::get_eid_of" );
my ( %eids, $status );
$status = $CELL->status_ok;
try {
$conn->run( fixup => sub {
my $sth = $_->prepare( $site->DBINIT_SELECT_EID_OF );
foreach my $nick ( @nicks ) {
$sth->bind_param( 1, $nick );
$sth->execute;
( $eids{$nick} ) = $sth->fetchrow_array();
$log->debug( "EID of $nick is $eids{$nick}" );
}
} );
} catch {
$status = $CELL->status_err( 'DOCHAZKA_DBI_ERR', args => [ $_ ] );
};
die $status->text unless $status->ok;
return \%eids;
lib/App/Dochazka/REST/Auth.pm view on Meta::CPAN
# check if LDAP is enabled and if the employee exists in LDAP
if ( ! $meta->META_DOCHAZKA_UNIT_TESTING and
$site->DOCHAZKA_LDAP and
ldap_exists( $nick )
) {
$log->info( "Detected authentication attempt from $nick, a known LDAP user" );
#$log->debug( "Password provided: $password" );
# - authenticate by LDAP bind
if ( ldap_auth( $nick, $password ) ) {
# successful LDAP auth: if the employee doesn't already exist in
# the database, possibly autocreate
$status = autocreate_employee( $dbix_conn, $nick );
return $status unless $status->ok;
} else {
return $CELL->status_not_ok( 'DOCHAZKA_EMPLOYEE_AUTH' );
}
# load the employee object
lib/App/Dochazka/REST/Fillup.pm view on Meta::CPAN
sub DESTROY {
my $self = shift;
$log->debug( "Entering " . __PACKAGE__ . "::DESTROY with arguments " . join( ' ', @_ ) );
$log->notice( "GLOBAL DESTRUCTION" ) if ${^GLOBAL_PHASE} eq 'DESTRUCT';
my $status;
try {
$dbix_conn->run( fixup => sub {
my $sth = $_->prepare( $site->SQL_TEMPINTVLS_DELETE_MULTIPLE );
$sth->bind_param( 1, $self->tiid );
$sth->execute;
my $rows = $sth->rows;
if ( $rows > 0 ) {
$status = $CELL->status_ok( 'DOCHAZKA_RECORDS_DELETED', args => [ $rows ], count => $rows );
} elsif ( $rows == 0 ) {
$status = $CELL->status_warn( 'DOCHAZKA_RECORDS_DELETED', args => [ $rows ], count => $rows );
} else {
die( "\$sth->rows returned a weird value $rows" );
}
} );
lib/App/Dochazka/REST/LDAP.pm view on Meta::CPAN
no strict 'subs';
my ( $nick, $password ) = @_;
return 0 unless $nick;
$password = $password || '';
return 0 unless $site->DOCHAZKA_LDAP;
require Net::LDAP;
require Net::LDAP::Filter;
my $mesg = $ldap->bind( "$dn",
password => "$password",
);
if ( $mesg->code == 0 ) {
$ldap->unbind;
$log->info("Access granted to $nick");
return 1;
}
$log->info("Access denied to $nick because LDAP server returned code " . $mesg->code);
return 0;
}
1;
lib/App/Dochazka/REST/Model/Employee.pm view on Meta::CPAN
) unless $self->sync;
return $CELL->status_err(
'DOCHAZKA_LDAP_SYSTEM_USER_NOSYNC',
args => [ $nick ],
) if grep { $nick eq $_; } @{ $site->DOCHAZKA_SYSTEM_USERS };
$log->debug( "About to populate $nick from LDAP" );
require Net::LDAP;
# initiate connection to LDAP server (anonymous bind)
my $server = $site->DOCHAZKA_LDAP_SERVER;
my $ldap = Net::LDAP->new( $server );
$log->error("$@") unless $ldap;
return $CELL->status_err( 'Could not connect to LDAP server' ) unless $ldap;
# get LDAP properties and stuff them into the employee object
my $count = 0;
foreach my $key ( keys( %{ $site->DOCHAZKA_LDAP_MAPPING } ) ) {
my $prop = $site->DOCHAZKA_LDAP_MAPPING->{ $key };
my $value = ldap_search( $ldap, $nick, $prop );
last unless $value;
$log->debug( "Setting $key to $value" );
$self->set( $key, $value );
$count += 1;
}
$ldap->unbind;
return $CELL->status_ok(
'DOCHAZKA_LDAP_SYNC_SUCCESS',
args => [ $count ],
) unless $count < 1;
return $CELL->status_not_ok( 'DOCHAZKA_LDAP_SYNC_FAILURE' );
}
lib/App/Dochazka/REST/Model/Interval.pm view on Meta::CPAN
my $count = $status->payload->[0];
# if it's greater than or equal to the limit, no go
return $CELL->status_err( 'DOCHAZKA_INTERVAL_DELETE_LIMIT_EXCEEDED', args => [ $count ] )
if $count >= $site->DOCHAZKA_INTERVAL_DELETE_LIMIT;
return cud_generic(
conn => $conn,
eid => $eid,
sql => $site->SQL_INTERVAL_DELETE_BY_EID_AND_TSRANGE,
bind_params => [ $eid, $tsrange ],
);
}
=head2 generate_interval_summary
Given DBIx::Connector object, EID, and tsrange, generate a hash keyed on
dates (YYYY-MM-DD) in the range. The value of each key/date is another
hash keyed on activity codes. For each activity code the value is the
total number of hours spent by the employee doing that activity on the day
lib/App/Dochazka/REST/Model/Schedintvls.pm view on Meta::CPAN
# the insert operation needs to take place within a transaction,
# because all the intervals are inserted in one go
my $status;
try {
$conn->txn( fixup => sub {
my $sth = $_->prepare( $site->SQL_SCHEDINTVLS_INSERT );
my $intvls;
# the next sequence value is already in $self->{ssid}
$sth->bind_param( 1, $self->{ssid} );
# execute SQL_SCHEDINTVLS_INSERT for each element of $self->{intvls}
map {
$sth->bind_param( 2, $_ );
$sth->execute;
push @$intvls, $_;
} @{ $self->{intvls} };
$status = $CELL->status_ok(
'DOCHAZKA_SCHEDINTVLS_INSERT_OK',
payload => {
intervals => $intvls,
ssid => $self->{ssid},
}
);
lib/App/Dochazka/REST/Model/Schedintvls.pm view on Meta::CPAN
sub delete {
my $self = shift;
my ( $conn ) = validate_pos( @_,
{ isa => 'DBIx::Connector' }
);
my $status;
try {
$conn->run( fixup => sub {
my $sth = $_->prepare( $site->SQL_SCHEDINTVLS_DELETE );
$sth->bind_param( 1, $self->ssid );
$sth->execute;
my $rows = $sth->rows;
if ( $rows > 0 ) {
$status = $CELL->status_ok( 'DOCHAZKA_RECORDS_DELETED', args => [ $rows ] );
} elsif ( $rows == 0 ) {
$status = $CELL->status_warn( 'DOCHAZKA_RECORDS_DELETED', args => [ $rows ] );
} else {
die( "\$sth->rows returned a weird value $rows" );
}
} );
lib/App/Dochazka/REST/Model/Shared.pm view on Meta::CPAN
=item * object
The Dochazka datamodel object to be worked on.
=item * sql
The SQL statement to execute (should be INSERT, UPDATE, or DELETE).
=item * attrs
An array reference containing the bind values to be plugged into the SQL
statement.
=back
Returns a status object.
Important note: it is up to the programmer to not pass any SQL statement that
might affect more than one record.
=cut
lib/App/Dochazka/REST/Model/Shared.pm view on Meta::CPAN
# start transaction
$ARGS{'conn'}->txn( fixup => sub {
# get DBI db handle
my $dbh = shift;
# set the dochazka.eid GUC session parameter
$dbh->do( $site->SQL_SET_DOCHAZKA_EID_GUC, undef, ( $ARGS{'eid'}+0 ) );
# prepare the SQL statement and bind parameters
my $sth = $dbh->prepare( $ARGS{'sql'} );
my $counter = 0;
map {
$counter += 1;
$sth->bind_param( $counter, $ARGS{'object'}->{$_} );
} @{ $ARGS{'attrs'} };
# execute the SQL statement
$rv = $sth->execute;
$log->debug( "cud: DBI execute returned " . Dumper( $rv ) );
if ( $rv == 1 ) {
# a record was returned; get the values
my $rh = $sth->fetchrow_hashref;
$log->info( "Statement " . $sth->{'Statement'} . " RETURNING values: " . Dumper( $rh ) );
lib/App/Dochazka/REST/Model/Shared.pm view on Meta::CPAN
The L<DBIx::Connector> object with which to gain access to the database.
=item * eid
The EID of the employee originating the request (needed for the audit triggers).
=item * sql
The SQL statement to execute (should be INSERT, UPDATE, or DELETE).
=item * bind_params
An array reference containing the bind values to be plugged into the SQL
statement.
=back
Returns a status object.
Important note: it is up to the programmer to not pass any SQL statement that
might affect more than one record.
=cut
sub cud_generic {
my %ARGS = validate( @_, {
conn => { isa => 'DBIx::Connector' },
eid => { type => SCALAR },
sql => { type => SCALAR },
bind_params => { type => ARRAYREF, optional => 1 }, # order must match SQL statement
} );
$log->info( "Entering " . __PACKAGE__ . "::cud_generic with" );
$log->info( "sql: $ARGS{sql}" );
$log->info( "bind_param: " . Dumper( $ARGS{bind_params} ) );
my ( $status, $rv, $count );
try {
local $SIG{__WARN__} = sub {
die @_;
};
# start transaction
$ARGS{'conn'}->txn( fixup => sub {
# get DBI db handle
my $dbh = shift;
# set the dochazka.eid GUC session parameter
$dbh->do( $site->SQL_SET_DOCHAZKA_EID_GUC, undef, ( $ARGS{'eid'}+0 ) );
# prepare the SQL statement and bind parameters
my $sth = $dbh->prepare( $ARGS{'sql'} );
my $counter = 0;
map {
$counter += 1;
$sth->bind_param( $counter, $_ || undef );
} @{ $ARGS{'bind_params'} };
# execute the SQL statement
$rv = $sth->execute;
$log->debug( "cud_generic: DBI execute returned " . Dumper( $rv ) );
if ( $rv >= 1 ) {
# count number of rows affected
$count = $sth->rows;
} elsif ( $rv eq '0E0' ) {
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 => [ $_ ] );
};
lib/App/Dochazka/REST/Model/Shared.pm view on Meta::CPAN
} catch {
$status = $CELL->status_err( 'DOCHAZKA_DBI_ERR', args => [ $_ ] );
};
die "AAAAHAHAAHAAAAAAGGGH! " . __PACKAGE__ . "::select_single" unless $status;
return $status;
}
=head2 select_set_of_single_scalar_rows
Given DBIx::Connector object, an SQL statement, and a set of keys to bind
into the SQL statement, assume that the statement can return 0-n records
and that each record consists of a single field that must fit into a single
scalar value.
=cut
sub select_set_of_single_scalar_rows {
my %ARGS = validate( @_, {
conn => { isa => 'DBIx::Connector' },
sql => { type => SCALAR },
lib/App/Dochazka/REST/Model/Shared.pm view on Meta::CPAN
$log->debug( "Entering " . __PACKAGE__ . "::select_set_of_single_scalar_rows with
paramhash " . Dumper( \%ARGS ) );
my ( $status, $result_set );
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();
# push results onto $nicks
while( defined( my $tmpres = $sth->fetchrow_arrayref() ) ) {
push @$result_set, @$tmpres;
}
} );
} catch {
$log->debug( 'Encountered DBI error' );
$status = $CELL->status_err( 'DOCHAZKA_DBI_ERR', args => [ $_ ] );
lib/App/Dochazka/REST/Test.pm view on Meta::CPAN
);
is( $status->level, 'OK' );
is( $status->code, 'DOCHAZKA_CUD_OK' );
return $status unless $status->ok;
note( 'delete privhistory' );
$status = cud_generic(
conn => $dbix_conn,
eid => $site->DOCHAZKA_EID_OF_ROOT,
sql => 'DELETE FROM privhistory WHERE eid != ?',
bind_params => [ $site->DOCHAZKA_EID_OF_ROOT ],
);
is( $status->level, 'OK' );
is( $status->code, 'DOCHAZKA_CUD_OK' );
return $status unless $status->ok;
note( 'delete schedules' );
$status = cud_generic(
conn => $dbix_conn,
eid => $site->DOCHAZKA_EID_OF_ROOT,
sql => 'DELETE FROM schedules WHERE scode != \'DEFAULT\'',
lib/App/Dochazka/REST/Test.pm view on Meta::CPAN
);
is( $status->level, 'OK' );
is( $status->code, 'DOCHAZKA_CUD_OK' );
return $status unless $status->ok;
note( 'delete employees' );
$status = cud_generic(
conn => $dbix_conn,
eid => $site->DOCHAZKA_EID_OF_ROOT,
sql => 'DELETE FROM employees WHERE eid != ? AND eid != ?',
bind_params => [ $site->DOCHAZKA_EID_OF_ROOT, $site->DOCHAZKA_EID_OF_DEMO ],
);
is( $status->level, 'OK' );
is( $status->code, 'DOCHAZKA_CUD_OK' );
return $status;
}
#
# functions to perform class-specific 'create', 'retrieve', 'delete', etc. actions
( run in 0.793 second using v1.01-cache-2.11-cpan-2398b32b56e )