view release on metacpan or  search on metacpan

lib/App/Dochazka/CLI/Commands/Schedule.pm  view on Meta::CPAN

    $memsched_scode = $th->{_TERM};

    return _dump_memsched_entries();
}


=head3 schedulespec

    SCHEDULE_SPEC
    SCHEDULE_SPEC SHOW

=cut

sub schedulespec {
    print "Entering " . __PACKAGE__ . "::schedulespec\n" if $debug_mode;
    my ( $ts, $th ) = @_;

    # parse test
    return parse_test( $ts, $th ) if $ts eq 'PARSE_TEST';

    my ( $key_spec, $key ) = $th->{'SCHEDULE_SPEC'} =~ m/^(.*)\=(.*)$/;

    my ( $status, $pl );
    if ( $key_spec =~ m/^sco/i ) {
        $status = send_req( 'GET', "schedule/scode/$key" );
    } elsif ( $key_spec =~ m/^sid/ ) {
        $status = send_req( 'GET', "schedule/sid/$key" );
    } else {
        die "AAAHAAAHHH!!! Invalid schedule lookup key " . ( defined( $key_spec ) ? $key_spec : "undefined" )
    }

    if ( $status->ok ) {
        my $sch_obj = App::Dochazka::Common::Model::Schedule->spawn( %{ $status->payload } );
        $pl = print_schedule_object( $sch_obj );
        return $CELL->status_ok( "DOCHAZKA_CLI_NORMAL_COMPLETION", payload => $pl );
    }

    return $status;
}


=head3 schedulespec_remark

    SCHEDULE_SPEC REMARK _TERM

=cut

sub schedulespec_remark {
    print "Entering " . __PACKAGE__ . "::schedulespec_remark\n" if $debug_mode;
    my ( $ts, $th ) = @_;
    
    # parse test
    return parse_test( $ts, $th ) if $ts eq 'PARSE_TEST';

    my ( $key_spec, $key ) = $th->{'SCHEDULE_SPEC'} =~ m/^(.*)\=(.*)$/;
    my $remark = $th->{'_REST'};
    $remark =~ s/\"/\'/g;

    my $status;
    if ( $key_spec =~ m/^sco/i ) {
        $status = send_req( 'PUT', "schedule/scode/$key", <<"EOS" );
{ "remark" : "$remark" }
EOS
    } elsif ( $key_spec =~ m/^sid/ ) {
        $status = send_req( 'PUT', "schedule/sid/$key", <<"EOS" );
{ "remark" : "$remark" }
EOS
    } else {
        die "AAAHAAAHHH!!! Invalid schedule lookup key " . ( defined( $key_spec ) ? $key_spec : "undefined" )
    }

    if ( $status->level eq 'OK' and $status->code eq 'DOCHAZKA_CUD_OK' ) {
        my $sch_obj = App::Dochazka::Common::Model::Schedule->spawn( %{ $status->payload } );
        my $pl = print_schedule_object( $sch_obj );
        return $CELL->status_ok( 'DOCHAZKA_CLI_NORMAL_COMPLETION', payload => $pl );
    }

    return $status;
}

=head3 schedulespec_scode

    SCHEDULE_SPEC SCODE _TERM

=cut

sub schedulespec_scode {
    print "Entering " . __PACKAGE__ . "::schedulespec_scode\n" if $debug_mode;
    my ( $ts, $th ) = @_;
    
    # parse test
    return parse_test( $ts, $th ) if $ts eq 'PARSE_TEST';

    my ( $key_spec, $key ) = $th->{'SCHEDULE_SPEC'} =~ m/^(.*)\=(.*)$/;
    my $scode = $th->{'_TERM'};

    my $status;
    if ( $key_spec =~ m/^sco/i ) {
        $status = send_req( 'PUT', "schedule/scode/$key", <<"EOS" );
{ "scode" : "$scode" }
EOS
    } elsif ( $key_spec =~ m/^sid/ ) {
        $status = send_req( 'PUT', "schedule/sid/$key", <<"EOS" );
{ "scode" : "$scode" }
EOS
    } else {
        die "AAAHAAAHHH!!! Invalid schedule lookup key " . ( defined( $key_spec ) ? $key_spec : "undefined" )
    }

    if ( $status->level eq 'OK' and $status->code eq 'DOCHAZKA_CUD_OK' ) {
        my $sch_obj = App::Dochazka::Common::Model::Schedule->spawn( %{ $status->payload } );
        my $pl = print_schedule_object( $sch_obj );
        return $CELL->status_ok( 'DOCHAZKA_CLI_NORMAL_COMPLETION', payload => $pl );
    }

    return $status;
}



=head2 Helper functions

Functions called by multiple command handlers


=head3 _canonicalize_th

The canonical form is "SCHEDULE _DOW _TIME _DOW1 _TIME1"
so if we get one of the other forms, we "canonicalize th"

=cut

sub _canonicalize_th {
    my $th = shift;
    print "Entering " . __PACKAGE__ . "::_canonicalize_th with th: " . Dumper( $th ) . "\n" if $debug_mode;

    my ( $dow_begin, $dow_end, $time_begin, $time_end );

    $dow_begin = uc( $th->{'_DOW'} );
    if ( $th->{_TIMERANGE} ) {
        $dow_end = $dow_begin;
        ( $time_begin, $time_end ) = $th->{_TIMERANGE} =~ m/(.*)-(.*)/;
    } else {
        $dow_end = uc( $th->{'_DOW1'} );
        $time_begin = $th->{'_TIME'};
        $time_end = $th->{'_TIME1'};
    }
    my ( $tbh, $tbm ) = $time_begin =~ m/(.*):(.*)/;
    $time_begin = sprintf( "%02d:%02d", $tbh, $tbm );
    my ( $teh, $tem ) = $time_end =~ m/(.*):(.*)/;
    $time_end = sprintf( "%02d:%02d", $teh, $tem );

    return ( $dow_begin, $dow_end, $time_begin, $time_end );
}


=head3 _clear_memsched_entries

Since clear_memsched_entries is a command handler, if we want to call it from
within this module we have to use a special argument. Thus we can have our cake
and eat it, too.

=cut