view release on metacpan or  search on metacpan

t/fillup.t  view on Meta::CPAN

	"[ ,2014-07-14 17:00)",
        "[2014-07-14 17:15,)",
        "[2014-07-14 17:15, )",
        "[ infinity, infinity)",
	"[ infinity,2014-07-14 17:00)",
        "[2014-07-14 17:15,infinity)",
    ];
map {
        my $status = $fo->_vet_tsrange( tsrange => $_ );
        #diag( $status->level . ' ' . $status->text );
        is( $status->level, 'ERR', "$_ is a bogus tsrange" ); 
    } @$bogus;

note( $note = 'vet a too-long tsrange' );
$log->info( "=== $note" );
$status = $fo->_vet_tsrange( tsrange => '[ 2015-1-1, 2016-1-2 )' );
is( $status->level, 'ERR' );
is( $status->code, 'DOCHAZKA_FILLUP_TSRANGE_TOO_LONG' );

note( $note = 'vet a non-bogus tsrange' );
$log->info( "=== $note" );
$status = $fo->_vet_tsrange( tsrange => '[ "Jan 1, 2015", 2015-12-31 )' );
is( $status->level, 'OK' );
is( $status->code, 'SUCCESS' );
like( $fo->tsranges->[0]->{'tsrange'}, qr/^\["2015-01-01 00:00:00...","2015-12-31 00:00:00..."\)$/ );
is( $fo->tsranges->[0]->{'lower_canon'}, '2014-12-31' );
is( $fo->tsranges->[0]->{'upper_canon'}, '2016-01-01' );
is_deeply( $fo->tsranges->[0]->{'lower_ymd'}, [ 2014, 12, 31 ] );
is_deeply( $fo->tsranges->[0]->{'upper_ymd'}, [ 2016, 1, 1 ] );

note( $note = 'but not fully vetted yet' );
$log->info( "=== $note" );
ok( ! $fo->vetted );

note( $note = 'vet a non-bogus employee (no schedule)' );
$log->info( "=== $note" );
reset_obj( $fo );
$fo->_vet_date_list( date_list => [ '2016-01-01' ] );
$status = App::Dochazka::REST::Model::Employee->load_by_eid( $dbix_conn, 1 );
$status = $fo->_vet_employee( emp_obj => $status->payload );
is( $status->level, 'ERR' );
is( $status->code, 'DISPATCH_EMPLOYEE_NO_SCHEDULE' );

note( $note = 'if employee object lacks an eid property, die' );
$log->info( "=== $note" );
my $bogus_emp = App::Dochazka::REST::Model::Employee->spawn( nick => 'bogus');
like( 
    exception { $fo->_vet_employee( emp_obj => $bogus_emp ); },
    qr/AKLDWW###%AAAAAH!/,
);

note( $note = 'we do not try to vet non-existent employee objects here, because the Tempintvls' );
$log->info( "=== $note" );
note( $note = 'class is designed to be called from Dispatch.pm *after* the employee has been' );
$log->info( "=== $note" );
note( $note = 'determined to exist' );
$log->info( "=== $note" );

note( $note = 'create a testing employee with nick "active"' );
$log->info( "=== $note" );
my $active = create_bare_employee( { nick => 'active', password => 'active' } );
push my @eids_to_delete, $active->eid;

note( $note = 'vet active - no privhistory' );
$log->info( "=== $note" );
$status = $fo->_vet_employee( emp_obj => $active );
is( $status->level, 'ERR' );
is( $status->code, 'DISPATCH_EMPLOYEE_NO_PRIVHISTORY' );

note( $note = 'give active a privhistory' );
$log->info( "=== $note" );
my $ins_eid = $active->eid;
my $ins_priv = 'active';
my $ins_effective = "1892-01-01";
my $ins_remark = 'TESTING';
my $priv = App::Dochazka::REST::Model::Privhistory->spawn(
              eid => $ins_eid,
              priv => $ins_priv,
              effective => $ins_effective,
              remark => $ins_remark,
          );
is( $priv->phid, undef, "phid undefined before INSERT" );
$status = $priv->insert( $faux_context );
diag( Dumper $status->text ) if $status->not_ok;
ok( $status->ok, "Post-insert status ok" );
ok( $priv->phid > 0, "INSERT assigned an phid" );
is( $priv->remark, $ins_remark, "remark survived INSERT" );
push my @phids_to_delete, $priv->phid;

note( $note = 'vet active - no schedule' );
$log->info( "=== $note" );
$status = $fo->_vet_employee( emp_obj => $active );
is( $status->level, 'ERR' );
is( $status->code, 'DISPATCH_EMPLOYEE_NO_SCHEDULE' );

note( $note = 'create a testing schedule MON-FRI 08:00-12:00, 12:30-16:30' );
$log->info( "=== $note" );
my $schedule1 = test_schedule_model( [ 
    '[ 1998-05-04 08:00, 1998-05-04 12:00 )',
    '[ 1998-05-04 12:30, 1998-05-04 16:30 )',
    '[ 1998-05-05 08:00, 1998-05-05 12:00 )',
    '[ 1998-05-05 12:30, 1998-05-05 16:30 )',
    '[ 1998-05-06 08:00, 1998-05-06 12:00 )',
    '[ 1998-05-06 12:30, 1998-05-06 16:30 )',
    '[ 1998-05-07 08:00, 1998-05-07 12:00 )',
    '[ 1998-05-07 12:30, 1998-05-07 16:30 )',
    '[ 1998-05-08 08:00, 1998-05-08 12:00 )',
    '[ 1998-05-08 12:30, 1998-05-08 16:30 )',
] );
push my @sids_to_delete, $schedule1->sid;

note( $note = 'give active a schedhistory' );
$log->info( "=== $note" );
my $schedhistory = App::Dochazka::REST::Model::Schedhistory->spawn(
    eid => $active->eid,
    sid => $schedule1->sid,
    effective => "1892-01-01",
    remark => 'TESTING',
);
my $first_active_eid = $active->eid;
isa_ok( $schedhistory, 'App::Dochazka::REST::Model::Schedhistory', "schedhistory object is an object" );