| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package App::JobLog::Command::configure; |
|
2
|
|
|
|
|
|
|
$App::JobLog::Command::configure::VERSION = '1.039'; |
|
3
|
|
|
|
|
|
|
# ABSTRACT: examine or modify App::JobLog configuration |
|
4
|
|
|
|
|
|
|
|
|
5
|
2
|
|
|
2
|
|
1854
|
use App::JobLog -command; |
|
|
2
|
|
|
|
|
3
|
|
|
|
2
|
|
|
|
|
16
|
|
|
6
|
2
|
|
|
2
|
|
736
|
use Modern::Perl; |
|
|
2
|
|
|
|
|
3
|
|
|
|
2
|
|
|
|
|
12
|
|
|
7
|
2
|
|
|
|
|
318
|
use App::JobLog::Config qw( |
|
8
|
|
|
|
|
|
|
day_length |
|
9
|
|
|
|
|
|
|
editor |
|
10
|
|
|
|
|
|
|
hidden_columns |
|
11
|
|
|
|
|
|
|
merge |
|
12
|
|
|
|
|
|
|
pay_period_length |
|
13
|
|
|
|
|
|
|
precision |
|
14
|
|
|
|
|
|
|
start_pay_period |
|
15
|
|
|
|
|
|
|
sunday_begins_week |
|
16
|
|
|
|
|
|
|
time_zone |
|
17
|
|
|
|
|
|
|
workdays |
|
18
|
|
|
|
|
|
|
DAYS |
|
19
|
|
|
|
|
|
|
HIDABLE_COLUMNS |
|
20
|
|
|
|
|
|
|
HOURS |
|
21
|
|
|
|
|
|
|
MERGE |
|
22
|
|
|
|
|
|
|
NONE_COLUMN |
|
23
|
|
|
|
|
|
|
PERIOD |
|
24
|
|
|
|
|
|
|
PRECISION |
|
25
|
|
|
|
|
|
|
SUNDAY_BEGINS_WEEK |
|
26
|
|
|
|
|
|
|
TIME_ZONE |
|
27
|
|
|
|
|
|
|
WORKDAYS |
|
28
|
2
|
|
|
2
|
|
248
|
); |
|
|
2
|
|
|
|
|
5
|
|
|
29
|
2
|
|
|
2
|
|
11
|
use autouse 'App::JobLog::TimeGrammar' => qw(parse); |
|
|
2
|
|
|
|
|
5
|
|
|
|
2
|
|
|
|
|
16
|
|
|
30
|
2
|
|
|
2
|
|
130
|
no if $] >= 5.018, warnings => "experimental::smartmatch"; |
|
|
2
|
|
|
|
|
4
|
|
|
|
2
|
|
|
|
|
16
|
|
|
31
|
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
sub execute { |
|
33
|
0
|
|
|
0
|
1
|
|
my ( $self, $opt, $args ) = @_; |
|
34
|
0
|
0
|
|
|
|
|
_list_params() if $opt->list; |
|
35
|
0
|
0
|
|
|
|
|
if ( defined $opt->precision ) { |
|
36
|
0
|
|
|
|
|
|
my $precision = precision( $opt->precision ); |
|
37
|
0
|
|
|
|
|
|
say "precision set to $precision"; |
|
38
|
|
|
|
|
|
|
} |
|
39
|
0
|
0
|
|
|
|
|
if ( defined $opt->start_pay_period ) { |
|
40
|
0
|
|
|
|
|
|
eval { |
|
41
|
0
|
|
|
|
|
|
my ($s) = parse( $opt->start_pay_period ); |
|
42
|
0
|
|
|
|
|
|
my $d = start_pay_period($s); |
|
43
|
0
|
|
|
|
|
|
say 'beginning of pay period set to ' . $d->strftime('%F'); |
|
44
|
|
|
|
|
|
|
}; |
|
45
|
0
|
0
|
|
|
|
|
$self->usage_error( |
|
46
|
|
|
|
|
|
|
'could not understand date: ' . $opt->start_pay_period ) |
|
47
|
|
|
|
|
|
|
if $@; |
|
48
|
|
|
|
|
|
|
} |
|
49
|
0
|
0
|
|
|
|
|
if ( defined $opt->length_pay_period ) { |
|
50
|
0
|
|
|
|
|
|
my $length_pp = pay_period_length( $opt->length_pay_period ); |
|
51
|
0
|
|
|
|
|
|
say "length of pay period in days set to $length_pp"; |
|
52
|
|
|
|
|
|
|
} |
|
53
|
0
|
0
|
|
|
|
|
if ( defined $opt->day_length ) { |
|
54
|
0
|
|
|
|
|
|
my $day_length = day_length( $opt->day_length ); |
|
55
|
0
|
|
|
|
|
|
say "length of work day set to $day_length"; |
|
56
|
|
|
|
|
|
|
} |
|
57
|
0
|
0
|
|
|
|
|
if ( defined $opt->workdays ) { |
|
58
|
0
|
|
|
|
|
|
my $days = uc $opt->workdays; |
|
59
|
0
|
|
|
|
|
|
my %days = map { $_ => 1 } split //, $days; |
|
|
0
|
|
|
|
|
|
|
|
60
|
0
|
|
|
|
|
|
my @days; |
|
61
|
0
|
|
|
|
|
|
for ( split //, DAYS ) { |
|
62
|
0
|
0
|
|
|
|
|
push @days, $_ if $days{$_}; |
|
63
|
|
|
|
|
|
|
} |
|
64
|
0
|
|
|
|
|
|
$days = join '', @days; |
|
65
|
0
|
|
|
|
|
|
$days = workdays($days); |
|
66
|
0
|
|
|
|
|
|
say "workdays set to $days"; |
|
67
|
|
|
|
|
|
|
} |
|
68
|
0
|
0
|
|
|
|
|
if ( defined $opt->sunday_begins_week ) { |
|
69
|
0
|
|
|
|
|
|
my $bool; |
|
70
|
0
|
|
|
|
|
|
for ( $opt->sunday_begins_week ) { |
|
71
|
0
|
|
|
|
|
|
when (/true/i) { $bool = 1 } |
|
|
0
|
|
|
|
|
|
|
|
72
|
0
|
|
|
|
|
|
when (/false/i) { $bool = 0 } |
|
|
0
|
|
|
|
|
|
|
|
73
|
0
|
|
0
|
|
|
|
default { $bool = $opt->sunday_begins_week || 0 }; |
|
|
0
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
} |
|
75
|
0
|
|
|
|
|
|
$bool = sunday_begins_week($bool); |
|
76
|
0
|
0
|
|
|
|
|
say "Sunday begins week is now " . ( $bool ? 'true' : 'false' ); |
|
77
|
|
|
|
|
|
|
} |
|
78
|
0
|
0
|
|
|
|
|
if ( defined $opt->merge ) { |
|
79
|
0
|
|
|
|
|
|
my $m = lc $opt->merge; |
|
80
|
0
|
|
|
|
|
|
$m =~ s/^\s++|\s++$//g; |
|
81
|
0
|
|
|
|
|
|
$m =~ s/\s++/ /g; |
|
82
|
0
|
|
|
|
|
|
my $value = merge($m); |
|
83
|
0
|
|
|
|
|
|
say "merge level is now '$value'"; |
|
84
|
|
|
|
|
|
|
} |
|
85
|
0
|
0
|
|
|
|
|
if ( defined $opt->editor ) { |
|
86
|
0
|
|
|
|
|
|
my $value = editor( $opt->editor ); |
|
87
|
0
|
|
|
|
|
|
say "log editor is now $value"; |
|
88
|
|
|
|
|
|
|
} |
|
89
|
0
|
0
|
|
|
|
|
if ( defined $opt->hidden_columns ) { |
|
90
|
0
|
|
|
|
|
|
my @cols = map { my $v = $_; lc $v } @{ $opt->hidden_columns }; |
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
91
|
0
|
|
|
|
|
|
my %cols = map { $_ => 1 } @cols; |
|
|
0
|
|
|
|
|
|
|
|
92
|
0
|
|
|
|
|
|
my $value = join ' ', sort keys %cols; |
|
93
|
0
|
|
|
|
|
|
$value = hidden_columns($value); |
|
94
|
0
|
|
|
|
|
|
say "hidden columns: $value"; |
|
95
|
|
|
|
|
|
|
} |
|
96
|
0
|
0
|
|
|
|
|
if ( defined $opt->time_zone ) { |
|
97
|
0
|
|
|
|
|
|
my $value = time_zone( $opt->time_zone ); |
|
98
|
0
|
|
|
|
|
|
say "time zone is now $value"; |
|
99
|
|
|
|
|
|
|
} |
|
100
|
|
|
|
|
|
|
} |
|
101
|
|
|
|
|
|
|
|
|
102
|
0
|
|
|
0
|
1
|
|
sub usage_desc { '%c ' . __PACKAGE__->name . ' %o' } |
|
103
|
|
|
|
|
|
|
|
|
104
|
0
|
|
|
0
|
1
|
|
sub abstract { 'set or display various parameters' } |
|
105
|
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
sub options { |
|
107
|
|
|
|
|
|
|
return ( |
|
108
|
|
|
|
|
|
|
[ |
|
109
|
|
|
|
|
|
|
'precision=i', |
|
110
|
|
|
|
|
|
|
'decimal places of precision in display of time; ' |
|
111
|
|
|
|
|
|
|
. 'e.g., --precision=1; ' |
|
112
|
|
|
|
|
|
|
. 'default is ' |
|
113
|
|
|
|
|
|
|
. PRECISION |
|
114
|
|
|
|
|
|
|
], |
|
115
|
|
|
|
|
|
|
[ |
|
116
|
|
|
|
|
|
|
'start-pay-period=s', |
|
117
|
|
|
|
|
|
|
'the first day of some pay period; ' |
|
118
|
|
|
|
|
|
|
. 'pay period boundaries will be calculated based on this date and the pay period length; ' |
|
119
|
|
|
|
|
|
|
. 'e.g., --start-pay-period="June 14, 1912"' |
|
120
|
|
|
|
|
|
|
], |
|
121
|
|
|
|
|
|
|
[ |
|
122
|
|
|
|
|
|
|
'time-zone=s', |
|
123
|
|
|
|
|
|
|
'time zone used in calendar calculations; default is ' . TIME_ZONE |
|
124
|
|
|
|
|
|
|
], |
|
125
|
|
|
|
|
|
|
[ |
|
126
|
|
|
|
|
|
|
'sunday-begins-week=s', |
|
127
|
|
|
|
|
|
|
'whether Sundays should be regarded as the first day in the week; ' |
|
128
|
|
|
|
|
|
|
. 'the alternative is Monday; default is ' |
|
129
|
|
|
|
|
|
|
. ( SUNDAY_BEGINS_WEEK ? 'TRUE' : 'FALSE' ) |
|
130
|
|
|
|
|
|
|
], |
|
131
|
|
|
|
|
|
|
[ |
|
132
|
|
|
|
|
|
|
'length-pay-period=i', |
|
133
|
|
|
|
|
|
|
'the length of the pay period in days; e.g., --length-pay-period 7; ' |
|
134
|
|
|
|
|
|
|
. 'default is ' |
|
135
|
|
|
|
|
|
|
. PERIOD |
|
136
|
|
|
|
|
|
|
], |
|
137
|
|
|
|
|
|
|
[ |
|
138
|
|
|
|
|
|
|
'day-length=f', |
|
139
|
|
|
|
|
|
|
'length of workday; ' |
|
140
|
|
|
|
|
|
|
. 'e.g., --day-length 7.5; ' |
|
141
|
|
|
|
|
|
|
. 'default is: ' |
|
142
|
|
|
|
|
|
|
. HOURS |
|
143
|
|
|
|
|
|
|
], |
|
144
|
|
|
|
|
|
|
[ |
|
145
|
|
|
|
|
|
|
'workdays=s', |
|
146
|
|
|
|
|
|
|
'which days of the week you work represented as some subset of ' |
|
147
|
|
|
|
|
|
|
. DAYS |
|
148
|
|
|
|
|
|
|
. '; e.g., --workdays=MTWH; ' |
|
149
|
|
|
|
|
|
|
. 'default is ' |
|
150
|
|
|
|
|
|
|
. WORKDAYS |
|
151
|
|
|
|
|
|
|
], |
|
152
|
|
|
|
|
|
|
[ |
|
153
|
|
|
|
|
|
|
'merge=s', |
|
154
|
|
|
|
|
|
|
'amount of merging of events in summaries; ' |
|
155
|
|
|
|
|
|
|
. 'available options are : ' |
|
156
|
|
|
|
|
|
|
. "'adjacent same tags', 'adjacent', 'all', 'none', 'same day same tags', 'same day', 'same tags'; " |
|
157
|
0
|
|
|
|
|
|
. "default is '@{[MERGE]}'" |
|
158
|
|
|
|
|
|
|
], |
|
159
|
|
|
|
|
|
|
[ |
|
160
|
|
|
|
|
|
|
'hidden-columns=s@', |
|
161
|
|
|
|
|
|
|
'columns not to display with the ' |
|
162
|
|
|
|
|
|
|
. App::JobLog::Command::summary->name |
|
163
|
|
|
|
|
|
|
. ' command; ' |
|
164
|
|
|
|
|
|
|
. 'available options are: ' |
|
165
|
0
|
|
|
0
|
0
|
|
. join( ', ', map { "'$_'" } @{ HIDABLE_COLUMNS() } ) . '; ' |
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
166
|
0
|
|
|
|
|
|
. "default is '@{[NONE_COLUMN]}'; " |
|
167
|
|
|
|
|
|
|
. 'multiple columns may be specified' |
|
168
|
|
|
|
|
|
|
], |
|
169
|
|
|
|
|
|
|
[ 'editor=s', 'text editor to use when manually editing the log' ], |
|
170
|
|
|
|
|
|
|
[ 'list|l', 'list all configuration parameters' ], |
|
171
|
|
|
|
|
|
|
); |
|
172
|
|
|
|
|
|
|
} |
|
173
|
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
# |
|
175
|
|
|
|
|
|
|
# list values of all params |
|
176
|
|
|
|
|
|
|
# |
|
177
|
|
|
|
|
|
|
sub _list_params { |
|
178
|
0
|
|
|
0
|
|
|
my @params = sort qw( |
|
179
|
|
|
|
|
|
|
precision |
|
180
|
|
|
|
|
|
|
day_length |
|
181
|
|
|
|
|
|
|
editor |
|
182
|
|
|
|
|
|
|
hidden_columns |
|
183
|
|
|
|
|
|
|
merge |
|
184
|
|
|
|
|
|
|
pay_period_length |
|
185
|
|
|
|
|
|
|
start_pay_period |
|
186
|
|
|
|
|
|
|
sunday_begins_week |
|
187
|
|
|
|
|
|
|
time_zone |
|
188
|
|
|
|
|
|
|
workdays |
|
189
|
|
|
|
|
|
|
); |
|
190
|
0
|
|
|
|
|
|
my %booleans = map { $_ => 1 } qw( |
|
|
0
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
sunday_begins_week |
|
192
|
|
|
|
|
|
|
); |
|
193
|
0
|
|
|
|
|
|
my ( $l1, $l2, %h ) = ( 0, 0 ); |
|
194
|
|
|
|
|
|
|
|
|
195
|
0
|
|
|
|
|
|
for my $method (@params) { |
|
196
|
0
|
|
|
|
|
|
my $l = length $method; |
|
197
|
0
|
|
|
|
|
|
my $value = eval "App::JobLog::Config::$method()"; |
|
198
|
0
|
0
|
|
|
|
|
$value = $value ? 'true' : 'false' if $booleans{$method}; |
|
|
|
0
|
|
|
|
|
|
|
199
|
0
|
0
|
|
|
|
|
$value = 'not defined' unless defined $value; |
|
200
|
0
|
0
|
|
|
|
|
$value = $value->strftime('%F') if ref $value eq 'DateTime'; |
|
201
|
0
|
0
|
|
|
|
|
$l1 = $l if $l > $l1; |
|
202
|
0
|
|
|
|
|
|
$l = length $value; |
|
203
|
0
|
0
|
|
|
|
|
$l2 = $l if $l > $l2; |
|
204
|
0
|
|
|
|
|
|
$h{$method} = $value; |
|
205
|
|
|
|
|
|
|
} |
|
206
|
0
|
|
|
|
|
|
my $format = '%-' . $l1 . 's %' . $l2 . "s\n"; |
|
207
|
0
|
|
|
|
|
|
for my $method (@params) { |
|
208
|
0
|
|
|
|
|
|
my $value = $h{$method}; |
|
209
|
0
|
|
|
|
|
|
$method =~ s/_/ /g; |
|
210
|
0
|
|
|
|
|
|
printf $format, $method, $value; |
|
211
|
|
|
|
|
|
|
} |
|
212
|
|
|
|
|
|
|
} |
|
213
|
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
sub validate { |
|
215
|
0
|
|
|
0
|
0
|
|
my ( $self, $opt, $args ) = @_; |
|
216
|
|
|
|
|
|
|
|
|
217
|
0
|
0
|
|
|
|
|
$self->usage_error('specify some parameter to set or display') unless %$opt; |
|
218
|
0
|
0
|
0
|
|
|
|
$self->usage_error('cannot parse work days') |
|
219
|
|
|
|
|
|
|
if $opt->workdays && $opt->workdays !~ /^[SMTWHFA]*+$/i; |
|
220
|
0
|
0
|
0
|
|
|
|
$self->usage_error( |
|
221
|
|
|
|
|
|
|
'cannot understand argument ' . $opt->sunday_begins_week ) |
|
222
|
|
|
|
|
|
|
if $opt->sunday_begins_week |
|
223
|
|
|
|
|
|
|
&& $opt->sunday_begins_week !~ /^(?:true|false|[01])?$/i; |
|
224
|
0
|
0
|
|
|
|
|
if ( defined $opt->merge ) { |
|
225
|
0
|
|
|
|
|
|
my $m = lc $opt->merge; |
|
226
|
0
|
|
|
|
|
|
$m =~ s/^\s++|\s++$//g; |
|
227
|
0
|
|
|
|
|
|
$m =~ s/\s++/ /g; |
|
228
|
0
|
0
|
|
|
|
|
if ( $m !~ |
|
229
|
|
|
|
|
|
|
/^(?:adjacent|adjacent same tags|all|none|same day|same day same tags|same tags)$/ |
|
230
|
|
|
|
|
|
|
) |
|
231
|
|
|
|
|
|
|
{ |
|
232
|
0
|
|
|
|
|
|
$self->usage_error( 'unknown merge option: ' . $opt->merge ); |
|
233
|
|
|
|
|
|
|
} |
|
234
|
|
|
|
|
|
|
} |
|
235
|
0
|
0
|
|
|
|
|
if ( defined $opt->hidden_columns ) { |
|
236
|
0
|
|
|
|
|
|
my %h = map { $_ => 1 } @{ HIDABLE_COLUMNS() }; |
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
237
|
0
|
|
|
|
|
|
my ( $found_none, $found_something ) = ( 0, 0 ); |
|
238
|
0
|
|
|
|
|
|
for my $c ( @{ $opt->hidden_columns } ) { |
|
|
0
|
|
|
|
|
|
|
|
239
|
0
|
|
|
|
|
|
my $col = lc $c; |
|
240
|
0
|
0
|
|
|
|
|
$self->usage_error("unknown column: $c") unless $h{$col}; |
|
241
|
0
|
0
|
|
|
|
|
if ( $col eq NONE_COLUMN ) { |
|
242
|
0
|
|
0
|
|
|
|
$found_none ||= 1; |
|
243
|
|
|
|
|
|
|
} |
|
244
|
|
|
|
|
|
|
else { |
|
245
|
0
|
|
0
|
|
|
|
$found_something ||= 1; |
|
246
|
|
|
|
|
|
|
} |
|
247
|
|
|
|
|
|
|
} |
|
248
|
|
|
|
|
|
|
$self->usage_error( |
|
249
|
0
|
0
|
0
|
|
|
|
"you have specified that something should be hidden and that nothing should be hidden" |
|
250
|
|
|
|
|
|
|
) if $found_none && $found_something; |
|
251
|
|
|
|
|
|
|
} |
|
252
|
0
|
0
|
|
|
|
|
if ( defined $opt->time_zone ) { |
|
253
|
0
|
|
|
|
|
|
require DateTime::TimeZone; |
|
254
|
0
|
|
|
|
|
|
eval { DateTime::TimeZone->new( name => $opt->time_zone ) }; |
|
|
0
|
|
|
|
|
|
|
|
255
|
0
|
0
|
|
|
|
|
$self->usage_error( |
|
256
|
|
|
|
|
|
|
'DateTime::TimeZone does not like the time zone name ' |
|
257
|
|
|
|
|
|
|
. $opt->time_zone |
|
258
|
|
|
|
|
|
|
. "\n$@" ) |
|
259
|
|
|
|
|
|
|
if $@; |
|
260
|
|
|
|
|
|
|
} |
|
261
|
|
|
|
|
|
|
} |
|
262
|
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
1; |
|
264
|
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
__END__ |