line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# ************************************************************************* |
2
|
|
|
|
|
|
|
# Copyright (c) 2014-2016, SUSE LLC |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
# All rights reserved. |
5
|
|
|
|
|
|
|
# |
6
|
|
|
|
|
|
|
# Redistribution and use in source and binary forms, with or without |
7
|
|
|
|
|
|
|
# modification, are permitted provided that the following conditions are met: |
8
|
|
|
|
|
|
|
# |
9
|
|
|
|
|
|
|
# 1. Redistributions of source code must retain the above copyright notice, |
10
|
|
|
|
|
|
|
# this list of conditions and the following disclaimer. |
11
|
|
|
|
|
|
|
# |
12
|
|
|
|
|
|
|
# 2. Redistributions in binary form must reproduce the above copyright |
13
|
|
|
|
|
|
|
# notice, this list of conditions and the following disclaimer in the |
14
|
|
|
|
|
|
|
# documentation and/or other materials provided with the distribution. |
15
|
|
|
|
|
|
|
# |
16
|
|
|
|
|
|
|
# 3. Neither the name of SUSE LLC nor the names of its contributors may be |
17
|
|
|
|
|
|
|
# used to endorse or promote products derived from this software without |
18
|
|
|
|
|
|
|
# specific prior written permission. |
19
|
|
|
|
|
|
|
# |
20
|
|
|
|
|
|
|
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
21
|
|
|
|
|
|
|
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
22
|
|
|
|
|
|
|
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
23
|
|
|
|
|
|
|
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE |
24
|
|
|
|
|
|
|
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR |
25
|
|
|
|
|
|
|
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF |
26
|
|
|
|
|
|
|
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS |
27
|
|
|
|
|
|
|
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN |
28
|
|
|
|
|
|
|
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) |
29
|
|
|
|
|
|
|
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE |
30
|
|
|
|
|
|
|
# POSSIBILITY OF SUCH DAMAGE. |
31
|
|
|
|
|
|
|
# ************************************************************************* |
32
|
|
|
|
|
|
|
# |
33
|
|
|
|
|
|
|
# Schedule commands |
34
|
|
|
|
|
|
|
package App::Dochazka::CLI::Commands::Schedule; |
35
|
|
|
|
|
|
|
|
36
|
20
|
|
|
20
|
|
256
|
use 5.012; |
|
20
|
|
|
|
|
41
|
|
37
|
20
|
|
|
20
|
|
61
|
use strict; |
|
20
|
|
|
|
|
22
|
|
|
20
|
|
|
|
|
276
|
|
38
|
20
|
|
|
20
|
|
54
|
use warnings; |
|
20
|
|
|
|
|
18
|
|
|
20
|
|
|
|
|
390
|
|
39
|
|
|
|
|
|
|
|
40
|
20
|
|
|
20
|
|
69
|
use App::CELL qw( $CELL ); |
|
20
|
|
|
|
|
17
|
|
|
20
|
|
|
|
|
1516
|
|
41
|
20
|
|
|
20
|
|
81
|
use App::Dochazka::CLI qw( $debug_mode ); |
|
20
|
|
|
|
|
21
|
|
|
20
|
|
|
|
|
1259
|
|
42
|
20
|
|
|
20
|
|
74
|
use App::Dochazka::CLI::Shared qw( print_schedule_object show_as_at ); |
|
20
|
|
|
|
|
19
|
|
|
20
|
|
|
|
|
759
|
|
43
|
20
|
|
|
20
|
|
68
|
use App::Dochazka::CLI::Util qw( parse_test ); |
|
20
|
|
|
|
|
19
|
|
|
20
|
|
|
|
|
636
|
|
44
|
20
|
|
|
20
|
|
8359
|
use App::Dochazka::Common::Model::Schedule; |
|
20
|
|
|
|
|
8165
|
|
|
20
|
|
|
|
|
401
|
|
45
|
20
|
|
|
20
|
|
80
|
use Data::Dumper; |
|
20
|
|
|
|
|
21
|
|
|
20
|
|
|
|
|
689
|
|
46
|
20
|
|
|
20
|
|
63
|
use Exporter 'import'; |
|
20
|
|
|
|
|
21
|
|
|
20
|
|
|
|
|
354
|
|
47
|
20
|
|
|
20
|
|
58
|
use JSON; |
|
20
|
|
|
|
|
20
|
|
|
20
|
|
|
|
|
77
|
|
48
|
20
|
|
|
20
|
|
1426
|
use Web::MREST::CLI qw( send_req ); |
|
20
|
|
|
|
|
24
|
|
|
20
|
|
|
|
|
37355
|
|
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
=head1 NAME |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
App::Dochazka::CLI::Commands::Schedule - Schedule commands |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
=head1 PACKAGE VARIABLES |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
=cut |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
our @EXPORT_OK = qw( |
65
|
|
|
|
|
|
|
$memsched |
66
|
|
|
|
|
|
|
%dow_map |
67
|
|
|
|
|
|
|
add_memsched_entry |
68
|
|
|
|
|
|
|
assign_memsched_scode |
69
|
|
|
|
|
|
|
clear_memsched_entries |
70
|
|
|
|
|
|
|
dump_memsched_entries |
71
|
|
|
|
|
|
|
fetch_all_schedules |
72
|
|
|
|
|
|
|
replicate_memsched_entry |
73
|
|
|
|
|
|
|
schedule_all |
74
|
|
|
|
|
|
|
schedule_new |
75
|
|
|
|
|
|
|
schedulespec |
76
|
|
|
|
|
|
|
schedulespec_remark |
77
|
|
|
|
|
|
|
schedulespec_scode |
78
|
|
|
|
|
|
|
show_schedule_as_at |
79
|
|
|
|
|
|
|
); |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
# in-memory storage for working schedule |
82
|
|
|
|
|
|
|
our $memsched; |
83
|
|
|
|
|
|
|
our $memsched_scode; |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
our %dow_map = ( |
86
|
|
|
|
|
|
|
'MON' => '2015-03-23', |
87
|
|
|
|
|
|
|
'TUE' => '2015-03-24', |
88
|
|
|
|
|
|
|
'WED' => '2015-03-25', |
89
|
|
|
|
|
|
|
'THU' => '2015-03-26', |
90
|
|
|
|
|
|
|
'FRI' => '2015-03-27', |
91
|
|
|
|
|
|
|
'SAT' => '2015-03-28', |
92
|
|
|
|
|
|
|
'SUN' => '2015-03-29', |
93
|
|
|
|
|
|
|
); |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
our %date_map = ( |
96
|
|
|
|
|
|
|
'2015-03-23' => 'MON', |
97
|
|
|
|
|
|
|
'2015-03-24' => 'TUE', |
98
|
|
|
|
|
|
|
'2015-03-25' => 'WED', |
99
|
|
|
|
|
|
|
'2015-03-26' => 'THU', |
100
|
|
|
|
|
|
|
'2015-03-27' => 'FRI', |
101
|
|
|
|
|
|
|
'2015-03-28' => 'SAT', |
102
|
|
|
|
|
|
|
'2015-03-29' => 'SUN', |
103
|
|
|
|
|
|
|
); |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
=head1 FUNCTIONS |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
The functions in this module are called from the parser when it recognizes a command. |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
=cut |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
=head2 Command handlers |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
The routines in this section are called as command handlers. |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
=head3 schedule_all |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
SCHEDULE ALL |
123
|
|
|
|
|
|
|
SCHEDULE ALL DISABLED |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
=cut |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
sub schedule_all { |
128
|
0
|
0
|
|
0
|
1
|
0
|
print "Entering " . __PACKAGE__ . "::schedule_all\n" if $debug_mode; |
129
|
0
|
|
|
|
|
0
|
my ( $ts, $th ) = @_; |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
# parse test |
132
|
0
|
0
|
|
|
|
0
|
return parse_test( $ts, $th ) if $ts eq 'PARSE_TEST'; |
133
|
|
|
|
|
|
|
|
134
|
0
|
|
|
|
|
0
|
return $CELL->status_ok( 'UNDER_CONSTRUCTION' ); |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
=head3 show_schedule_as_at |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
SCHEDULE |
141
|
|
|
|
|
|
|
EMPLOYEE_SPEC SCHEDULE |
142
|
|
|
|
|
|
|
SCHEDULE _DATE |
143
|
|
|
|
|
|
|
EMPLOYEE_SPEC SCHEDULE _DATE |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
=cut |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
sub show_schedule_as_at { |
148
|
2
|
50
|
|
2
|
1
|
14
|
print "Entering " . __PACKAGE__ . "::show_schedule_as_at\n" if $debug_mode; |
149
|
2
|
|
|
|
|
3
|
my ( $ts, $th ) = @_; |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
# parse test |
152
|
2
|
50
|
|
|
|
9
|
return parse_test( $ts, $th ) if $ts eq 'PARSE_TEST'; |
153
|
|
|
|
|
|
|
|
154
|
0
|
|
|
|
|
0
|
return show_as_at( 'schedule', $th ); |
155
|
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
=head3 add_memsched_entry |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
SCHEDULE _DOW _TIME _DOW1 _TIME1 |
161
|
|
|
|
|
|
|
SCHEDULE _DOW _TIME _HYPHEN _DOW1 _TIME1 |
162
|
|
|
|
|
|
|
SCHEDULE _DOW _TIMERANGE |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
=cut |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
sub add_memsched_entry { |
167
|
3
|
50
|
|
3
|
1
|
10
|
print "Entering " . __PACKAGE__ . "::add_memsched_entry\n" if $debug_mode; |
168
|
3
|
|
|
|
|
4
|
my ( $ts, $th ) = @_; |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
# parse test |
171
|
3
|
50
|
|
|
|
12
|
return parse_test( $ts, $th ) if $ts eq 'PARSE_TEST'; |
172
|
|
|
|
|
|
|
|
173
|
0
|
|
|
|
|
0
|
my ( $dow_begin, $dow_end, $time_begin, $time_end ) = _canonicalize_th( $th ); |
174
|
0
|
|
|
|
|
0
|
my ( $date_begin, $date_end ) = ( $dow_map{$dow_begin}, $dow_map{$dow_end} ); |
175
|
|
|
|
|
|
|
|
176
|
0
|
0
|
|
|
|
0
|
if ( exists( $memsched->{"$date_begin $time_begin"} ) ) { |
177
|
0
|
|
|
|
|
0
|
push @{ $memsched->{"$date_begin $time_begin"} }, "$date_end $time_end" |
178
|
0
|
0
|
|
|
|
0
|
unless grep { $_ eq "$date_end $time_end" } @{ $memsched->{"$date_begin $time_begin"} }; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
179
|
|
|
|
|
|
|
} else { |
180
|
0
|
|
|
|
|
0
|
$memsched->{"$date_begin $time_begin"} = [ "$date_end $time_end" ]; |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
|
183
|
0
|
0
|
|
|
|
0
|
print Dumper( $memsched ) if $debug_mode; |
184
|
|
|
|
|
|
|
|
185
|
0
|
|
|
|
|
0
|
return _dump_memsched_entries(); |
186
|
|
|
|
|
|
|
} |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
=head3 replicate_memsched_entry |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
SCHEDULE ALL _TIMERANGE |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
Apply timerange to all five days MON-FRI |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
=cut |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
sub replicate_memsched_entry { |
198
|
1
|
50
|
|
1
|
1
|
5
|
print "Entering " . __PACKAGE__ . "::add_memsched_entry\n" if $debug_mode; |
199
|
1
|
|
|
|
|
2
|
my ( $ts, $th ) = @_; |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
# parse test |
202
|
1
|
50
|
|
|
|
5
|
return parse_test( $ts, $th ) if $ts eq 'PARSE_TEST'; |
203
|
|
|
|
|
|
|
|
204
|
0
|
|
|
|
|
0
|
foreach my $dow ( qw( MON TUE WED THU FRI ) ) { |
205
|
0
|
|
|
|
|
0
|
$th->{_DOW} = $dow; |
206
|
0
|
|
|
|
|
0
|
add_memsched_entry( $ts, $th ); |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
|
209
|
0
|
|
|
|
|
0
|
return _dump_memsched_entries(); |
210
|
|
|
|
|
|
|
} |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
=head3 clear_memsched_entries |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
SCHEDULE CLEAR |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
=cut |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
sub clear_memsched_entries { |
220
|
1
|
50
|
|
1
|
1
|
4
|
print "Entering " . __PACKAGE__ . "::clear_memsched_entries\n" if $debug_mode; |
221
|
1
|
|
|
|
|
2
|
my ( $ts, $th ) = @_; |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
# parse test |
224
|
1
|
50
|
|
|
|
6
|
return parse_test( $ts, $th ) if $ts eq 'PARSE_TEST'; |
225
|
|
|
|
|
|
|
|
226
|
0
|
|
|
|
|
0
|
$memsched = {}; |
227
|
0
|
|
|
|
|
0
|
$memsched_scode = ''; |
228
|
0
|
|
|
|
|
0
|
return $CELL->status_ok( 'DOCHAZKA_CLI_MEMSCHED_EMPTY' ); |
229
|
|
|
|
|
|
|
} |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
=head3 fetch_all_schedules |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
SCHEDULES FETCH ALL |
235
|
|
|
|
|
|
|
SCHEDULES FETCH ALL DISABLED |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
Get all schedules and dump them to the screen. |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
=cut |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
sub fetch_all_schedules { |
242
|
2
|
50
|
|
2
|
1
|
6
|
print "Entering " . __PACKAGE__ . "::fetch_all_schedules\n" if $debug_mode; |
243
|
2
|
|
|
|
|
3
|
my ( $ts, $th ) = @_; |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
# parse test |
246
|
2
|
50
|
|
|
|
9
|
return parse_test( $ts, $th ) if $ts eq 'PARSE_TEST'; |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
my $status = ( $th->{DISABLED} ) |
249
|
0
|
0
|
|
|
|
0
|
? send_req( 'GET', 'schedule/all/disabled' ) |
250
|
|
|
|
|
|
|
: send_req( 'GET', 'schedule/all' ); |
251
|
0
|
0
|
|
|
|
0
|
if ( $status->ok ) { |
252
|
0
|
|
|
|
|
0
|
my $pl = ''; |
253
|
0
|
|
|
|
|
0
|
foreach my $sch_hash ( @{ $status->payload } ) { |
|
0
|
|
|
|
|
0
|
|
254
|
0
|
|
|
|
|
0
|
my $sch_obj = App::Dochazka::Common::Model::Schedule->spawn( %$sch_hash ); |
255
|
0
|
|
|
|
|
0
|
$pl .= print_schedule_object( $sch_obj ); |
256
|
0
|
|
|
|
|
0
|
$pl .= "\n"; |
257
|
|
|
|
|
|
|
} |
258
|
0
|
|
|
|
|
0
|
return $CELL->status_ok( 'DOCHAZKA_CLI_NORMAL_COMPLETION', payload => $pl ); |
259
|
|
|
|
|
|
|
} |
260
|
0
|
|
|
|
|
0
|
return $status; |
261
|
|
|
|
|
|
|
} |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
=head3 dump_memsched_entries |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
Dumps "memsched" (i.e. working schedule stored in memory) to the screen. |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
Note that L will happily let you build up a completely |
269
|
|
|
|
|
|
|
illegal and nonsensical schedule in memory, and submit it to the REST |
270
|
|
|
|
|
|
|
server. Data integrity controls for new schedule records are performed |
271
|
|
|
|
|
|
|
on server-side. |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
SCHEDULE DUMP |
274
|
|
|
|
|
|
|
SCHEDULE MEMORY |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
=cut |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
sub dump_memsched_entries { |
279
|
2
|
50
|
|
2
|
1
|
5
|
print "Entering " . __PACKAGE__ . "::dump_memsched_entries\n" if $debug_mode; |
280
|
2
|
|
|
|
|
4
|
my ( $ts, $th ) = @_; |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
# parse test |
283
|
2
|
50
|
|
|
|
8
|
return parse_test( $ts, $th ) if $ts eq 'PARSE_TEST'; |
284
|
|
|
|
|
|
|
|
285
|
0
|
|
|
|
|
0
|
my $pl = ''; |
286
|
|
|
|
|
|
|
|
287
|
0
|
0
|
|
|
|
0
|
if ( $memsched_scode ) { |
288
|
0
|
|
|
|
|
0
|
$pl .= "Schedule code: $memsched_scode\n\n"; |
289
|
|
|
|
|
|
|
} |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
# sort entries by beginning and ending timestamp |
292
|
0
|
|
|
|
|
0
|
foreach my $start_str ( sort keys %$memsched ) { |
293
|
0
|
|
|
|
|
0
|
my ( $start_date, $start_time ) = $start_str =~ m/(.*) (.*)/; |
294
|
0
|
|
|
|
|
0
|
my $start_converted = $date_map{$start_date} . " " . $start_time; |
295
|
0
|
|
|
|
|
0
|
foreach my $end_str ( sort @{ $memsched->{$start_str} } ) { |
|
0
|
|
|
|
|
0
|
|
296
|
0
|
|
|
|
|
0
|
my ( $end_date, $end_time ) = $end_str =~ m/(.*) (.*)/; |
297
|
0
|
|
|
|
|
0
|
my $end_converted = $date_map{$end_date} . " " . $end_time; |
298
|
0
|
|
|
|
|
0
|
$pl .= "[ $start_converted, $end_converted )\n"; |
299
|
|
|
|
|
|
|
} |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
|
302
|
0
|
0
|
|
|
|
0
|
my $code = $pl ? 'DOCHAZKA_CLI_MEMSCHED' : 'DOCHAZKA_CLI_MEMSCHED_EMPTY'; |
303
|
0
|
|
|
|
|
0
|
return $CELL->status_ok( $code, payload => $pl ); |
304
|
|
|
|
|
|
|
} |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
=head3 schedule_new |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
Submits the "memsched" (i.e. working schedule stored in memory) to the REST |
310
|
|
|
|
|
|
|
server via 'POST submit/new'. |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
SCHEDULE NEW |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
=cut |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
sub schedule_new { |
317
|
1
|
50
|
|
1
|
1
|
3
|
print "Entering " . __PACKAGE__ . "::schedule_new\n" if $debug_mode; |
318
|
1
|
|
|
|
|
3
|
my ( $ts, $th ) = @_; |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
# parse test |
321
|
1
|
50
|
|
|
|
6
|
return parse_test( $ts, $th ) if $ts eq 'PARSE_TEST'; |
322
|
|
|
|
|
|
|
|
323
|
0
|
|
|
|
|
0
|
my @pl; |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
# make sure there are some memsched entries to begin with |
326
|
0
|
0
|
|
|
|
0
|
if ( ! $memsched ) { |
327
|
0
|
|
|
|
|
0
|
return $CELL->status_err( 'DOCHAZKA_CLI_NO_SCHEDULE_ENTRIES_IN_MEMORY' ); |
328
|
|
|
|
|
|
|
} |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
# sort entries by beginning and ending timestamp |
331
|
0
|
|
|
|
|
0
|
foreach my $start_str ( sort keys %$memsched ) { |
332
|
0
|
|
|
|
|
0
|
foreach my $end_str ( sort @{ $memsched->{$start_str} } ) { |
|
0
|
|
|
|
|
0
|
|
333
|
0
|
|
|
|
|
0
|
push @pl, "[ $start_str, $end_str )"; |
334
|
|
|
|
|
|
|
} |
335
|
|
|
|
|
|
|
} |
336
|
|
|
|
|
|
|
|
337
|
0
|
|
|
|
|
0
|
my $sched = { "schedule" => \@pl }; |
338
|
0
|
0
|
|
|
|
0
|
$sched->{'scode'} = $memsched_scode if $memsched_scode; |
339
|
0
|
|
|
|
|
0
|
my $json = encode_json $sched; |
340
|
|
|
|
|
|
|
|
341
|
0
|
|
|
|
|
0
|
my $status = send_req( 'POST', 'schedule/new', $json ); |
342
|
0
|
0
|
|
|
|
0
|
if ( $status->ok ) { |
343
|
0
|
|
|
|
|
0
|
my $sch_obj = App::Dochazka::Common::Model::Schedule->spawn( %{ $status->payload } ); |
|
0
|
|
|
|
|
0
|
|
344
|
0
|
|
|
|
|
0
|
my $pl = ''; |
345
|
0
|
0
|
|
|
|
0
|
if ( my $http_status = $status->{'http_status'} ) { |
346
|
0
|
|
|
|
|
0
|
$pl .= "HTTP status: $http_status\n"; |
347
|
|
|
|
|
|
|
} |
348
|
0
|
|
|
|
|
0
|
$pl .= print_schedule_object( $sch_obj ); |
349
|
0
|
|
|
|
|
0
|
_clear_memsched_entries(); |
350
|
0
|
|
|
|
|
0
|
return $CELL->status_ok( |
351
|
|
|
|
|
|
|
'DOCHAZKA_CLI_NORMAL_COMPLETION', |
352
|
|
|
|
|
|
|
http_status => '200 OK', |
353
|
|
|
|
|
|
|
payload => $pl |
354
|
|
|
|
|
|
|
); |
355
|
|
|
|
|
|
|
} |
356
|
0
|
|
|
|
|
0
|
return $status; |
357
|
|
|
|
|
|
|
} |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
=head3 assign_memsched_scode |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
SCHEDULE SCODE _TERM |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
Assign an 'scode' value to the "memsched" (local memory buffer) schedule. |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
=cut |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
sub assign_memsched_scode { |
369
|
1
|
50
|
|
1
|
1
|
4
|
print "Entering " . __PACKAGE__ . "::assign_memsched_scode\n" if $debug_mode; |
370
|
1
|
|
|
|
|
3
|
my ( $ts, $th ) = @_; |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
# parse test |
373
|
1
|
50
|
|
|
|
5
|
return parse_test( $ts, $th ) if $ts eq 'PARSE_TEST'; |
374
|
|
|
|
|
|
|
|
375
|
0
|
|
|
|
|
0
|
$memsched_scode = $th->{_TERM}; |
376
|
|
|
|
|
|
|
|
377
|
0
|
|
|
|
|
0
|
return _dump_memsched_entries(); |
378
|
|
|
|
|
|
|
} |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
=head3 schedulespec |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
SCHEDULE_SPEC |
384
|
|
|
|
|
|
|
SCHEDULE_SPEC SHOW |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
=cut |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
sub schedulespec { |
389
|
2
|
50
|
|
2
|
1
|
8
|
print "Entering " . __PACKAGE__ . "::schedulespec\n" if $debug_mode; |
390
|
2
|
|
|
|
|
2
|
my ( $ts, $th ) = @_; |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
# parse test |
393
|
2
|
50
|
|
|
|
9
|
return parse_test( $ts, $th ) if $ts eq 'PARSE_TEST'; |
394
|
|
|
|
|
|
|
|
395
|
0
|
|
|
|
|
0
|
my ( $key_spec, $key ) = $th->{'SCHEDULE_SPEC'} =~ m/^(.*)\=(.*)$/; |
396
|
|
|
|
|
|
|
|
397
|
0
|
|
|
|
|
0
|
my ( $status, $pl ); |
398
|
0
|
0
|
|
|
|
0
|
if ( $key_spec =~ m/^sco/i ) { |
|
|
0
|
|
|
|
|
|
399
|
0
|
|
|
|
|
0
|
$status = send_req( 'GET', "schedule/scode/$key" ); |
400
|
|
|
|
|
|
|
} elsif ( $key_spec =~ m/^sid/ ) { |
401
|
0
|
|
|
|
|
0
|
$status = send_req( 'GET', "schedule/sid/$key" ); |
402
|
|
|
|
|
|
|
} else { |
403
|
0
|
0
|
|
|
|
0
|
die "AAAHAAAHHH!!! Invalid schedule lookup key " . ( defined( $key_spec ) ? $key_spec : "undefined" ) |
404
|
|
|
|
|
|
|
} |
405
|
|
|
|
|
|
|
|
406
|
0
|
0
|
|
|
|
0
|
if ( $status->ok ) { |
407
|
0
|
|
|
|
|
0
|
my $sch_obj = App::Dochazka::Common::Model::Schedule->spawn( %{ $status->payload } ); |
|
0
|
|
|
|
|
0
|
|
408
|
0
|
|
|
|
|
0
|
$pl = print_schedule_object( $sch_obj ); |
409
|
0
|
|
|
|
|
0
|
return $CELL->status_ok( "DOCHAZKA_CLI_NORMAL_COMPLETION", payload => $pl ); |
410
|
|
|
|
|
|
|
} |
411
|
|
|
|
|
|
|
|
412
|
0
|
|
|
|
|
0
|
return $status; |
413
|
|
|
|
|
|
|
} |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
=head3 schedulespec_remark |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
SCHEDULE_SPEC REMARK _TERM |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
=cut |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
sub schedulespec_remark { |
423
|
2
|
50
|
|
2
|
1
|
7
|
print "Entering " . __PACKAGE__ . "::schedulespec_remark\n" if $debug_mode; |
424
|
2
|
|
|
|
|
3
|
my ( $ts, $th ) = @_; |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
# parse test |
427
|
2
|
50
|
|
|
|
9
|
return parse_test( $ts, $th ) if $ts eq 'PARSE_TEST'; |
428
|
|
|
|
|
|
|
|
429
|
0
|
|
|
|
|
0
|
my ( $key_spec, $key ) = $th->{'SCHEDULE_SPEC'} =~ m/^(.*)\=(.*)$/; |
430
|
0
|
|
|
|
|
0
|
my $remark = $th->{'_REST'}; |
431
|
0
|
|
|
|
|
0
|
$remark =~ s/\"/\'/g; |
432
|
|
|
|
|
|
|
|
433
|
0
|
|
|
|
|
0
|
my $status; |
434
|
0
|
0
|
|
|
|
0
|
if ( $key_spec =~ m/^sco/i ) { |
|
|
0
|
|
|
|
|
|
435
|
0
|
|
|
|
|
0
|
$status = send_req( 'PUT', "schedule/scode/$key", <<"EOS" ); |
436
|
|
|
|
|
|
|
{ "remark" : "$remark" } |
437
|
|
|
|
|
|
|
EOS |
438
|
|
|
|
|
|
|
} elsif ( $key_spec =~ m/^sid/ ) { |
439
|
0
|
|
|
|
|
0
|
$status = send_req( 'PUT', "schedule/sid/$key", <<"EOS" ); |
440
|
|
|
|
|
|
|
{ "remark" : "$remark" } |
441
|
|
|
|
|
|
|
EOS |
442
|
|
|
|
|
|
|
} else { |
443
|
0
|
0
|
|
|
|
0
|
die "AAAHAAAHHH!!! Invalid schedule lookup key " . ( defined( $key_spec ) ? $key_spec : "undefined" ) |
444
|
|
|
|
|
|
|
} |
445
|
|
|
|
|
|
|
|
446
|
0
|
0
|
0
|
|
|
0
|
if ( $status->level eq 'OK' and $status->code eq 'DOCHAZKA_CUD_OK' ) { |
447
|
0
|
|
|
|
|
0
|
my $sch_obj = App::Dochazka::Common::Model::Schedule->spawn( %{ $status->payload } ); |
|
0
|
|
|
|
|
0
|
|
448
|
0
|
|
|
|
|
0
|
my $pl = print_schedule_object( $sch_obj ); |
449
|
0
|
|
|
|
|
0
|
return $CELL->status_ok( 'DOCHAZKA_CLI_NORMAL_COMPLETION', payload => $pl ); |
450
|
|
|
|
|
|
|
} |
451
|
|
|
|
|
|
|
|
452
|
0
|
|
|
|
|
0
|
return $status; |
453
|
|
|
|
|
|
|
} |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
=head3 schedulespec_scode |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
SCHEDULE_SPEC SCODE _TERM |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
=cut |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
sub schedulespec_scode { |
462
|
2
|
50
|
|
2
|
1
|
7
|
print "Entering " . __PACKAGE__ . "::schedulespec_scode\n" if $debug_mode; |
463
|
2
|
|
|
|
|
3
|
my ( $ts, $th ) = @_; |
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
# parse test |
466
|
2
|
50
|
|
|
|
8
|
return parse_test( $ts, $th ) if $ts eq 'PARSE_TEST'; |
467
|
|
|
|
|
|
|
|
468
|
0
|
|
|
|
|
|
my ( $key_spec, $key ) = $th->{'SCHEDULE_SPEC'} =~ m/^(.*)\=(.*)$/; |
469
|
0
|
|
|
|
|
|
my $scode = $th->{'_TERM'}; |
470
|
|
|
|
|
|
|
|
471
|
0
|
|
|
|
|
|
my $status; |
472
|
0
|
0
|
|
|
|
|
if ( $key_spec =~ m/^sco/i ) { |
|
|
0
|
|
|
|
|
|
473
|
0
|
|
|
|
|
|
$status = send_req( 'PUT', "schedule/scode/$key", <<"EOS" ); |
474
|
|
|
|
|
|
|
{ "scode" : "$scode" } |
475
|
|
|
|
|
|
|
EOS |
476
|
|
|
|
|
|
|
} elsif ( $key_spec =~ m/^sid/ ) { |
477
|
0
|
|
|
|
|
|
$status = send_req( 'PUT', "schedule/sid/$key", <<"EOS" ); |
478
|
|
|
|
|
|
|
{ "scode" : "$scode" } |
479
|
|
|
|
|
|
|
EOS |
480
|
|
|
|
|
|
|
} else { |
481
|
0
|
0
|
|
|
|
|
die "AAAHAAAHHH!!! Invalid schedule lookup key " . ( defined( $key_spec ) ? $key_spec : "undefined" ) |
482
|
|
|
|
|
|
|
} |
483
|
|
|
|
|
|
|
|
484
|
0
|
0
|
0
|
|
|
|
if ( $status->level eq 'OK' and $status->code eq 'DOCHAZKA_CUD_OK' ) { |
485
|
0
|
|
|
|
|
|
my $sch_obj = App::Dochazka::Common::Model::Schedule->spawn( %{ $status->payload } ); |
|
0
|
|
|
|
|
|
|
486
|
0
|
|
|
|
|
|
my $pl = print_schedule_object( $sch_obj ); |
487
|
0
|
|
|
|
|
|
return $CELL->status_ok( 'DOCHAZKA_CLI_NORMAL_COMPLETION', payload => $pl ); |
488
|
|
|
|
|
|
|
} |
489
|
|
|
|
|
|
|
|
490
|
0
|
|
|
|
|
|
return $status; |
491
|
|
|
|
|
|
|
} |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
=head2 Helper functions |
496
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
Functions called by multiple command handlers |
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
=head3 _canonicalize_th |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
The canonical form is "SCHEDULE _DOW _TIME _DOW1 _TIME1" |
503
|
|
|
|
|
|
|
so if we get one of the other forms, we "canonicalize th" |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
=cut |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
sub _canonicalize_th { |
508
|
0
|
|
|
0
|
|
|
my $th = shift; |
509
|
0
|
0
|
|
|
|
|
print "Entering " . __PACKAGE__ . "::_canonicalize_th with th: " . Dumper( $th ) . "\n" if $debug_mode; |
510
|
|
|
|
|
|
|
|
511
|
0
|
|
|
|
|
|
my ( $dow_begin, $dow_end, $time_begin, $time_end ); |
512
|
|
|
|
|
|
|
|
513
|
0
|
|
|
|
|
|
$dow_begin = uc( $th->{'_DOW'} ); |
514
|
0
|
0
|
|
|
|
|
if ( $th->{_TIMERANGE} ) { |
515
|
0
|
|
|
|
|
|
$dow_end = $dow_begin; |
516
|
0
|
|
|
|
|
|
( $time_begin, $time_end ) = $th->{_TIMERANGE} =~ m/(.*)-(.*)/; |
517
|
|
|
|
|
|
|
} else { |
518
|
0
|
|
|
|
|
|
$dow_end = uc( $th->{'_DOW1'} ); |
519
|
0
|
|
|
|
|
|
$time_begin = $th->{'_TIME'}; |
520
|
0
|
|
|
|
|
|
$time_end = $th->{'_TIME1'}; |
521
|
|
|
|
|
|
|
} |
522
|
0
|
|
|
|
|
|
my ( $tbh, $tbm ) = $time_begin =~ m/(.*):(.*)/; |
523
|
0
|
|
|
|
|
|
$time_begin = sprintf( "%02d:%02d", $tbh, $tbm ); |
524
|
0
|
|
|
|
|
|
my ( $teh, $tem ) = $time_end =~ m/(.*):(.*)/; |
525
|
0
|
|
|
|
|
|
$time_end = sprintf( "%02d:%02d", $teh, $tem ); |
526
|
|
|
|
|
|
|
|
527
|
0
|
|
|
|
|
|
return ( $dow_begin, $dow_end, $time_begin, $time_end ); |
528
|
|
|
|
|
|
|
} |
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
|
531
|
|
|
|
|
|
|
=head3 _clear_memsched_entries |
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
Since clear_memsched_entries is a command handler, if we want to call it from |
534
|
|
|
|
|
|
|
within this module we have to use a special argument. Thus we can have our cake |
535
|
|
|
|
|
|
|
and eat it, too. |
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
=cut |
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
sub _clear_memsched_entries { |
540
|
0
|
|
|
0
|
|
|
return clear_memsched_entries( 'DUMMY_ARG' => 0 ); |
541
|
|
|
|
|
|
|
} |
542
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
=head3 _dump_memsched_entries |
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
Since dump_memsched_entries is a command handler, if we want to call it from |
547
|
|
|
|
|
|
|
within this module we have to use a special argument. Thus we can have our cake |
548
|
|
|
|
|
|
|
and eat it, too. |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
=cut |
551
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
sub _dump_memsched_entries { |
553
|
0
|
|
|
0
|
|
|
return dump_memsched_entries( 'DUMMY_ARG' => 0 ); |
554
|
|
|
|
|
|
|
} |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
1; |