view release on metacpan or  search on metacpan

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

    return $CELL->status_ok( 'UNDER_CONSTRUCTION' );    
}


=head3 show_schedule_as_at

    SCHEDULE
    EMPLOYEE_SPEC SCHEDULE
    SCHEDULE _DATE
    EMPLOYEE_SPEC SCHEDULE _DATE

=cut

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

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

    return show_as_at( 'schedule', $th );
}


=head3 add_memsched_entry

    SCHEDULE _DOW _TIME _DOW1 _TIME1
    SCHEDULE _DOW _TIME _HYPHEN _DOW1 _TIME1
    SCHEDULE _DOW _TIMERANGE

=cut

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

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

    my ( $dow_begin, $dow_end, $time_begin, $time_end ) = _canonicalize_th( $th );
    my ( $date_begin, $date_end ) = ( $dow_map{$dow_begin}, $dow_map{$dow_end} );

    if ( exists( $memsched->{"$date_begin $time_begin"} ) ) {
        push @{ $memsched->{"$date_begin $time_begin"} }, "$date_end $time_end"
            unless grep { $_ eq "$date_end $time_end" } @{ $memsched->{"$date_begin $time_begin"} };
    } else {
        $memsched->{"$date_begin $time_begin"} = [ "$date_end $time_end" ];
    }

    print Dumper( $memsched ) if $debug_mode;

    return _dump_memsched_entries();
}


=head3 replicate_memsched_entry

    SCHEDULE ALL _TIMERANGE

Apply timerange to all five days MON-FRI

=cut

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

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

    foreach my $dow ( qw( MON TUE WED THU FRI ) ) {
        $th->{_DOW} = $dow;
        add_memsched_entry( $ts, $th );
    }

    return _dump_memsched_entries();
}


=head3 clear_memsched_entries

    SCHEDULE CLEAR

=cut

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

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

    $memsched = {};
    $memsched_scode = '';
    return $CELL->status_ok( 'DOCHAZKA_CLI_MEMSCHED_EMPTY' );
}


=head3 fetch_all_schedules

    SCHEDULES FETCH ALL 
    SCHEDULES FETCH ALL DISABLED

Get all schedules and dump them to the screen.

=cut

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

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

    my $status = ( $th->{DISABLED} )
        ? send_req( 'GET', 'schedule/all/disabled' )
        : send_req( 'GET', 'schedule/all' );
    if ( $status->ok ) {
        my $pl = '';
        foreach my $sch_hash ( @{ $status->payload } ) {