view release on metacpan or  search on metacpan

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

use Log::Any::Adapter;
use Params::Validate qw( :all );
use Scalar::Util qw( looks_like_number );
use Try::Tiny;
use Web::MREST::CLI qw( normalize_filespec send_req );



=head1 NAME

App::Dochazka::CLI::Util - Various reusable components




=head1 PACKAGE VARIABLES AND EXPORTS

=cut

our @EXPORT_OK = qw( 
    authenticate_to_server 
    datelist_from_token
    determine_employee
    lookup_employee 
    init_logger
    init_prompt
    month_alpha_to_numeric
    normalize_date
    normalize_time
    parse_test
    refresh_current_emp 
    rest_error 
    truncate_to
);

our %month_map = (
    'jan' => 1,
    'feb' => 2,
    'mar' => 3,
    'apr' => 4,
    'may' => 5,
    'jun' => 6,
    'jul' => 7,
    'aug' => 8,
    'sep' => 9,
    'oct' => 10,
    'nov' => 11,
    'dec' => 12,
);



=head1 FUNCTIONS


=head2 authenticate_to_server

All communication between L<App::Dochazka::CLI> and the L<App::Dochazka::REST>
server goes via the C<send_req> routine in L<Web::MREST::CLI>. This
routine takes its connection parameters (address of REST server, nick and
password) from the following configuration parameters:

    $meta->MREST_CLI_URI_BASE
    $meta->CURRENT_EMPLOYEE_NICK
    $meta->CURRENT_EMPLOYEE_PASSWORD

The first parameter, C<MREST_CLI_URI_BASE>, is assumed to be set before this
routine is called. The second and third are meta parameters and are set by
this routine.

After setting the meta parameters, the routine causes a GET request for the
C<employee/self/full> resource to be send to the server, and uses the response
to initialize the C<$current_emp> and C<$current_priv> variables which are
imported from the L<App::Dochazka::CLI> package.

Takes PROPLIST with two properties:

=over

=item C<< user >>

The username to authenticate as (defaults to 'demo')

=item C<< password >>

The password to use (defaults to the value of the C<user> parameter)

=back

Since this routine returns the status object returned by the "GET
employee/self/full" request, it is actually a wrapper around C<send_req>.

=cut

sub authenticate_to_server {
    my %PROPLIST = ( 
        user => 'demo',
        @_,
    );
    $PROPLIST{'password'} = $PROPLIST{'password'} || $PROPLIST{'user'};

    $meta->set( 'CURRENT_EMPLOYEE_NICK', $PROPLIST{'user'} );
    $meta->set( 'CURRENT_EMPLOYEE_PASSWORD', $PROPLIST{'password'} );

    # get info about us
    my $status;
    try {
        $status = send_req( 'GET', '/employee/self/full' );
    } catch {
        $status = $_;
    };
    if ( !ref( $status ) ) {
        die "AGHAUFF! $status\n";
    }
    return $status unless $status->ok;

    # authentication OK, initialize package variables
    $current_emp = App::Dochazka::Common::Model::Employee->spawn( %{ $status->payload->{'emp'} } );
    $current_priv = $status->payload->{'priv'};
    return $CELL->status_ok( 'DOCHAZKA_CLI_AUTHENTICATION_OK' );
}


=head2 datelist_from_token

Takes a numeric month and a _DATELIST token - e.g. "5,6,10-13,2".

Convert the token into an array of dates and return a reference. So, upon
success, the return value will look something like this:

    [ "2015-01-01", "2015-01-06", "2015-01-22" ]

If there's a problem, writes an error message to the log and returns
undef.

=cut

sub datelist_from_token {
    my ( $token ) = @_;
    $log->debug( "Entering " . __PACKAGE__ . "::datelist_from_token with token " . Dumper( $token ) );

    if ( $prompt_month < 1 or $prompt_month > 12 ) {
        die "ASSERT ohayoa9I \$prompt_month set to illegal value";
    }

    my @datelist;
    #
    # loop as long as subtokens are left
    while ( defined( $token ) and my ( $subtoken ) = $token =~ m/^((\d{1,2})|(\d{1,2}-\d{1,2}))(?=(,|$))/ ) {

        #
        # 1. chew off the subtoken
        if ( $token =~ m/^$subtoken,/ ) {
            $token =~ s/^$subtoken,//;
        } elsif ( $token =~ m/^$subtoken$/ ) {
            $token =~ s/^$subtoken$//;
        } else {
            die "AGACDKDFLQERIIeee!";
        }

        #
        # 2. if it's a range, convert it into a list of individual dates
        if ( my ( $begin, $end ) = $subtoken =~ m/^(\d{1,2})-(\d{1,2})$/ ) {