App-Dochazka-CLI
view release on metacpan or search on metacpan
- fix bug "'get employee NON-EXISTENT-NICK' should produce an error message;
instead, it says 'undef'"
0.006 2014-08-10 18:37 CEST
- Build.PL: add dependency HTTP::Cookies
- bin/dochazka-cli: use App::Dochazka::Model::Employee instead of inheriting from it
- HTTP.pm: construct LWP::UserAgent object with cookie_jar
- config/CLI_Config.pm: make a proper _Config.pm file for the application
0.007 2014-08-10 20:12 CEST
- bin/dochazka-cli: prompt for nick/password if not given in site configuration
- HTTP.pm: add 'init_ua' and 'cookie_jar' functions, use nick/password
prompted from user if not given in site config
- Parser.pm: add GET COO[KIES]
- Build.PL: update dependencies
0.008 2014-08-10 22:51 CEST
- fix bug "bin/dochazka-cli throws 'Odd number of arguments' error at startup"
0.009 2014-08-10 22:56 CEST
- Parser.pm: add GET SES[SION]
0.010 2014-08-11 16:15 CEST
0.011 2014-10-17 23:01 CEST
- Build.PL: add Getopt::Long dependency
- get user and password from command-line options instead of from site
configuration
0.012 2014-10-18 10:06 CEST
- process command-line options: 'help', 'user', 'password'
- add dependencies: Getopt::Long, Pod::Usage
- log to $HOME/.dochazka-cli.log by default, user can override in /etc/dochazka-cli
- prompt for password if none specified on command line
0.013 2014-10-19 07:55 CEST
- CLI.pm: document commands and their syntax
- Parser.pm: work on top-level GET commands
0.014 2014-10-19 08:44 CEST
- move command POD to Parser.pm where it belongs
- Parser.pm: add a couple more top-level GET commands
0.015 2014-10-19 13:35 CEST
command
0.027 2014-10-24 10:58 CEST
- complete development workflow for employee resources
- Parser.pm: add missing documentation and commands
0.028 2014-10-24 15:27 CEST
- Parser.pm: add privhistory commands
0.029 2014-10-24 22:34 CEST
- bin/dochazka-cli: fix bug "hitting ENTER at CLI prompt causes over a
screenful of error messages to be displayed"
- Parser.pm: document and implement commands:
- PUT PRIVHISTORY EID
- PUT PRIVHISTORY NICK
- DELETE PRIVHISTORY EID
- DELETE PRIVHISTORY NICK
0.030 2014-10-25 12:05 CEST
- bin/dochazka-cli: write a proper SYNOPSIS; add an optional 'sitedir'
command-line option; fix bug "dochazka-cli refuses to start unless
0.171 2015-04-15 10:15 CEST
- make history commands take _DATE only (instead of deprecated _DATESTAMP)
0.172 2015-04-15 10:30 CEST
- get rid of _DATESTAMP completely, replace it with _TIMESTAMP
- replace the old _TIMESTAMP with _TIMESTAMPDEPR
0.173 2015-04-15 20:08 CEST
- Build.PL: bring in Date::Calc dependency
- CLI.pm, bin/dochazka-cli: re-name "prompt date" package variable from
$current_date to $prompt_date
- Util.pm, t/util/ts.t: split normalize_timestamp into normalize_date and
normalize_time; handle offsets
- CommandMap.pm, Commands/Interval.pm, t/parser/commands.t: re-vamp interval
insertion commands; use normalize_date and normalize_time
0.174 2015-04-16 07:12 CEST
- Commands/Interval.pm: eliminate some code duplication
- CommandMap.pm: add some new interval insertion commands
- CLI_Message_en.conf: add some proper error messages
- Util.pm: make argument processing more robust
- t/cmd_active/interval.t: start developing functional tests of INTERVAL
commands
- Commands/Interval.pm: eliminate more code duplication; arrive at a name
_tsrange_from_dates_and_times for helper function; add _print_interval helper
function
- Util.pm: make 'init_cli_client' call init_timepiece()
0.176 2015-04-16 14:07 CEST
- bin/dochazka-cli, Util.pm: special handling of REST_ERROR status code
- CommandMap.pm: re-vamp commands for fetching intervals
- Commands/Interval.pm: implement "interval_fetch_promptdate" handler,
"_print_intervals_tsrange" helper function
- TokenMap.pm: add months of the year
0.177 2015-04-16 15:13 CEST
- Commands/Misc.pm: new module for miscellaneous command handlers
- add commands (PROMPT, PROMPT DATE) for changing the prompt date
- Util.pm: add write 'determine_employee' routine
- CommandMap.pm, Commands/Interval.pm: add "EMPLOYEE_SPEC ..." variants for
"INTERVAL", "INTERVAL FETCH", and "INTERVAL _DATE"
- Commands/Employee.pm: eliminate code duplication by using determine_employee
- t/parser/commands.t: adapt to current state
0.178 2015-04-16 18:31 CEST
- Commands/Interval.pm: display fetched intervals in table form
0.179 2015-04-17 13:22 CEST
instead of tsrange
0.184 2015-04-18 20:03 CEST
- bin/dochazka-cli: use Data::Dumper to display payload when status is OK and
payload is not a number or string
- add INTERVAL FILLUP commands (piggyback on INTERVAL FETCH)
0.185 2015-04-27 16:59 CEST
- give active testing employee a schedule already in t/001-init.t;
get rid of unintuitive t/cmd_active/001-init.t
- use prompt date (century, year, month, etc.) instead of current date
(century, year, month, etc.)
- Test.pm: add a 'delete_interval' test routine
- t/cmd_active/interval.t: expand unit; use imported 'delete_interval' routine;
test that "PROMPT 2015-01-01" does change all the $prompt_... variables
0.186 2015-04-28 17:34 CEST
- t/util/: add two new units auth.t and determine_employee.t
- Util.pm: abolish 'quiet' parameter to authenticate_to_server and make routine
completely mute; validate a parameter; document routines better; refactor
authenticate_to_server for code readability and more reasonable return value;
lookup_employee: fix bugs uncovered by unit testing
- bin/dochazka-cli: move in authentication announcement from
authenticate_to_server
0.187 2015-04-29 19:47 CEST
- Util.pm, t/util/ts.t: more documentation improvement; remove deprecated
tsrange_from_timestamps routine; use $prompt_year instead of $current_year;
eliminate deprecated $current_{year,century,month} package variables
- CommandMap.pm, Parser.pm: move functions from CommandMap.pm to Parser.pm;
improve description of the semantic tree
- t/cmd_active/interval.t: add tests to fetch intervals created by this unit
- t/parser/: test generate_semantic_tree documentation
0.188 2015-04-29 20:43 CEST
- CLI.pm, Test.pm: improve readability
- t/util/truncate.t: unit tests for 'truncate_to'
authenticate_to_server(), because it might result in "plan skip_all"
0.193 2015-07-01 17:13 CEST
- implement REST test and normal commands for 'employee/team',
'employee/eid/:eid/team' and 'employee/nick/:nick/team' resources
0.194 2015-07-01 22:39 CEST
- implement "EMPLOYEE TEAM" and "EMPLOYEE_SPEC TEAM" commands
0.195 2015-07-04 19:43 CEST
- bin/dochazka-cli: honor sitedir option; prompt for password
0.196 2015-07-04 22:12 CEST
- bin/dochazka-cli: use init_prompt() instead of init_timepiece()
- bin/dochazka-cli: initialize prompt date every time prompt is displayed
- Util.pm: import init_timepiece() from App::Dochazka
- Util.pm: implement init_prompt()
- Commands/Misc.pm: use init_prompt() instead of init_timepiece()
0.197 2015-07-05 14:19 CEST
- bin/dochazka-cli: $sitedir fall back to /etc/dochazka-cli
- require latest version of App::Dochazka for $today
- change Supervisor: to Reports to: in EMPLOYEE PROFILE output
0.198 2015-07-21 16:13 CEST
- Define $VERSION only in CLI.pm and Guide.pm
- Rename App::Dochazka::Common and update copyright statement
0.199 2015-07-22 14:51 CEST
- Convert MREST_CLI_URI_BASE to a meta param
- bin/dochazka-cli
- get home directory using File::HomeDir
- add --version option and take optional URL as argument
- prompt for username and password if not supplied
0.200 2015-07-23 08:54 CEST
- Util.pm: modify lookup_employee() to take hash of properties ...
- t/: make sure config is loaded in test suite
- Util.pm and t/: Rename App::Dochazka to App::Dochazka::Common
- Build.PL: rename App::Dochazka to App::Dochazka::Common
- bin/dochazka-cli: do not display password as it is typed and ignore password
stored in config if username not taken from config
- Do not generate Makefile.PL anymore
- bin/dochazka-cli: become aware of non-interactive usage
0.222 2016-01-12 00:41 CET
- MANIFEST.SKIP: avoid docker/ directory
- docker/: add Dockerization
- Testers.pm: a place to hold instructions for volunteer testers
- Testers.pm: first test is to meet the prerequisites
0.223 2016-01-12 15:26 CET
- Testers.pm: have them first login with demo/demo
- bin/dochazka-cli: show prompt/commands in non-interactive mode
- CLI/Testers.pm: add testing session 1
0.224 2016-01-14 13:10 CET
- Build.PL: require Web::MREST::CLI 0.279 for bugfixes
- bin/dochazka-cli: add rudimentary custom completion function
https://github.com/smithfarm/dochazka-cli/issues/27 Fixes: #27
- CLI/Guide.pm: remove VERSION
0.225 2016-01-14 17:19 CET
- bin/dochazka-cli: tell JSON to not decode UTF-8
bin/dochazka-cli view on Meta::CPAN
# POSSIBILITY OF SUCH DAMAGE.
# *************************************************************************
#
# Dochazka CLI script
#
use 5.012;
use strict;
use warnings;
use App::CELL qw( $CELL $log $site $meta );
use App::Dochazka::CLI qw( $debug_mode $current_emp $current_priv $prompt_date );
use App::Dochazka::CLI::Completion qw( dochazka_cli_completion );
use App::Dochazka::CLI::Parser qw( process_command );
use App::Dochazka::CLI::Util qw( authenticate_to_server init_logger init_prompt );
use App::Dochazka::Common::Model::Employee;
use Data::Dumper;
use File::HomeDir;
use Getopt::Long 2.32;
use JSON;
use Pod::Usage;
use Term::ReadKey;
use Term::ReadLine;
use Web::MREST::CLI qw( init_cli_client );
bin/dochazka-cli view on Meta::CPAN
$log->init(
ident => "DochazkaCLI",
debug_mode => 1,
);
my $server = '';
my $home = File::HomeDir->my_home;
my $noauth = 0;
my $versionparam = 0;
sub get_prompt {
init_prompt();
if ( $noauth ) {
return "App::Dochazka::CLI> ";
} else {
return "Dochazka($prompt_date) " . $current_emp->nick . " " . uc $current_priv . "> ";
}
}
sub printversion {
print "App::Dochazka::CLI version $App::Dochazka::CLI::VERSION\n";
exit(0);
}
# -------------------------------------------------------------------------
bin/dochazka-cli view on Meta::CPAN
distro => 'App-Dochazka-CLI',
sitedir => [ @sitedirs ],
early_debug => $early_debug,
);
if ( $status->not_ok ) {
print $status->code . ' (' . $status->level . ') ' . $status->text . "\n";
print "Response: " . Dumper( $status->payload ) . "\n";
exit;
}
init_logger();
init_prompt();
# determine server
if ( ! ( $server = $ARGV[0] ) ) {
if ( $server = $meta->MREST_CLI_URI_BASE ) {
print "URI base $server set from site configuration\n";
} else {
$server = 'http://localhost:5000';
print "URI base not set; defaulting to $server\n";
}
}
bin/dochazka-cli view on Meta::CPAN
# paraphrased from https://metacpan.org/source/HAYASHI/Term-ReadLine-Gnu-1.26/eg/fileman
sub initialize_readline {
my $term = new Term::ReadLine 'dochazka-cli';
$term->Attribs->{completion_function} = \&dochazka_cli_completion;
return $term;
}
my $term = initialize_readline() if $interactive;
my $readline = $interactive
? sub { $term->readline( get_prompt() ) }
: sub {
my $line = <STDIN>;
return unless defined($line);
print get_prompt() . $line;
return $line;
};
binmode STDOUT, ":utf8";
my $cmd;
COMMAND: while ( defined ( $cmd = $readline->() ) ) {
my $rv = process_command( $cmd );
config/CLI_Config.pm view on Meta::CPAN
# -----------------------------------
# Dochazka-CLI
# -----------------------------------
# CLI_Config.pm
#
# Main configuration file
# -----------------------------------
# DOCHAZKA_REST_LOGIN_NICK
# nick to use when we authenticate ourselves to the App::Dochazka::REST server
# when this is set to '' or undef, App::Dochazka::CLI will prompt for it
set( 'DOCHAZKA_REST_LOGIN_NICK', undef );
# DOCHAZKA_REST_LOGIN_NICK
# password to use when we authenticate ourselves to the App::Dochazka::REST server
# when this is set to '' or undef, App::Dochazka::CLI will prompt for a password
# WARNING: PUTTING YOUR PASSWORD HERE MAY BE CONVENIENT, BUT IS PROBABLY UNSAFE
set( 'DOCHAZKA_REST_LOGIN_PASSWORD', undef );
# MREST_CLI_COOKIE_JAR
# default location of the cookie jar
set( 'MREST_CLI_COOKIE_JAR', "$ENV{HOME}/.cookies.txt" );
# DOCHAZKA_CLI_LOG_FILE
# default location of the log file
set( 'DOCHAZKA_CLI_LOG_FILE', "$ENV{HOME}/.dochazka-cli.log" );
ext/CLI_SiteConfig.pm.example view on Meta::CPAN
# The first argument to "set()" is the name of the configuration parameter, and
# the second argument is its value. The values shown below are the defaults.
#
# To keep the default value, do nothing.
#
# To override a default, uncomment the "set" call and change the value.
#
# DOCHAZKA_REST_LOGIN_NICK
# nick to use when we authenticate ourselves to the App::Dochazka::REST server
# when this is set to '' or undef, App::Dochazka::CLI will prompt for it
#set( 'DOCHAZKA_REST_LOGIN_NICK', undef );
# DOCHAZKA_REST_LOGIN_NICK
# password to use when we authenticate ourselves to the App::Dochazka::REST server
# when this is set to '' or undef, App::Dochazka::CLI will prompt for a password
# WARNING: PUTTING YOUR PASSWORD HERE MAY BE CONVENIENT, BUT IS PROBABLY UNSAFE
#set( 'DOCHAZKA_REST_LOGIN_PASSWORD', undef );
# MREST_CLI_COOKIE_JAR
# default location of the cookie jar
#set( 'MREST_CLI_COOKIE_JAR', "$ENV{HOME}/.cookies.txt" );
# DOCHAZKA_CLI_LOG_FILE
# default location of the log file
#set( 'DOCHAZKA_CLI_LOG_FILE', "$ENV{HOME}/.dochazka-cli.log" );
lib/App/Dochazka/CLI.pm view on Meta::CPAN
The L<App::Dochazka::Common::Model::Employee> object of the current employee.
=item * C<< $current_priv >>
The privlevel of the current employee.
=item * C<< $debug_mode >>
Tells parser whether to display debug messages
=item * C<< $prompt_century >>
The century component of C<< $prompt_date >>; see L<App::Dochazka::CLI::Util>
=item * C<< $prompt_date >>
The date displayed in the prompt -- see C<bin/dochazka-cli> and L<App::Dochazka::CLI::Util>
=item * C<< $prompt_day >>
The day component of C<< $prompt_date >>; see L<App::Dochazka::CLI::Util>
=item * C<< $prompt_month >>
The month component of C<< $prompt_date >>; see L<App::Dochazka::CLI::Util>
=item * C<< $prompt_year >>
The year component of C<< $prompt_date >>; see L<App::Dochazka::CLI::Util>
=back
=cut
our @EXPORT_OK = qw(
$current_emp
$current_priv
$debug_mode
$prompt_century
$prompt_date
$prompt_day
$prompt_month
$prompt_year
);
our (
$current_emp,
$current_priv,
$debug_mode,
$prompt_date,
$prompt_century,
$prompt_year,
$prompt_month,
$prompt_day,
);
1;
lib/App/Dochazka/CLI/CommandMap.pm view on Meta::CPAN
dump_schedule_history
set_history_remark
);
use App::Dochazka::CLI::Commands::Interval qw(
interval_date
interval_date_date1
interval_datelist
interval_tsrange
interval_month
interval_num_num1
interval_promptdate
interval_new_date_time_date1_time1
interval_new_time_time1
interval_new_timerange
);
use App::Dochazka::CLI::Commands::Misc qw(
change_prompt_date
noop
);
use App::Dochazka::CLI::Commands::Priv qw(
show_priv_as_at
);
use App::Dochazka::CLI::Commands::Schedule qw(
add_memsched_entry
assign_memsched_scode
clear_memsched_entries
dump_memsched_entries
lib/App/Dochazka/CLI/CommandMap.pm view on Meta::CPAN
"EMPLOYEE_SPEC SET SCHEDULE_SPEC _DATE" => \&add_schedule_history,
"EMPLOYEE_SPEC SET SCHEDULE_SPEC EFFECTIVE _DATE" => \&add_schedule_history,
"PHISTORY_SPEC REMARK" => \&set_history_remark,
"PHISTORY_SPEC SET REMARK" => \&set_history_remark,
"SHISTORY_SPEC REMARK" => \&set_history_remark,
"SHISTORY_SPEC SET REMARK" => \&set_history_remark,
# Interval commands
# fetch/fillup intervals
"INTERVAL" => \&interval_promptdate,
"EMPLOYEE_SPEC INTERVAL" => \&interval_promptdate,
"INTERVAL FETCH" => \&interval_promptdate,
"EMPLOYEE_SPEC INTERVAL FETCH" => \&interval_promptdate,
"INTERVAL FILLUP" => \&interval_promptdate,
"EMPLOYEE_SPEC INTERVAL FILLUP" => \&interval_promptdate,
"INTERVAL FILLUP DRY_RUN" => \&interval_promptdate,
"EMPLOYEE_SPEC INTERVAL FILLUP DRY_RUN" => \&interval_promptdate,
"INTERVAL SUMMARY" => \&interval_promptdate,
"EMPLOYEE_SPEC INTERVAL SUMMARY" => \&interval_promptdate,
"INTERVAL REPORT" => \&interval_promptdate,
"EMPLOYEE_SPEC INTERVAL REPORT" => \&interval_promptdate,
"INTERVAL DELETE" => \&interval_promptdate,
"EMPLOYEE_SPEC INTERVAL DELETE" => \&interval_promptdate,
"INTERVAL _DATE" => \&interval_date,
"EMPLOYEE_SPEC INTERVAL _DATE" => \&interval_date,
"INTERVAL FETCH _DATE" => \&interval_date,
"EMPLOYEE_SPEC INTERVAL FETCH _DATE" => \&interval_date,
"INTERVAL FILLUP _DATE" => \&interval_date,
"EMPLOYEE_SPEC INTERVAL FILLUP _DATE" => \&interval_date,
"INTERVAL FILLUP DRY_RUN _DATE" => \&interval_date,
"EMPLOYEE_SPEC INTERVAL FILLUP DRY_RUN _DATE" => \&interval_date,
"INTERVAL SUMMARY _DATE" => \&interval_date,
lib/App/Dochazka/CLI/CommandMap.pm view on Meta::CPAN
# Lock commands
# Priv commands
"PRIV" => \&show_priv_as_at,
"PRIV _DATE" => \&show_priv_as_at,
"EMPLOYEE_SPEC PRIV" => \&show_priv_as_at,
"EMPLOYEE_SPEC PRIV _DATE" => \&show_priv_as_at,
# Prompt date commands
"PROMPT _DATE" => \&change_prompt_date,
"PROMPT DATE _DATE" => \&change_prompt_date,
# Schedule commands
"SCHEDULE ALL" => \&schedule_all,
"SCHEDULE ALL DISABLED" => \&schedule_all,
"SCHEDULE" => \&show_schedule_as_at,
"SCHEDULE _DATE" => \&show_schedule_as_at,
"EMPLOYEE_SPEC SCHEDULE" => \&show_schedule_as_at,
"EMPLOYEE_SPEC SCHEDULE _DATE" => \&show_schedule_as_at,
"SCHEDULE _DOW _TIME _DOW1 _TIME1" => \&add_memsched_entry,
"SCHEDULE _DOW _TIME _HYPHEN _DOW1 _TIME1" => \&add_memsched_entry,
lib/App/Dochazka/CLI/Commands/Employee.pm view on Meta::CPAN
sub _set_password {
my %PH = @_;
my $eid = $PH{'eid'};
my $newpass = $PH{'password'};
print "It is important that the new password really be what you intended.\n";
print "Therefore, we are going to ask you to enter the desired password\n";
print "twice, so you have a chance to double-check. ";
print "\n\n";
# prompt for new password and ask nicely for confirmation
if ( ! $newpass ) {
ReadMode ('noecho');
print "New password : ";
chomp( $newpass = <> );
ReadMode ('restore');
print "\n";
}
ReadMode ('noecho');
print "New password again: ";
chomp( my $confirm = <> );
lib/App/Dochazka/CLI/Commands/Interval.pm view on Meta::CPAN
package App::Dochazka::CLI::Commands::Interval;
use 5.012;
use strict;
use warnings;
use App::CELL qw( $CELL $log );
use App::Dochazka::CLI qw(
$current_emp
$debug_mode
$prompt_date
$prompt_month
$prompt_year
);
use App::Dochazka::CLI::Shared qw( shared_generate_report );
use App::Dochazka::CLI::Util qw(
datelist_from_token
determine_employee
month_alpha_to_numeric
normalize_date
normalize_time
parse_test
refresh_current_emp
lib/App/Dochazka/CLI/Commands/Interval.pm view on Meta::CPAN
our @EXPORT_OK = qw(
interval_date
interval_date_date1
interval_datelist
interval_month
interval_new_date_time_date1_time1
interval_new_time_time1
interval_new_timerange
interval_num_num1
interval_promptdate
interval_tsrange
);
=head1 FUNCTIONS
The functions in this module are called from the parser when it recognizes a command.
lib/App/Dochazka/CLI/Commands/Interval.pm view on Meta::CPAN
# determine employee
my $status = determine_employee( $th->{'EMPLOYEE_SPEC'} );
return $status unless $status->ok;
my $emp = $status->payload;
# determine lower and upper bounds
# - month
my $nmonth = month_alpha_to_numeric( $th->{_MONTH} );
# - year
my $year = $th->{'_NUM'} || $prompt_year;
# - normalize
my $date = normalize_date( "$year-$nmonth-1" );
return $CELL->status_err( 'DOCHAZKA_CLI_INVALID_DATE' ) unless $date;
my $date1 = normalize_date( "$year-$nmonth-" .
Days_in_Month( $year, $nmonth ) );
return $CELL->status_err( 'DOCHAZKA_CLI_INVALID_DATE' ) unless $date1;
return _interval_fillup_delete_print( $th, $emp, "[ $date 00:00, $date1 24:00 )" );
}
lib/App/Dochazka/CLI/Commands/Interval.pm view on Meta::CPAN
# determine lower and upper bounds
# - numeric month
my $nmonth;
if ( $th->{'_NUM'} >= 0 and $th->{'_NUM'} <= 12 ) {
$nmonth = $th->{'_NUM'};
} else {
return $CELL->status_err( 'DOCHAZKA_CLI_INVALID_DATE' );
}
# - year
my $year = $th->{'_NUM1'} || $prompt_year;
# - normalize
my $date = normalize_date( "$year-$nmonth-1" );
return $CELL->status_err( 'DOCHAZKA_CLI_INVALID_DATE' ) unless $date;
my $date1 = normalize_date( "$year-$nmonth-" .
Days_in_Month( $year, $nmonth ) );
return $CELL->status_err( 'DOCHAZKA_CLI_INVALID_DATE' ) unless $date1;
return _interval_fillup_delete_print( $th, $emp, "[ $date 00:00, $date1 24:00 )" );
}
lib/App/Dochazka/CLI/Commands/Interval.pm view on Meta::CPAN
# determine dry_run
my $dry_run = exists( $th->{'DRY_RUN'} ) ? 1 : 0;
$log->debug( "dry_run: $dry_run" );
# check datelist for sanity
my $regex = qr/^(\d{1,2},|\d{1,2}-\d{1,2},)*(\d{1,2}|\d{1,2}-\d{1,2})$/;
return $CELL->status_err( "Invalid datelist" ) unless $th->{"_REST"} =~ $regex;
# convert datelist into reference to array of dates
my $dl = datelist_from_token( $prompt_month, $th->{_REST} );
$log->debug( "datelist: " . Dumper( $dl ) );
return _fillup(
eid => $emp->eid,
code => $th->{_TERM},
date_list => $dl,
dry_run => $dry_run,
clobber => 1,
);
}
=head3 interval_promptdate
INTERVAL
EMPLOYEE_SPEC INTERVAL
INTERVAL FETCH
EMPLOYEE_SPEC INTERVAL FETCH
INTERVAL FILLUP
EMPLOYEE_SPEC INTERVAL FILLUP
INTERVAL SUMMARY
EMPLOYEE_SPEC INTERVAL SUMMARY
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;
lib/App/Dochazka/CLI/Commands/Interval.pm view on Meta::CPAN
}
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;
}
# for the second date, we have to check for undefined/empty-ness ourselves
$d1 = $d0 unless defined( $d1 ) and length( $d1 ) > 0;
if ( $s = normalize_date( $d1 ) ) {
lib/App/Dochazka/CLI/Commands/Misc.pm view on Meta::CPAN
# *************************************************************************
#
# Miscellaneous commands
package App::Dochazka::CLI::Commands::Misc;
use 5.012;
use strict;
use warnings;
use App::CELL qw( $CELL );
use App::Dochazka::CLI qw( $debug_mode $prompt_date );
use App::Dochazka::CLI::Util qw( init_prompt normalize_date parse_test rest_error );
use Data::Dumper;
use Exporter 'import';
use Web::MREST::CLI qw( send_req );
=head1 NAME
App::Dochazka::CLI::Commands::Misc - Misc commands
=head1 PACKAGE VARIABLES
=cut
our @EXPORT_OK = qw(
change_prompt_date
noop
);
=head1 FUNCTIONS
The functions in this module are called from the parser when it recognizes a command.
=cut
=head2 change_prompt_date
PROMPT _DATE
PROMPT DATE _DATE
=cut
sub change_prompt_date {
print "Entering " . __PACKAGE__ . "::change_prompt_date\n" if $debug_mode;
my ( $ts, $th ) = @_;
# parse test
return parse_test( $ts, $th ) if $ts eq 'PARSE_TEST';
# normalize the date
my $nd = normalize_date( $th->{_DATE} );
# date not valid?
return $CELL->status_err( 'DOCHAZKA_CLI_INVALID_DATE_OR_TIME', args => [ $th->{_DATE} ] )
unless $nd;
# make it so
$prompt_date = $nd;
init_prompt();
return $CELL->status_ok( 'DOCHAZKA_CLI_PROMPT_DATE_CHANGED', args => [ $prompt_date ] );
}
=head2 noop
=cut
sub noop {
print "Entering " . __PACKAGE__ . "::noop\n" if $debug_mode;
my ( $ts, $th ) = @_;
lib/App/Dochazka/CLI/Guide.pm view on Meta::CPAN
The canonical way to enter an attendance interval:
INTERVAL $TIME_BEGIN $TIME_END $ACTIVITY_CODE $DESCRIPTION
INTERVAL $TIME_BEGIN - $TIME_END $ACTIVITY_CODE $DESCRIPTION
Use the above command variant if you need to enter the date along with the
time, or if the interval begins and ends on a different date. Example:
INTERVAL 2015-04-27 08:00 - 2015-04-27 12:00 WORK Prepare notes for meeting
If the date is omitted, the "prompt date" will be used:
INTERVAL 08:00 - 12:00 WORK Prepare notes for meeting
If a beginning date is specified, but no ending date, the beginning date will
be applied to the end as well:
INTERVAL 2015-04-28 12:30 - 16:30 WORK Wait for Godot
=head4 Time range
Another way to omit the date (default to the prompt date) is to enter a time range:
INTERVAL $TIME_RANGE $ACTIVITY_CODE $DESCRIPTION
Example:
INTERVAL 8:00-9:00 MEDICAL_LEAVE Doctor's appointment
Optionally, a date can be specified before the time range:
INTERVAL 2015-04-28 8:00-9:00 MEDICAL_LEAVE Doctor's appointment
=head3 Fetch (i.e., view) intervals
There are many commands for viewing intervals. In all cases, the term FETCH is optional
=head4 All intervals on the prompt date
INTERVAL [FETCH]
The simplest form; displays the list of intervals for the
prompt date.
=head4 All intervals on a specified date
INTERVAL [FETCH] $DATE
Fetch all intervals on the given date. Example:
INTERVAL FETCH 2015-04-28
=head4 All intervals between a range of dates
lib/App/Dochazka/CLI/Guide.pm view on Meta::CPAN
INTERVAL [FETCH] $MONTH
INTERVAL [FETCH] $MONTH $YEAR
The month can be given either in English (only first three letters are
necessary) or as a numeric value. Example:
INTERVAL APR
INTERVAL FETCH 4
Both of these commands fetch all the employee's intervals that fall within
April of the prompt year.
=cut
1;
lib/App/Dochazka/CLI/Test.pm view on Meta::CPAN
# Test module - reusable components
#
package App::Dochazka::CLI::Test;
use 5.012;
use strict;
use warnings;
use App::CELL qw( $CELL $log $meta $site );
use App::Dochazka::CLI::Parser qw( look_up_command process_command );
use App::Dochazka::CLI::Util qw( init_prompt );
use Exporter qw( import );
use Test::More;
use Web::MREST::CLI qw( init_cli_client );
=head1 NAME
App::Dochazka::CLI::Test - Reusable test routines
lib/App/Dochazka/CLI/Test.pm view on Meta::CPAN
=head1 FUNCTIONS
=head2 init_unit
=cut
sub init_unit {
init_prompt();
my $status = init_cli_client( distro => 'App-Dochazka-CLI', );
return $status;
}
=head2 delete_interval
=cut
sub delete_interval_test {
lib/App/Dochazka/CLI/Testers.pm view on Meta::CPAN
This just demonstrates that the test employee can log in.
$ dochazka-cli -u george -p george
...
Authenticating to server at http://localhost:5000 as user george
Server is alive
Dochazka(2016-01-27) george PASSERBY>
=head2 Concepts (Dochazka prompt, employee priv levels)
Let's review the information presented in the prompt:
=over
=item Prompt date in parentheses (defaults to current date)
=item Logged-in employee (george)
=item Privilege level of logged-in employee (passerby)
=back
lib/App/Dochazka/CLI/Testers.pm view on Meta::CPAN
Very good, and enough fiddling. In the meantime, George went to lunch, and then
spent the afternoon looking out the window:
Dochazka(2016-02-03) george ACTIVE> interval 12:30-16:30 work Look out window
...
Interval IID 2
["2016-02-03 12:30:00+01","2016-02-03 16:30:00+01") WORK Look out window
Now let's admire George's work. The command INTERVAL should list all
existing intervals for the prompt date:
Dochazka(2016-02-03) george ACTIVE> interval
Attendance intervals of george (EID 3)
in the range [ 2016-02-03 00:00, 2016-02-03 24:00 )
IID Begin End Code Description
1 2016-02-03 08:00 2016-02-03 12:00 WORK Push pencils
2 2016-02-03 12:30 2016-02-03 16:30 WORK Look out window
=head2 Concepts (Prompt date)
Let's review once again the information provided by the Dochazka prompt:
=over
=item Prompt date (defaults to current date)
=item Logged-in employee (george in this case)
=item Privilege level of logged-in employee (passerby)
=back
The prompt date defaults to today's date.
=head2 Set the prompt date
The prompt date can be set by the user to any valid date:
Dochazka(2016-02-03) george ACTIVE> prompt 2016-01-18
Prompt date changed to 2016-01-18
Dochazka(2016-01-18) george ACTIVE> prompt 203-12-31
*** Anomaly detected ***
Explanation: Encountered invalid date or time ->203-12-31<- (ERR)
Dochazka(2016-02-03) george ACTIVE> prompt 2016-01-33
Prompt date changed to 2016-01-33
Oops! (This is a bug.)
=cut
1;
lib/App/Dochazka/CLI/TokenMap.pm view on Meta::CPAN
param => 'PARAM',
passerby => 'PRIV_SPEC',
password => 'PASSWORD',
path => 'PATH',
phid => 'PHID',
'phid=' => 'PHISTORY_SPEC',
pod => 'POD',
post => 'POST',
priv => 'PRIV',
profile => 'PROFILE',
prompt => 'PROMPT',
put => 'PUT',
quit => 'QUIT',
remark => 'REMARK',
report => 'REPORT',
saturday => '_DOW',
schedule => 'SCHEDULE',
scode => 'SCODE',
'scode=' => 'SCHEDULE_SPEC',
search => 'SEARCH',
sec_id => 'SEC_ID',
lib/App/Dochazka/CLI/Util.pm view on Meta::CPAN
use 5.012;
use strict;
use warnings;
use App::CELL qw( $CELL $log $meta $site );
use App::Dochazka::Common qw( $t $today $tomorrow $yesterday init_timepiece );
use App::Dochazka::CLI qw(
$current_emp
$current_priv
$debug_mode
$prompt_date
$prompt_century
$prompt_year
$prompt_month
$prompt_day
);
use App::Dochazka::Common::Model::Employee;
use Data::Dumper;
use Date::Calc qw( check_date Add_Delta_Days );
use Exporter 'import';
use File::ShareDir;
use Log::Any::Adapter;
use Params::Validate qw( :all );
use Scalar::Util qw( looks_like_number );
use Try::Tiny;
lib/App/Dochazka/CLI/Util.pm view on Meta::CPAN
=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 = (
lib/App/Dochazka/CLI/Util.pm view on Meta::CPAN
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,/ ) {
lib/App/Dochazka/CLI/Util.pm view on Meta::CPAN
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})$/ ) {
if ( $begin >= $end ) {
die "AGHGGHSKSKDQ!!!!! Begin date must be less than end";
}
foreach my $n ( $begin..$end ) {
my $canonical_date = sprintf( "%04d-%02d-%02d", $prompt_year, $prompt_month, $n );
push @datelist, $canonical_date;
}
#
# 3. if not, convert it into a date
} else { # is a single date
my $canonical_date = sprintf( "%04d-%02d-%02d", $prompt_year, $prompt_month, $subtoken );
push @datelist, $canonical_date;
}
}
return \@datelist;
}
=head2 determine_employee
lib/App/Dochazka/CLI/Util.pm view on Meta::CPAN
sub init_logger {
my $log_file = normalize_filespec( $site->DOCHAZKA_CLI_LOG_FILE );
unlink $log_file if $site->DOCHAZKA_CLI_LOG_FILE_RESET;
print "Logging to $log_file\n";
Log::Any::Adapter->set('File', $log_file );
$log->init( ident => 'dochazka-cli', debug_mode => 1 );
$log->debug( 'Logger initialized' );
}
=head2 init_prompt
(Re-)initialize the date/time-related package variables
=cut
sub init_prompt {
#print "Entering " . __PACKAGE__ . "::init_prompt\n";
init_timepiece();
$prompt_date = $today unless $prompt_date;
( $prompt_year, $prompt_month, $prompt_day ) =
$prompt_date =~ m/^(\d{4,4})-(\d{1,2})-(\d{1,2})/;
( $prompt_century ) = $prompt_year =~ m/^(\d{2,2})/;
}
=head2 month_alpha_to_numeric
Given a month written in English (e.g. "January"), return the ordinal
number of that month (i.e. 1 for January) or undef if it cannot be
determined.
=cut
lib/App/Dochazka/CLI/Util.pm view on Meta::CPAN
TOMORROW
YESTERDAY
+n
-n
and any of the two-digit forms can be fulfilled by a single digit,
for example 2014-3-4 is March 4th, 2014.
All the forms except the first are converted into the YYYY-MM-DD form.
The last two forms listed, C<+n> and C<-n>, are calculated as offsets
from the "prompt date" (the date shown in the prompt), where C<n> is
interpreted as a number of days.
If an undefined or empty string is given, the prompt date is returned.
If the string does not match any of the forms, undef is returned.
Caveats:
=over
=item * two-digit years
If only YY is given, it is converted into YYYY by appending two digits
corresponding to the prompt century (e.g. 22 becomes 2022 during 2000-2099).
=item * special date forms
The special date forms "TODAY", "TOMORROW", and "YESTERDAY" are recognized,
and only the first three letters are significant, so "todMUMBOJUMBO" converts
to today's date.
=item * offsets
The C<n> in the offset can be any number in the range 0-999.
=item * no year
If no year is given, the prompt year is used.
=item * no date
If no date is given, the prompt date is used.
=item * single-digit forms
If a single-digit form is given for C<MM> or C<DD>, a leading zero is appended.
=back
=cut
sub normalize_date {
my $rd = shift; # rd == raw date
my $nd; # nd == normalized date
# initialize timepiece so we can do things like $today, $tomorrow, etc.
init_prompt();
# return prompt date if no raw date provided
unless ( defined( $rd ) and length( $rd ) > 0 ) {
#print "normalize_date(): no date provided, returning prompt date\n";
#print "Prompt date is " . ( $prompt_date || 'undefined' ) . "\n";
return $prompt_date;
}
if ( $rd =~ m/\A\d{4,4}-\d{1,2}-\d{1,2}\z/ ) {
$nd = $rd;
} elsif ( $rd =~ m/\A\d{2,2}-\d{1,2}-\d{1,2}\z/ ) {
# year has only two digits: add the prompt century
$nd = $prompt_century . $rd;
} elsif ( $rd =~ m/\A\d{1,2}-\d{1,2}\z/ ) {
# year omitted: add the prompt year
$nd = $prompt_year . '-' . $rd;
} elsif ( $rd =~ m/\Atod/i ) {
$nd = $today;
} elsif ( $rd =~ m/\Atom/i ) {
$nd = $tomorrow;
} elsif ( $rd =~ m/\Ayes/i ) {
$nd = $yesterday;
} elsif ( $rd =~ m/\A[\+\-]\d{1,3}\z/ ) {
# offset from prompt date
$prompt_date =~ m/\A(?<yyyy>\d{4,4})-(?<mm>\d{1,2})-(?<dd>\d{1,2})\z/;
if ( check_date( $+{'yyyy'}, $+{'mm'}, $+{'dd'} ) ) {
# prompt date is OK, apply delta
my ( $year, $month, $day ) = Add_Delta_Days(
$+{'yyyy'}, $+{'mm'}, $+{'dd'},
$rd,
);
$nd = "$year-$month-$day";
} else {
die "AAAAAAJAJAJAJADDEEEEE!!! Invalid prompt date $prompt_date";
}
} else {
# anything else - invalid timestamp
return undef;
}
# add leading zeroes to month and day, if necessary
$nd =~ m/\A(?<yyyy>\d{4,4})-(?<mm>\d{1,2})-(?<dd>\d{1,2})\z/;
return undef unless $+{yyyy} and $+{mm} and $+{dd};
$nd = sprintf( "%d-%02d-%02d", $+{yyyy}, $+{mm}, $+{dd} );
t/cmd_active/interval.t view on Meta::CPAN
# *************************************************************************
#
# test INTERVAL commands as user with privlevel active
#!perl
use 5.012;
use strict;
use warnings;
use App::CELL qw( $CELL $log $meta $site );
use App::Dochazka::CLI qw( $prompt_date $prompt_century $prompt_year $prompt_month $prompt_day );
use App::Dochazka::CLI::Parser qw( process_command );
use App::Dochazka::CLI::Test qw( delete_interval_test fetch_interval_test init_unit );
use App::Dochazka::CLI::Util qw( authenticate_to_server );
use Data::Dumper;
use Test::More;
use Test::Warnings;
my ( $cmd, $rv );
$rv = init_unit();
t/cmd_active/interval.t view on Meta::CPAN
note( 'INTERVAL displays today\'s intervals (but there are none)' );
$cmd = "INTERVAL";
$rv = process_command( $cmd );
is( ref( $rv ), 'App::CELL::Status' );
is( $rv->level, 'OK' );
like( $rv->payload, qr/No attendance intervals found in tsrange/ );
my $iid;
note( 'set prompt date to 2015-01-01' );
$cmd = "PROMPT 2015-01-01";
$rv = process_command( $cmd );
is( ref( $rv ), 'App::CELL::Status' );
is( $rv->level, 'OK' );
is( $rv->code, 'DOCHAZKA_CLI_PROMPT_DATE_CHANGED' );
note( "Prompt century, etc. have changed as expected" );
is( $prompt_century, 20 );
is( $prompt_year, 2015 );
is( $prompt_month+0, 1 );
is( $prompt_day+0, 1 );
note( 'enter an interval without specifying a date; see that prompt date is used' );
note( $cmd = "INTERVAL 6:30-7:00 WORK" );
$rv = process_command( $cmd );
is( ref( $rv ), 'App::CELL::Status' );
is( $rv->level, 'OK' );
is( $rv->code, 'DOCHAZKA_CLI_NORMAL_COMPLETION' );
( $iid ) = $rv->payload =~ m/\AInterval IID (\d+)/;
like( $rv->payload, qr/\AInterval IID \d+.*2015-01-01.*06:30.*2015-01-01.*07:00.*WORK/ms,
"IID $iid inserted");
note( 'enter interval with non-existent activity' );
t/cmd_active/interval.t view on Meta::CPAN
is( $rv->level, 'ERR' );
is( $rv->code, 'DOCHAZKA_CLI_WRONG_ACTIVITY' );
like( $rv->text, qr/Activity -\>PRDBANK\<- does not exist \(use ACTIVITY ALL command to list activities\)/ );
note( 'fetch the interval' );
my $payload = fetch_interval_test( '', '' );
like( $payload, qr/06:30.+07:00/ );
delete_interval_test( $iid );
note( 'use +1 notation to specify the day after the prompt date' );
note( $cmd = "INTERVAL +1 6:30-7:00 WORK Teststr_foobarbaz" );
$rv = process_command( $cmd );
is( ref( $rv ), 'App::CELL::Status' );
is( $rv->level, 'OK' );
is( $rv->code, 'DOCHAZKA_CLI_NORMAL_COMPLETION' );
( $iid ) = $rv->payload =~ m/\AInterval IID (\d+)/;
like( $rv->payload, qr/\AInterval IID \d+.*2015-01-02.*06:30.*2015-01-02.*07:00.*WORK/ms,
"IID $iid inserted");
note( 'fetch the interval using YYYY-MM-DD notation' );
t/parser/parse_test.t view on Meta::CPAN
#================================
# Interval commands
#================================
note( "Interval fetch and fillup" );
note( $cmd = "INTERVAL your text here or there" );
$r = parse( $cmd );
do_parse_test( $r->{'nc'}, 'App::Dochazka::CLI::Commands::Interval::interval_promptdate' );
note( $cmd = "EMPLOYEE=orc6e INTERVAL your text here or there" );
$r = parse( $cmd );
do_parse_test( $r->{'nc'}, 'App::Dochazka::CLI::Commands::Interval::interval_promptdate' );
note( $cmd = "INTERVAL FETCH" );
$r = parse( $cmd );
do_parse_test( $r->{'nc'}, 'App::Dochazka::CLI::Commands::Interval::interval_promptdate' );
note( $cmd = "EMPLOYEE=orc6e INTERVAL FETCH" );
$r = parse( $cmd );
do_parse_test( $r->{'nc'}, 'App::Dochazka::CLI::Commands::Interval::interval_promptdate' );
note( $cmd = "INTERVAL FILLUP" );
$r = parse( $cmd );
do_parse_test( $r->{'nc'}, 'App::Dochazka::CLI::Commands::Interval::interval_promptdate' );
note( $cmd = "EMPLOYEE=orc6e INTERVAL FILLUP" );
$r = parse( $cmd );
do_parse_test( $r->{'nc'}, 'App::Dochazka::CLI::Commands::Interval::interval_promptdate' );
note( $cmd = "INTERVAL TOMORROW" );
$r = parse( $cmd );
do_parse_test( $r->{'nc'}, 'App::Dochazka::CLI::Commands::Interval::interval_date' );
note( $cmd = "EMPLOYEE=orc6e INTERVAL TOMORROW" );
$r = parse( $cmd );
do_parse_test( $r->{'nc'}, 'App::Dochazka::CLI::Commands::Interval::interval_date' );
note( $cmd = "INTERVAL FETCH 77-1-3" );
t/util/datelist.t view on Meta::CPAN
# + month_alpha_to_numeric
#
#!perl
use 5.012;
use strict;
use warnings;
#use App::CELL::Test::LogToFile;
use App::CELL qw( $log );
use App::Dochazka::CLI qw( $prompt_year $prompt_month );
use App::Dochazka::CLI::Util qw( datelist_from_token month_alpha_to_numeric );
use Data::Dumper;
use Test::Fatal;
use Test::More;
use Test::Warnings;
note( 'initialize logger' );
$log->init( ident => "dochazka-cli", debug_mode => 1 );
note( 'month_alpha_to_numeric()' );
t/util/datelist.t view on Meta::CPAN
'november' => 11,
'dec' => 12,
'furt' => undef,
);
foreach my $test ( keys %test_months ) {
my $result = month_alpha_to_numeric( $test );
is( $test_months{$test}, $result );
}
is( month_alpha_to_numeric(), undef );
note( 'datelist_from_token() - legal prompt_month' );
$prompt_year = 1960;
my %tests = (
1 => [ "5", [ "1960-01-05" ] ],
2 => [ "5-6", [ "1960-02-05", "1960-02-06" ] ],
3 => [ "10", [ "1960-03-10" ] ],
4 => [ "9-10", [ "1960-04-09", "1960-04-10" ] ],
5 => [ "10-13,5,5", [ "1960-05-10", "1960-05-11", "1960-05-12", "1960-05-13", "1960-05-05", "1960-05-05" ] ],
6 => [ "5,6,10-13,2", [ "1960-06-05", "1960-06-06", "1960-06-10", "1960-06-11", "1960-06-12", "1960-06-13", "1960-06-02" ] ],
);
foreach my $test ( keys %tests ) {
$prompt_month = $test;
my $result = datelist_from_token( $tests{$test}->[0] );
is_deeply( $tests{$test}->[1], $result );
}
note( 'datelist_from_token() - illegal prompt_month' );
%tests = (
0 => [ "5,6,10-13,2", undef ],
13 => [ "5,6,10-13,2", undef ],
);
foreach my $test ( keys %tests ) {
$prompt_month = $test;
like( exception { datelist_from_token( $tests{$test}->[0] ); },
qr/ASSERT ohayoa9I/ );
}
done_testing;
t/util/ts.t view on Meta::CPAN
# + normalize_date
# + normalize_time
#
#!perl
use 5.012;
use strict;
use warnings;
use App::Dochazka::Common qw( $t $today $tomorrow $yesterday );
use App::Dochazka::CLI qw( $prompt_date $prompt_year $prompt_month $prompt_day );
use App::Dochazka::CLI::Util qw(
init_prompt
normalize_date
normalize_time
);
use Data::Dumper;
use Test::More;
use Test::Warnings;
my ( $rd, $nd, $rt, $nt );
#=================================
# normalize_date() tests
#=================================
note( 'normalize_date routine from Util.pm' );
note( 'Normalize a date entered by the user.' );
note( 'Initialize timepiece' );
ok( ! defined( $t ), "\$t not defined before timepiece initialization" );
init_prompt();
ok( defined( $t ), "\$t defined after timepiece initialization" );
like( $prompt_date, qr/\d{4,4}-\d{1,2}-\d{1,2}/, 'Prompt date resembles a date' );
note( 'Normalize the prompt date' );
my $normalized_prompt_date = normalize_date( $prompt_date );
is( normalize_date( undef ), $normalized_prompt_date,
'If no date is provided, the prompt date is returned 1' );
is( normalize_date( '' ), $normalized_prompt_date,
'If no date is provided, the prompt date is returned 2' );
$rd = '2014-01-01';
$nd = normalize_date( $rd );
is( $rd, $nd, "2014-01-01 is already normalized - no change" );
is( normalize_date( 'Admin barge' ), undef, "Admin barge is an invalid date" );
note( 'YY-MM-DD' );
$rd = '72-12-12';
$nd = normalize_date( $rd );
is( $nd, '2072-12-12', "$rd normalizes to current century" );
note( 'MM-DD' );
$rd = '12-12';
$nd = normalize_date( $rd );
is( $nd, $prompt_year . '-12-12', "$rd normalizes to prompt year" );
note( 'Trailing characters' );
$rd = '72-12-12 BLBA';
$nd = normalize_date( $rd );
is( $nd, undef, "Trailing characters in raw date are not tolerated 1" );
$rd = '12-12 *DSS(((';
$nd = normalize_date( $rd );
is( $nd, undef, "Trailing characters in raw date are not tolerated 2" );
note( 'any of the two-digit forms can be fulfilled by a single digit' );
$rd = '1955-2-12';
$nd = normalize_date( $rd );
is( $nd, '1955-02-12', "month gets leading zero 1" );
$rd = '2-12';
$nd = normalize_date( $rd );
is( $nd, $prompt_year . '-02-12', "month gets leading zero 2" );
$rd = '2-00';
$nd = normalize_date( $rd );
is( $nd, undef );
$rd = '1955-12-2';
$nd = normalize_date( $rd );
is( $nd, '1955-12-02', "day gets leading zero 1" );
$rd = '12-2';
$nd = normalize_date( $rd );
is( $nd, $prompt_year . '-12-02', "day gets leading zero 2" );
note( 'a single zero will not pass for a month or date' );
$rd = '1983-0-10';
$nd = normalize_date( $rd );
is( $nd, undef, "single zero as month does not fly" );
$rd = '12-0';
$nd = normalize_date( $rd );
is( $nd, undef, "single zero as day does not fly" );
t/util/ts.t view on Meta::CPAN
is( $nd, "$yesterday", "$rd is normalized to $yesterday" );
note( 'only the first three letters are significant' );
$rd = "todMUMBOJUMBO";
$nd = normalize_date( $rd );
is( $nd, "$today", "$rd converts to today\'s date" );
note( 'If no year is given, the current year is used.' );
$rd = "6-30";
$nd = normalize_date( $rd );
is( $nd, $prompt_year . "-06-30" );
note( 'Offsets are applied to prompt date' );
$prompt_date = '2014-04-24';
$rd = "-1";
$nd = normalize_date( $rd );
is( $nd, "2014-04-23" );
$prompt_date = '2014-04-01';
$rd = "-1";
$nd = normalize_date( $rd );
is( $nd, "2014-03-31" );
#=================================
# normalize_time() tests
#=================================
note( 'if seconds are given, they are left off' );
( run in 0.828 second using v1.01-cache-2.11-cpan-6aa56a78535 )