view release on metacpan or  search on metacpan

t/dispatch/interval_lock.t  view on Meta::CPAN

note( 'delete all intervals in tsrange [1980-01-02 00:00, 1980-01-05 24:00)' );
$status = req( $test, 200, 'active', 'DELETE', 'interval/self/[1980-01-02 00:00, 1980-01-05 24:00)' );
is( $status->level, 'OK' );
is( $status->code, 'DOCHAZKA_CUD_OK' );
is( $status->{'count'}, 2 );
is( $status->{'DBI_return_value'}, 2 );

note( '=============================' );
note( 'interval/iid" resource' );
note( '"lock/lid" resource' );
note( '=============================' );
foreach my $il ( qw( interval lock ) ) {
    my $base = "$il/$idmap{$il}";
    docu_check($test, "$base");
    
    note( 'GET, PUT' );
    foreach my $method ( 'GET', 'PUT' ) {
        note( 'Testing method: $method' );
        foreach my $user ( 'demo', 'active', 'root', 'WOMBAT5', 'WAMBLE owdkmdf 5**' ) {
            req( $test, 405, $user, $method, $base );
        }
    }
    
    note( 'POST' );
    my $test_id = ( $il eq 'interval' ) ? $test_iid : $test_lid;
    # 
    note( 'test if expected behavior behaves as expected (update)' );
    my $int_obj = <<"EOH";
{ "$idmap{$il}" : $test_id, "remark" : "Sharpening pencils" }
EOH
    req( $test, 403, 'demo', 'POST', $base, $int_obj );
    req( $test, 403, 'inactive', 'POST', $base, $int_obj );

    if ( $il eq 'interval' ) {
         $status = req( $test, 200, 'active', 'POST', $base, $int_obj );
         if ( $status->not_ok ) {
             diag( "MARK foo1" );
             diag( Dumper $status );
             BAIL_OUT(0);
         }
         is( $status->level, 'OK', "POST $base 3" );
         is( $status->code, 'DOCHAZKA_CUD_OK', "POST $base 4" );
         is( $status->payload->{'iid'}, $test_iid, "POST $base 5" );
         is( $status->payload->{'remark'}, 'Sharpening pencils', "POST $base 7" );
    } else {
         req( $test, 403, 'active', 'POST', $base, $int_obj );
    }

    note( 'non-existent ID and also out of range' );
    $int_obj = <<"EOH";
{ "$idmap{$il}" : 3434342342342, "remark" : 34334342 }
EOH
    dbi_err( $test, 500, 'root', 'POST', $base, $int_obj, qr/out of range for type integer/ );
    
    note( 'non-existent ID' );
    $int_obj = <<"EOH";
{ "$idmap{$il}" : 342342342, "remark" : 34334342 }
EOH
    req( $test, 404, 'root', 'POST', $base, $int_obj );
    
    note( 'throw a couple curve balls: weirded object' );
    my $weirded_object = '{ "copious_turds" : 555, "long_desc" : "wang wang wazoo", "disabled" : "f" }';
    req( $test, 400, 'root', 'POST', $base, $weirded_object );
    
    note( 'throw a couple curve balls: no closing bracket' );
    my $no_closing_bracket = '{ "copious_turds" : 555, "long_desc" : "wang wang wazoo", "disabled" : "f"';
    req( $test, 400, 'root', 'POST', $base, $no_closing_bracket );
    
    note( 'throw a couple curve balls: weirded object 2' );
    $weirded_object = "{ \"$idmap{$il}\" : \"!!!!!\", \"remark\" : \"down it goes\" }";
    dbi_err( $test, 500, 'root', 'POST', $base, $weirded_object, qr/invalid input syntax for type integer/ );
    
    note( 'can a different active employee edit active\'s interval?' );
    note( 'let bubba try it' );
    req( $test, 403, 'bubba', 'POST', "$il/$idmap{$il}", <<"EOH" );
{ "$idmap{$il}" : $test_id, "remark" : "mine" }
EOH

    note( 'can a different active employee edit active\'s interval?' );
    note( 'let active\'s supervisor try it' );
    req( $test, 403, 'super', 'POST', "$il/$idmap{$il}", <<"EOH" );
{ "$idmap{$il}" : $test_id, "remark" : "super was here" }
EOH

    note( 'now root will try to post an illegal interval' );
    dbi_err( $test, 500, 'root', 'POST', "$il/$idmap{$il}", <<"EOH", $illegal );
{ "$idmap{$il}" : $test_id, "intvl" : "(-infinity, today)" }
EOH
    
    note( 'unbounded tsrange' );
    dbi_err( $test, 500, 'root', 'POST', "$il/$idmap{$il}", 
        "{ \"$idmap{$il}\" : $test_id, \"intvl\" : \"[1957-01-01 00:00,)\" }", $illegal );
    
    note( 'DELETE' );
    req( $test, 405, 'demo', 'DELETE', $base );
    req( $test, 405, 'root', 'DELETE', $base );
    req( $test, 405, 'WOMBAT5', 'DELETE', $base );
}


note( "=============================" );
note( '"interval/iid/:iid" resource' );
note( '"lock/lid/:lid" resource' );
note( "=============================" );
foreach my $il ( qw( interval lock ) ) {
    my $base = "$il/$idmap{$il}";
    docu_check($test, "$base/:$idmap{$il}");

    my $test_id = ( $il eq 'interval' ) ? $test_iid : $test_lid;
    
    note( 'GET' );
    note( 'fail as demo 403' );
    req( $test, 403, 'demo', 'GET', "$base/$test_id" );
    
    note( 'succeed as active IID 1' );
    $status = req( $test, 200, 'active', 'GET', "$base/$test_id" );
    ok( $status->ok, "GET $base/:iid 2" );
    ok( $status->{'payload'} );
    is( $status->payload->{$idmap{$il}}, $test_id );
    is( $status->payload->{'eid'}, $eid_active );
    ok( $status->payload->{'intvl'} );
    if ( $il eq 'interval' ) {
        ok( $status->payload->{'aid'} );
        ok( exists $status->payload->{'long_desc'} );
        ok( $status->payload->{'remark'} );
        ok( ! defined $status->payload->{'long_desc'} );
    }
    
    note( 'fail invalid ID' );