view release on metacpan or  search on metacpan

t/fillup.t  view on Meta::CPAN

        dry_run => [],
        emp_obj => '',
        intervals => {},
        long_desc => {},
        remark => {},
        tiid => {},
        tsrange => '',
        tsranges => '',
    );
    map 
    {
        my $throwaway = $attr_test{ $_ };
        like(
            exception { $fo->$_( $throwaway ) },
            qr/which is not one of the allowed types:/
        );
    } keys %attr_test;
}

note( $note = 'further test selected accessors non-pathological' );
$log->info( "=== $note" );

my $context = { 'heaven' => 'angel' };
$fo->context( $context  );
is( $fo->context, $context );

my $emp = App::Dochazka::REST::Model::Employee->spawn;
$fo->emp_obj( $emp );
is( $fo->emp_obj, $emp );

my $act = App::Dochazka::REST::Model::Activity->spawn;
$fo->act_obj( $act );
is( $fo->act_obj, $act );

my $dl = [ '2016-01-01', '2016-01-02', '2016-01-03' ];
$fo->date_list( $dl );
is( $fo->date_list, $dl );

$status = $CELL->status_ok( 'DOCHAZKA_ALL_GREEN' );
$fo->constructor_status( $status );
is( $fo->constructor_status, $status );

note( $note = 'further test selected accessors pathological' );
$log->info( "=== $note" );
like( 
    exception { $fo->constructor_status( App::Dochazka::REST::Model::Activity->spawn ) }, 
    qr/was not a.*it is a/
);
like( 
    exception { $fo->act_obj( $CELL->status_ok ) }, 
    qr/was not a.*it is a/
);
like( 
    exception { $fo->emp_obj( $CELL->status_ok ) }, 
    qr/was not a.*it is a/
);

note( $note = "vet empty context" );
$log->info( "=== $note" );
$status = $fo->_vet_context();
ok( $status->not_ok );

note( $note = "populate context attribute" );
$log->info( "=== $note" );
$status = $fo->_vet_context( context => $faux_context );
ok( $status->ok );

note( $note = "context should now be OK" );
$log->info( "=== $note" );
ok( $fo->context );
is( ref( $fo->context ), 'HASH' );
isa_ok( $fo->context->{dbix_conn}, 'DBIx::Connector' );

note( $note = 'quickly test canon_to_ymd' );
$log->info( "=== $note" );
my @ymd = canon_to_ymd( '2015-01-01' );
is( ref( \@ymd ), 'ARRAY' );
is( $ymd[0], '2015' );
is( $ymd[1], '01' );
is( $ymd[2], '01' );

note( $note = 'test the reset method' );
$log->info( "=== $note" );
my $saved_context = $fo->context;
$fo->reset;
my %test_attrs = %App::Dochazka::REST::Fillup::attr;
delete( $test_attrs{tiid} );
map { is( $fo->{ $_ }, undef ); } keys %test_attrs;
$fo->context( $saved_context );
is( $fo->context, $saved_context );

note( $note = 'test the _vet_date_spec method' );
$log->info( "=== $note" );
$status = $fo->_vet_date_spec(
    date_list => [ qw( 2016-01-01 2016-01-02 2016-01-03 ) ],
);
ok( $status->ok );
$status = $fo->_vet_date_spec(
    tsrange => 'bubba', # can be any scalar, not necessarily a valid tsrange
);
ok( $status->ok );
$status = $fo->_vet_date_spec(
    date_list => [ qw( 2016-01-01 2016-01-02 2016-01-03 ) ],
    tsrange => 'bubba', # can be any scalar, not necessarily a valid tsrange
);
ok( $status->not_ok );
$status = $fo->_vet_date_spec();
ok( $status->not_ok );
$status = $fo->_vet_date_spec(
    date_list => undef,
    tsrange => undef,
);
ok( $status->not_ok );
isnt( $fo->context, undef );

note( $note = 'vet some valid date lists' );
$log->info( "=== $note" );

note( $note = 'valid date list #1' );
$log->info( "=== $note" );
reset_obj( $fo );
is( $fo->date_list, undef );
is( $fo->tsrange, undef );
$dl = [ qw( 2016-01-01 2016-01-02 2016-01-03 ) ];
$status = $fo->_vet_date_list( date_list => $dl );
ok( $status->ok );
isnt( $fo->context, undef );
is_deeply( 
    $fo->date_list, 
    [ qw( 2016-01-01 2016-01-02 2016-01-03 ) ], 
    "date_list property initialized" 
);
is_deeply(
    $fo->tsrange,
    { tsrange => '["2016-01-01 00:00:00+01","2016-01-04 00:00:00+01")' }
);
is_deeply( 
    $fo->tsranges,
    [ 
        { tsrange => '["2016-01-01 00:00:00+01","2016-01-02 00:00:00+01")' }, 
        { tsrange => '["2016-01-02 00:00:00+01","2016-01-03 00:00:00+01")' }, 
        { tsrange => '["2016-01-03 00:00:00+01","2016-01-04 00:00:00+01")' }, 
    ], 
    "tsrange property initialized"
);

note( $note = 'valid date list #2' );
$log->info( "=== $note" );
reset_obj( $fo );
is( $fo->date_list, undef );
is( $fo->tsrange, undef );
$dl = [ qw( 1892-12-31 ) ];
$status = $fo->_vet_date_list( date_list => $dl );
ok( $status->ok );
is_deeply(
    $fo->date_list,
    [ qw( 1892-12-31 ) ],
    "date_list property initialized"
);
is_deeply(
    $fo->tsrange,
    { tsrange => '["1892-12-31 00:00:00+01","1893-01-01 00:00:00+01")' }
);
is_deeply(
    $fo->tsranges,
    [
        { tsrange => '["1892-12-31 00:00:00+01","1893-01-01 00:00:00+01")' },
    ],
    "tsrange property initialized"
);

note( $note = 'demonstrate how _vet_date_list does some limited canonicalizafon' );
$log->info( "=== $note" );

t/fillup.t  view on Meta::CPAN

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" );
$status = $schedhistory->insert( $faux_context );
is( $status->level, 'OK' );
is( $status->code, 'DOCHAZKA_CUD_OK' );
push my @shids_to_delete, $schedhistory->shid;
is( noof( $dbix_conn, "schedhistory" ), 1 );

note( $note = 'vet active - all green' );
$log->info( "=== $note" );
$status = $fo->_vet_employee( emp_obj => $active );
is( $status->level, "OK" );
is( $status->code, "SUCCESS" );
isa_ok( $fo->{'emp_obj'}, 'App::Dochazka::REST::Model::Employee' );
is( $fo->{'emp_obj'}->eid, $active->eid );
is( $fo->{'emp_obj'}->nick, 'active' );
my $active_obj = $fo->{'emp_obj'};

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

note( $note = 'get AID of WORK' );
$log->info( "=== $note" );
$status = App::Dochazka::REST::Model::Activity->load_by_code( $dbix_conn, 'WORK' );