view release on metacpan or  search on metacpan

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

    INTERVAL REPORT
    EMPLOYEE_SPEC INTERVAL REPORT
    INTERVAL DELETE
    EMPLOYEE_SPEC INTERVAL DELETE

=cut

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

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

    print Dumper( $th ) if $debug_mode;

    # determine employee
    my $status = determine_employee( $th->{'EMPLOYEE_SPEC'} );
    return $status unless $status->ok;
    my $emp = $status->payload;

    return _interval_fillup_delete_print( $th, $emp, "[ $prompt_date 00:00, $prompt_date 24:00 )" );
}

sub _interval_fillup_delete_print {
    my ( $th, $emp, $tsr ) = @_;

    if ( $th->{'FILLUP'} ) {
        my %ARGS;
        $ARGS{eid} = $emp->eid;
        $ARGS{tsrange} = $tsr;
        $ARGS{dry_run} = exists( $th->{'DRY_RUN'} ) ? 1 : 0;
        $ARGS{clobber} = 0;
        return _fillup( %ARGS );
    } elsif ( $th->{'DELETE'} ) {
        return _delete_intervals_tsrange( $emp->eid, $tsr );
    } elsif ( $th->{'SUMMARY'} ) {
        return _interval_summary( $emp->eid, $tsr );
    } elsif ( $th->{'REPORT'} ) {
        return _interval_report( $emp, $tsr );
    } else {
        return _print_intervals_tsrange( $emp, $tsr );
    }
}


=head2 Helper functions

Functions called from command handlers


=head3 _interval_new

Takes code, tsrange and, optionally, long_desc. Converts the code into an AID,
sets up and sends the "POST interval/new" REST request, and returns the
resulting status object.

=cut

sub _interval_new {
    my ( $code, $tsrange, $long_desc ) = validate_pos( @_,
        { type => SCALAR },
        { type => SCALAR },
        { type => SCALAR|UNDEF, optional => 1 },
    );

    # get aid from code
    my $status = send_req( 'GET', "activity/code/$code" );
    if ( $status->not_ok ) {
        if ( $status->code eq "DISPATCH_SEARCH_EMPTY" and
             $status->text =~ m/Search over activity with key -\>code equals .+\<- returned nothing/
        ) {
            return $CELL->status_err( 'DOCHAZKA_CLI_WRONG_ACTIVITY', args => [ $code ] );
        }
        return rest_error( $status, "Determine AID from code" ) unless $status->ok;
    }
    my $aid = $status->payload->{'aid'};

    # assemble entity
    my $entity_perl = {
        'aid' => $aid,
        'intvl' => $tsrange,
    };
    $entity_perl->{'long_desc'} = $long_desc if $long_desc;
    my $entity = encode_json $entity_perl;

    # send the request
    $status = send_req( 'POST', "interval/new", $entity );
    if ( $status->not_ok ) {
        # if ... possible future checks for common errors
        # elsif ... other common errors
        return rest_error( $status, "Insert new attendance interval" ) unless $status->ok;
    }

    return $CELL->status_ok( 'DOCHAZKA_CLI_NORMAL_COMPLETION',
        payload => _print_interval( $status->payload ) );
}


=head3 _tsrange_from_dates_and_times

Given two dates and two times, returns a full-fledged tsrange.
If the first date is undef or empty, use the prompt date.
If the second date is undef or empty, use the first date.

=cut

sub _tsrange_from_dates_and_times {
    my ( $d0, $d1, $t0, $t1 ) = @_;

    # normalize dates and times
    BREAK_OUT: {
        my $s = 1;
        my $flagged;

        # normalize_date will replace an undefined or empty date with the prompt date
        if ( $s = normalize_date( $d0 ) ) {
            $d0 = $s;
        } else {
            $flagged = $d0;
        }

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

sub _delete_intervals_tsrange {
    my ( $eid, $tsr ) = @_;
    my $status = send_req( 'DELETE', "interval/eid/$eid/$tsr" );
    return $status unless $status->ok;
    my $count = $status->{'count'};
    return $CELL->status_ok( 'DOCHAZKA_CLI_NORMAL_COMPLETION', 
        payload => "$count intervals deleted in range $tsr" );
}

=head3 _interval_summary

Given an EID and a tsrange, call the "interval/sumary/eid/:eid/:tsrange"
resource.

=cut

sub _interval_summary {
    my ( $eid, $tsr ) = @_;
    my $status = send_req( 'GET', "interval/summary/eid/$eid/$tsr" );
    return $status unless $status->ok;
    $status->code( 'DOCHAZKA_CLI_NORMAL_COMPLETION' );
    return $status;
}

=head3 _interval_report

Given an employee object and a tsrange, POST to the "genreport" resource with
an entity body: 

    { 
        "path" : "suse-cz-monthly.mc", 
        "parameters" : {
            "employee" : $EMPLOYEE_OBJECT_JSON,
            "tsrange" : "$TSRANGE"
        }
    }

=cut

sub _interval_report {
    my ( $emp, $tsr ) = @_;
    my $emp_json = JSON->new->convert_blessed->encode( $emp );
    my $entity = <<"EOS";
{ 
    "path" : "suse-cz-monthly.mc", 
    "parameters" : {
        "employee" : $emp_json,
        "tsrange" : "$tsr"
    }
}
EOS
    return shared_generate_report( $entity );
}

=head3 _fillup

=cut

sub _fillup {
    my ( %ARGS ) = validate( @_, {
        eid => { type => SCALAR },
        code => { type => SCALAR, optional => 1 },
        date_list => { type => ARRAYREF, optional => 1 },
        tsrange => { type => SCALAR, optional => 1 },
        dry_run => { type => SCALAR },
        clobber => { type => SCALAR, default => 1 },
    } );

    my $request_body = encode_json( \%ARGS );

    my $status = send_req( 'POST', "interval/fillup", $request_body );
    return $status unless $status->ok;

    my ( $pl, $count );
    if ( $status->code eq 'DISPATCH_FILLUP_INTERVALS_CREATED' ) {
        my $tmp = $status->payload->{'success'}->{'count'};
        $pl .= "$tmp intervals successfully inserted\n";
        $tmp = $status->payload->{'failure'}->{'count'};
        $pl .= "$tmp intervals not inserted due to conflicts\n";
        if ( exists( $status->payload->{'clobbered'} ) ) {
            $tmp = $status->payload->{'clobbered'}->{'count'};
            $pl .= "$tmp existing intervals clobbered\n";
        }
    }
    $count = $status->{'count'};
    return $CELL->status_ok( 'DOCHAZKA_CLI_NORMAL_COMPLETION', payload => $pl );
}

1;