view release on metacpan or  search on metacpan

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

Normalize a time entered by the user. A time can take the following forms

    HH:MM:SS
    HH:MM

and any of the two-digit forms can be fulfilled by a single digit,
for example 6:4:9 is 6:04 a.m. and nine seconds

=over

=item * single-digit forms

If a single-digit form is given, a leading zero is appended.

=item * seconds

If seconds are given, they are ignored.

=item * no validation

No attempt is made to validate the time -- this is done later, by
PostgreSQL.

=back

=cut

sub normalize_time {
    my $rt = shift;  # rt == raw time

    return '00:00' unless $rt;

    # normalize time part
    $rt =~ m/\A(?<hh>\d{1,2}):(?<mm>\d{1,2})(:\d{1,2})?\z/;
    my ( $hours, $minutes ) = ( $+{hh}, $+{mm} );
    return undef unless defined( $hours ) and defined( $minutes );
    # handle single zeroes
    $hours = '00' if $hours eq '0';
    $minutes = '00' if $minutes eq '0';
    return undef unless $hours and $minutes;
    my $nt = sprintf( "%02d:%02d", $+{hh}, $+{mm} );
    
    return "$nt";
}


=head2 parse_test

Given a reference to the PARAMHASH a command handler was called with, check
if there is a PARSE_TEST property there, and if it is true return the
full subroutine name of the caller. 

=cut

sub parse_test {
    #print ( 'parse_test arg list: ' . join( ' ', @_ ) . "\n" );
    my ( %PARAMHASH ) = @_;
    if ( $PARAMHASH{'PARSE_TEST'} ) {
        return $CELL->status_ok( 'DOCHAZKA_CLI_PARSE_TEST', 
            payload => (caller(1))[3] );
    } 
    return $CELL->status_not_ok( 'DOCHAZKA_CLI_PARSE_TEST' );
}


=head2 refresh_current_emp

REST calls are cheap, so look up C<< $current_emp >> again just to make sure.

=cut

sub refresh_current_emp {
    my $status = send_req( 'GET', 'employee/eid/' . $current_emp->eid );
    if ( $status->not_ok ) {
        $log->crit( "Problem with data integrity (current employee)" );
        return $status;
    }
    $current_emp = App::Dochazka::Common::Model::Employee->spawn( %{ $status->payload } );
    return $status;
}


=head2 rest_error

Given a non-OK status object and a string briefly identifying (for the user)
the operation during which the error occurred, construct and return a new
L<App::CELL::Status> object bearing (in the payload) a string containing the
"error report" - perhaps suitable for displaying to the user.  The code of that
object is C<REST_ERROR> and its level is taken from the passed-in status
object. The other attributes of the original (passed-in) status object are
preserved in the returned status object as follows:

    payload -> rest_payload
    uri_path -> uri_path 
    http_status -> http_status

=cut

sub rest_error {
    my ( $status, $oper_desc ) = @_;
    my $rv = "\n";
    $rv .= "Entering " . __PACKAGE__ . "::rest_error ($oper_desc)"
        if $debug_mode;

    $rv .= "Error encountered on attempted operation \"$oper_desc\"\n";

    # special handling if payload is a string
    if ( ref( $status->payload ) eq '' ) {

        $rv .= $status->payload;
        $rv .= "\n";

    } elsif ( ref( $status->payload ) eq 'HASH' ) {

        my $http_status = $status->{'http_status'} || 
                          $status->payload->{'http_code'} || 
                          "Cannot be determined";
        my $method      = $status->payload->{'http_method'} || 
                          "Cannot be determined";
        my $uri_path    = $status->payload->{'uri_path'} ||