File Coverage

blib/lib/Calendar/Schedule.pm
Criterion Covered Total %
statement 281 579 48.5
branch 78 254 30.7
condition 26 80 32.5
subroutine 17 25 68.0
pod 10 17 58.8
total 412 955 43.1


line stmt bran cond sub pod time code
1             # Calendar::Schedule - Manage calendar schedules
2             # (c) 2002-2020 Vlado Keselj http://web.cs.dal.ca/~vlado vlado@dnlp.ca
3             # and contributing authors
4             #
5             # Some parts are updated with Starfish during development, such as the version
6             # number:
7              
8             package Calendar::Schedule;
9 1     1   1421 use strict;
  1         2  
  1         34  
10             require Exporter;
11 1     1   583 use POSIX;
  1         6551  
  1         10  
12              
13 1     1   2866 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); # Exporter vars
  1         2  
  1         170  
14             our @ISA = qw(Exporter);
15              
16             our %EXPORT_TAGS = ( 'all' => [ qw( parse_time ) ] );
17             our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
18             our @EXPORT = qw(new);
19              
20             #{version}';"!>#+
21             our $VERSION = '1.20';#-
22              
23             # non-exported package globals
24 1     1   8 use vars qw( $REweekday3 $REmonth3 $RE1st );
  1         2  
  1         842  
25             $RE1st = qr/first|second|third|fourth|fifth|last|1st|2nd|3rd|4th|5th/;
26             $REweekday3 = qr/Mon|Tue|Wed|Thu|Fri|Sat|Sun/;
27             $REmonth3 = qr/Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec/;
28              
29             =head1 NAME
30              
31             Calendar::Schedule - manage calendar schedules
32              
33             =head1 SYNOPSIS
34              
35             use Calendar::Schedule qw/:all/;
36              
37             my $TTable = Calendar::Schedule->new();
38              
39             # manually adding an entry
40             $TTable->add_entry('2003-09-09 Tue 18-20 Some meeting');
41            
42             # reading entries from a file
43             $TTable->add_entries_from("$ENV{'HOME'}/.calendar");
44              
45             # producing entries in HTML tables, one table per week
46             $TTable->set_first_week('now');
47             print "

\n" . $TTable->generate_table();

48             print "

\n" . $TTable->generate_table();

49             print "

\n" . $TTable->generate_table();

50              
51             # for more examples, see EXAMPLES section
52              
53             The file .calendar may look like this:
54              
55             # comments can start with #
56             * lines starting with * are treated as general todo entries ...
57             # empty lines are acceptable and ignored:
58              
59             Mon 9:00-10:00 this is a weekly entry
60             Mon 13-14 a biweekly entry :biweekly :start Mar 8, 2004
61             Mon,Wed,Fri 15:30-16:30 several-days-a-week entry
62             Wed :biweekly garbage collection
63              
64             2004-03-06 Sat 14-16 fixed entry. The week day is redundant, but may\
65             help to detect errors (error will be reported if a wrong\
66             weekday is entered). BTW, an entry can go for several lines as\
67             long as there is a backslash at the end of each line.
68              
69             May 6 birthday (yearly entry)
70              
71             # more examples in "Example entries" section
72              
73             =head1 DESCRIPTION
74              
75             The module is created with a purpose to provide functionality for handling a
76             personal calendar schedule in a transparent and simple way. The calendar
77             data is assumed to be kept in a plain file in a format easy to edit and
78             understand. It was inspired by the C program on older Unix-like
79             systems, which used C<~/.calendar> file to produce entries for each day
80             and send them in the morning by email.
81              
82             Inspired by the C<~/.calendar> file, the format for recording scheduled
83             events is very simple, mostly contained in one line of text.
84              
85             The module currently supports generation of HTML weekly tables with visual
86             representation of scheduled events. The generated table is generated in
87             a simple HTML table, with a use of C and C attributes to
88             represent overlapping events in parallel in the table.
89              
90             =head2 Planned Future Work
91              
92             In the development of the recording format for the event, there is an attempt
93             to model the data representation of the iCalendar standard (RFC2445).
94             Examples of the iCalendar fields are: DTSTART, DTEND, SUMMARY,
95             RRULE (e.g. RRULE:FREQ=WEEKLY, RRULE:FREQ=WEEKLY;INTERVAL=2 for
96             biweekly, RRULE:FREQ=WEEKLY;UNTIL=20040408 ) etc.
97             More examples:
98              
99             RRULE:FREQ=MONTHLY;BYDAY=TU;BYSETPOS=3
100              
101             Every third Tuesday in a month.
102              
103             =head1 EXAMPLES
104              
105             First example:
106              
107             use Calendar::Schedule qw/:all/;
108              
109             my $TTable = Calendar::Schedule->new();
110              
111             # manually adding an entry
112             $TTable->add_entry('2003-09-09 Tue 18-20 Some meeting');
113            
114             # reading entries from a file
115             $TTable->add_entries_from("$ENV{'HOME'}/.calendar");
116              
117             # producing entries in HTML tables
118             $TTable->set_first_week('2003-12-15');
119             print "

\n" . $TTable->generate_table();

120             print "

\n" . $TTable->generate_table();

121             print "

\n" . $TTable->generate_table();

122              
123             Example with generating a weekly schedule (example2):
124              
125             use Calendar::Schedule;
126             $TTable = Calendar::Schedule->new();
127             $TTable->{'ColLabel'} = "%A";
128             $TTable->add_entries(<
129             Mon 15:30-16:30 Teaching (CSCI 3136)
130             Tue 10-11:30 Teaching (ECMM 6014)
131             Wed 13:30-14:30 DNLP
132             Wed 15:30-16:30 Teaching (CSCI 3136) :until Apr 8, 2005
133             Thu 10-11:30 Teaching (ECMM 6014)
134             Thu 16-17 WIFL
135             Fri 14:30-15:30 MALNIS
136             Fri 15:30-16:30 Teaching (CSCI 3136)
137             EOT
138             );
139             print "

\n" . $TTable->generate_table();

140              
141             This will produce the following HTML code (if run before Apr 8, 2005):
142              
143             =for html
144            

145            
146            
147              
148             Monday
149             Tuesday
150             Wednesday
151             Thursday
152             Friday
153             Saturday
154             Sunday
155            
156            
08:00
157              
158              
159              
160              
161              
162              
163              
164            
165            
10:00
166              
167             Teaching (ECMM 6014)
168              
169             Teaching (ECMM 6014)
170              
171              
172              
173            
174            
11:30
175              
176              
177              
178              
179              
180              
181              
182            
183            
12:00
184              
185              
186              
187              
188              
189              
190              
191            
192            
13:30
193              
194              
195             DNLP
196              
197              
198              
199              
200            
201            
14:30
202              
203              
204              
205              
206             MALNIS
207              
208              
209            
210            
15:30
211             Teaching (CSCI 3136)
212              
213             Teaching (CSCI 3136)
214              
215             Teaching (CSCI 3136)
216              
217              
218            
219            
16:00
220            
221              
222            
223             WIFL
224            
225              
226              
227            
228            
16:30
229              
230              
231              
232            
233              
234              
235              
236            
237            
17:00
238              
239              
240              
241              
242              
243              
244              
245            
246            
247              
248             =head2 Conflicts
249              
250             Time conflicts are handled by producing several columns in a table for
251             the same day. For example, the following code (example3):
252              
253             use Calendar::Schedule;
254             $TTable = Calendar::Schedule->new();
255             $TTable->{'ColLabel'} = "%A";
256             $TTable->add_entries(<
257              
258             Mon 15:30-16:30 Teaching (CSCI 3136)
259             Tue 10-11:30 Teaching (ECMM 6014)
260             Wed 13:30-14:30 DNLP
261             Wed 15:30-16:30 Teaching (CSCI 3136) :until Apr 8, 2005
262             Thu 10-11:30 Teaching (ECMM 6014)
263             Thu 16-17 WIFL
264             Fri 14:30-15:30 MALNIS
265             Fri 15:30-16:30 Teaching (CSCI 3136)
266             Wed 15-16 meeting
267             Wed 15:30-18 another meeting
268              
269             EOT
270             );
271             print "

\n" . $TTable->generate_table();

272              
273             will produce the following table (if run before Apr 8, 2005):
274              
275             =for html
276            

277            
278            
279              
280             Monday
281             Tuesday
282             Wednesday
283             Thursday
284             Friday
285             Saturday
286             Sunday
287            
288            
08:00
289              
290              
291              
292              
293              
294              
295              
296              
297              
298            
299            
10:00
300              
301             Teaching (ECMM 6014)
302              
303              
304              
305             Teaching (ECMM 6014)
306              
307              
308              
309            
310            
11:30
311              
312              
313              
314              
315              
316              
317              
318              
319              
320            
321            
12:00
322              
323              
324              
325              
326              
327              
328              
329              
330              
331            
332            
13:30
333              
334              
335             DNLP
336              
337              
338              
339              
340              
341              
342            
343            
14:30
344              
345              
346              
347              
348              
349              
350             MALNIS
351              
352              
353            
354            
15:00
355              
356              
357              
358             meeting
359              
360              
361            
362              
363              
364            
365            
15:30
366             Teaching (CSCI 3136)
367              
368             Teaching (CSCI 3136)
369            
370             another meeting
371              
372             Teaching (CSCI 3136)
373              
374              
375            
376            
16:00
377            
378              
379            
380              
381            
382             WIFL
383            
384              
385              
386            
387            
16:30
388              
389              
390              
391              
392            
393            
394              
395              
396              
397            
398            
17:00
399              
400              
401              
402              
403            
404              
405              
406              
407              
408            
409            
18:00
410              
411              
412              
413              
414              
415              
416              
417              
418              
419            
420            
421              
422             =head2 Example entries
423              
424             These are some example of simple entries that are accepted by the
425             C function or C for reading from a file.
426             Each entry is on a line by itself, but it can be continued in the the
427             following lines by using \ (backslash) at the end of the current line.
428             The time specificantions are generally at the beginning of an entry.
429             Examples:
430              
431             # comments can start with #
432             # empty lines are acceptable and ignored:
433              
434             Mon 9:00-10:00 this is a weekly entry
435             Mon 13-14 a biweekly entry :biweekly :start Mar 8, 2004
436             Mon,Wed,Fri 15:30-16:30 several-days-a-week entry
437             Wed :biweekly garbage collection
438              
439             2004-03-06 Sat 14-16 fixed entry. The week day is redundant, but may\
440             help to detect errors (error will be reported if a wrong\
441             weekday is entered). BTW, an entry can go for several lines as\
442             long as there is a backslash at the end of each line.
443              
444             May 6 an example birthday (yearly entry)
445              
446             Wed 13:30-14:30 DNLP
447             Wed 15:30-16:30 Teaching (CSCI 3136) :until Apr 8, 2005
448             Wed 3-4:30pm meeting
449             Mon,Wed,Fri 10:30-11:30 meeting (product team)
450             Mon 13-14 seminar :biweekly :start Mar 8, 2004
451             Tue,Thu 10-11:30 Class (ECMM 6014) Location: MCCAIN ARTS&SS 2022 :until Apr 8, 2004
452             1st,3rd Tue 10-11 meeting
453             1st,last Mon,Fri 4-5 meeting (4 meetings every month)
454             4th Thu 11:30-13 meeting (fcm)
455              
456             =head1 STATE VARIABLES
457              
458             =over 4
459              
460             =item StartTime
461              
462             Used as C<$obj-E{StartTime}>. Start time for various uses.
463             Usually it is the the beginning of the first interesting week.
464              
465             =item DefaultRowLabels
466              
467             Used as C<$obj-E{DefaultRowLabels}>. Includes pre-defined labels
468             for rows of the generated HTML schedule tables. The pre-defined value
469             is:
470              
471             $self->{DefaultRowLabels} = [qw( 08:00 12:00 17:00 )];
472              
473             =back
474              
475             =head1 METHODS
476              
477             =over 4
478              
479             =item new()
480              
481             Creates a new C object and returns it.
482              
483             =cut
484             sub new {
485 1     1 1 854 my $proto = shift;
486 1   33     8 my $class = ref($proto) || $proto;
487 1         6 my $self = { VEvents => [ ],
488             Entries => [ ],
489             Entries1 => [ ],
490             DayEntries => [ ],
491             ToDo => [ ],
492             RowLabels => [ ],
493             StartTime => 0,
494             ColLabel => "%A
%Y-%m-%d",
495             ShowDays => 'all', # 'workdays'
496             };
497              
498 1         3 bless($self, $class);
499              
500 1         6 $self->{'DefaultRowLabels'} = [ qw( 08:00 12:00 17:00 ) ];
501 1         3 $self->{'RowLabels'} = [ @{ $self->{'DefaultRowLabels'} } ];
  1         3  
502              
503 1         4 $self->set_first_week(time);
504              
505 1         20 return $self;
506             }
507              
508             =item set_first_week(time)
509              
510             sets start time at the last Monday before given date. It is used in generate_table.
511             Examples:
512              
513             $TTable = Calendar::Schedule->new();
514             $TTable->set_first_week('now');
515             $TTable->set_first_week('2016-02-19');
516              
517             See parse_time for examples for specifying time.
518             =cut
519             sub set_first_week {
520 1     1 1 2 my $self = shift;
521 1         2 my $arg = shift;
522 1         2 my $starttime = &parse_time($arg);
523              
524 1         14 $self->{'StartTime'} = $self->{'ContextTime'} =
525             &find_week_start($starttime);
526             }
527              
528             =item set_ColLabel(pattern)
529              
530             sets C pattern for column (day) labels. The default pattern
531             is "C<%AEbrE%Y-%m-%d>", which produces labels like:
532              
533             Friday
534             2003-12-19
535              
536             In order to have just a weekday name, use "C<%A>".
537              
538             =cut
539             sub set_ColLabel {
540 0     0 1 0 my $self = shift;
541 0         0 my $arg = shift;
542 0         0 $self->{'ColLabel'} = $arg;
543             }
544              
545             sub find_week_start {
546 2     2 0 4 my $starttime = shift;
547              
548 2         85 while ((localtime($starttime))[6] != 1)
549 3         44 { $starttime -= 86400 }
550              
551 2         30 while ((localtime($starttime))[2] != 0)
552 13         172 { $starttime -= 3600 }
553              
554 2         29 while ((localtime($starttime))[1] != 0)
555 36         464 { $starttime -= 60 }
556              
557 2         37 while ((localtime($starttime))[0] != 0)
558 24         405 { $starttime -- }
559              
560 2         11 return $starttime;
561             }
562              
563             =item parse_time(time_specification[,prefix])
564              
565             Parses time specification and returns the calendar time (see mktime in
566             Perl). The functions dies if the time cannot be completely recognized.
567             If prefix is set to true (1), then only a prefix of the string can be
568             a time specification. If prefix is set to 1, then in an array context
569             it will return a 2-element list: the calendar time and the
570             remainder of the string. Format examples:
571              
572             2004-03-17
573             now
574             Mar 8, 2004
575             1-Jul-2005
576              
577             =cut
578             #mktime(sec,min,hour,mday,mon,year,wday=0,yday=0,isdst=0)
579             #mon,wday,yday start with 0,wday starts with Sun,year starts with 1900
580             # usually set last 3 to -1
581             # ('YYYY-MM-DD') now
582             sub parse_time {
583 1     1 1 2 my $time = shift;
584 1         2 my $prefix = shift;
585 1 50       5 my $endrex = ( $prefix ? qr// : qr/\s*$/ );
586 1         2 my ($ret, $ret2);
587 1         1 my $monrex = $REmonth3;
588 1 50       181 if ($time =~ /^(\d\d\d\d)-(\d\d)-(\d\d) (\d\d?):(\d\d)$endrex/)
    50          
    50          
    50          
    50          
    50          
    0          
589 0         0 { $ret = mktime(0,$5,$4,$3,$2-1,$1-1900,-1,-1,-1) }
590             elsif ($time =~ /^(\d\d\d\d)-(\d\d)-(\d\d)$endrex/)
591 0         0 { $ret = mktime(0,0,0,$3,$2-1,$1-1900,-1,-1,-1) }
592             elsif ($time =~ /^(\d\d)-(\d\d)-(\d\d\d\d)$endrex/)
593 0         0 { $ret = mktime(0,0,0,$1,$2-1,$3-1900,-1,-1,-1) }
594             elsif ($time =~ /^(\d?\d)-($monrex)-(\d\d\d\d)\b$endrex/)
595 0         0 { $ret = mktime(0,0,0,$1,&month_to_digits($2),$3-1900,-1,-1,-1) }
596             elsif ($time =~ /^($monrex) (\d?\d), (\d\d\d\d)\b$endrex/)
597 0         0 { $ret = mktime(0,0,0,$2,&month_to_digits($1),$3-1900,-1,-1,-1) }
598 1         3 elsif ($time =~ /^\d+$endrex/) { $ret = $time }
599 0         0 elsif ($time =~/^now\b$endrex/) { $ret = time }
600 1     1   8 else { use Carp; confess "cannot parse time:($time)" }
  1         3  
  1         6897  
  0         0  
601 1         5 $ret2 = $';
602 1 50       7 return wantarray ? ($ret, $ret2) : $ret;
603             }
604              
605             =item add_entries_from(file_name)
606              
607             Adds entries from a file. See method add_entries and add_entry for format explanation.
608              
609             =cut
610             sub add_entries_from {
611 0     0 1 0 my $self = shift;
612 0         0 my $fname = shift;
613 0         0 return $self->add_entries(scalar(_getfile($fname)));
614             }
615              
616             =item add_entries(list_of_entries)
617              
618             Adds more entries. Each entry may contain several entries separated
619             by a new-line, except if the line ends with \.
620             Empty lines and lines that start with \s*# are ignored.
621             See add_entry for further explanation of format.
622              
623             =cut
624             sub add_entries {
625 1     1 1 7 my $self = shift;
626 1         4 while ($#_ > -1) {
627 1         2 my $entries = shift;
628 1         11 foreach my $en (split(/(?
629 10 50       42 next if $en =~ /^\s*$/;
630 10 50       32 next if $en =~ /^\s*#/;
631 10         20 $en =~ s/\\\n/\n/g;
632 10         23 $self->add_entry($en);
633             }
634             }
635             }
636              
637             =item add_entry(list_of_entries)
638              
639             Adds more entries. It is different from add_entries because this
640             method does not break entries on new-lines, although it does accept a
641             list of entries as arguments.
642              
643             Examples:
644              
645             $TTable->add_entry('Mon 8-17', 'Labour Day');
646             $TTable->add_entry('2003-09-09 Tue 18-20 Some meeting');
647              
648             More format examples:
649              
650             Wed 3-4:30pm meeting
651             Mon,Wed,Fri 15:30-16:30 meeting (product team)
652             Mon 13-14 seminar :biweekly :start Mar 8, 2004
653             Tue,Thu 10-11:30 Class (ECMM 6014) Location: MCCAIN ARTS&SS 2022 :until Apr 8, 2004
654             1st,3rd Tue 10-11 meeting
655             1st,last Mon,Fri 4-5 meeting (4 meetings every month)
656              
657             More examples can be found in section "Example entries".
658              
659             =cut
660             sub add_entry {
661 10     10 1 15 my $self = shift;
662              
663 10 50       25 if ($#_ <= 1) { # entry not structured, needs to be
664             # parsed (string)
665 10         14 my $timeslot = shift;
666 10         18 my $description;
667 10 50       17 if ($#_ == 0) { $description = shift }
  0         0  
668             else {
669 10         17 local $_ = $timeslot;
670             #2003-09-09 Tue 18-20
671 10 50 0     205 if (/^\d\d\d\d-\d\d-\d\d $REweekday3 \d\d?(:\d\d)?-\d\d?(:\d\d)?([ap]m)? /)
    50          
    50          
    0          
    0          
    0          
    0          
    0          
672 0         0 { $timeslot = $&; $description = $'; }
  0         0  
673             elsif (/^\d\d\d\d-\d\d-\d\d \d\d?(:\d\d)?-\d\d?(:\d\d)?([ap]m)? /)
674 0         0 { $timeslot = $&; $description = $'; }
  0         0  
675             #
676             elsif (/^$REweekday3(?:,$REweekday3)*\s+\d\d?(:\d\d)?-\d\d?(:\d\d)?([ap]m)? /)
677 10         30 { $timeslot = $&; $description = $'; }
  10         21  
678             #
679             elsif (/^$RE1st(,$RE1st)*
680             \ $REweekday3(?:,$REweekday3)*\s+\d\d?(:\d\d)?-\d\d?(:\d\d)?([ap]m)?\ /x)
681 0         0 { $timeslot = $&; $description = $'; }
  0         0  
682             #iso8601 thanks to Mike Vasiljevs
683             elsif (/^(\d\d\d\d-\d\d-\d\d)T(\d\d:\d\d:\d\d)-
684             (\d\d\d\d-\d\d-\d\d)T(\d\d:\d\d:\d\d)?/x)
685 0         0 { $timeslot = $&; $description = $'; }
  0         0  
686             elsif (/^(\d\d\d\d-\d\d-\d\d) / ||
687             /^(\d?\d-\w\w\w-\d\d\d\d) /
688             )
689             {
690 0         0 $timeslot = parse_time($1);
691 0         0 $description = $';
692 0         0 push @{ $self->{'DayEntries'}},
  0         0  
693             { date => $timeslot, description => $description };
694 0         0 return;
695             }
696             elsif (/^\*\s*/) {
697 0         0 push @{ $self->{'ToDo'}}, { desc=>$' };
  0         0  
698 0         0 return;
699             }
700             #
701 0         0 elsif (/^($REweekday3)\b\s*/) { $timeslot=$1; $description=$'; }
  0         0  
702 0         0 else { ($timeslot, $description) = parse_time($_, 1) }
703 10         43 $timeslot =~ s/\s+$//;
704             }
705              
706 10         19 my ($starttime, $endtime);
707              
708 10 50       111 if ($timeslot =~ /^($REweekday3(?:,$REweekday3)*)\s+(\d\d?(?::\d\d)?)-(\d\d?(?::\d\d)?)((?:[ap]m)?)$/) {
    0          
    0          
    0          
    0          
    0          
709 10         48 my ($days,$stime,$etime,$ampm) = ($1, $2, $3, $4);
710 10         17 $stime .= $ampm; $etime .= $ampm;
  10         13  
711              
712 10         16 my $rrule = 'FREQ=WEEKLY';
713 10 50       25 if ($description =~ /\s*:biweekly\b\s*/) {
714 0         0 $description = "$` $'";
715 0         0 $rrule .= ':INTERVAL=2';
716             }
717 10 50       19 if ($description =~ /\s*:until\s+/) {
718 0         0 my $p1 = $`; my $p2 = $';
  0         0  
719 0         0 my ($t, $p2n) = parse_time($p2, 1);
720 0         0 $description = "$p1 $p2n";
721 0         0 $rrule .= ";UNTIL=".$self->find_next_time("23:59", $t);
722             }
723 10         18 my $starttime = $self->{'StartTime'};
724 10 50       20 if ($description =~ /:start\s+/) {
725 0         0 my $d1 = $`; my $d2 = $';
  0         0  
726 0         0 ($starttime, $d2) = parse_time($d2, 1);
727 0         0 $description = "$d1$d2";
728             }
729            
730 10         27 foreach my $d (split(/,/, $days)) {
731 10         17 my %vevent = ();
732 10         19 $vevent{'RRULE'} = $rrule;
733 10         27 $vevent{'DTSTART'} = $self->find_next_time("$d $stime", $starttime);
734 10         37 $vevent{'DTEND'} = $self->find_next_time("$d $etime", $starttime);
735 10         26 while ($vevent{'DTEND'} < $vevent{'DTSTART'})
736 0         0 { $vevent{'DTEND'} = $self->find_next_time("$d $etime", $vevent{'DTEND'}) }
737 10         18 $vevent{'SUMMARY'} = $description;
738 10         13 push @{ $self->{'VEvents'} }, \%vevent;
  10         34  
739             }
740 10         70 return;
741             }
742             # pattern 1:
743             elsif ($timeslot =~ /^($RE1st(?:,$RE1st)*)\s+
744             ($REweekday3(?:,$REweekday3)*)\s+
745             (\d\d?(?::\d\d)?)-(\d\d?(?::\d\d)?)([ap]m)?$
746             /ix) { # pattern 1:
747 0         0 my ($first,$days,$stime,$etime,$ampm) = ($1,$2,$3,$4,$5);
748 0         0 $stime .= $ampm; $etime .= $ampm;
  0         0  
749             # example: RRULE:FREQ=MONTHLY;BYDAY=+3TU
750 0         0 my $rrule = 'FREQ=MONTHLY'; my @first;
  0         0  
751 0         0 foreach my $f (split(/,/, $first)) {
752 0         0 my $f1;
753 0 0       0 if ($f =~ /^first|1st$/) { $f1 = '+1' }
  0 0       0  
    0          
    0          
    0          
    0          
754 0         0 elsif ($f =~ /^second|2nd$/) { $f1 = '+2' }
755 0         0 elsif ($f =~ /^third|3rd$/) { $f1 = '+3' }
756 0         0 elsif ($f =~ /^fourth|4th$/) { $f1 = '+4' }
757 0         0 elsif ($f =~ /^fifth|5th$/) { $f1 = '+5' }
758 0         0 elsif ($f =~ /^last$/) { $f1 = '-1' }
759 0         0 else {die}
760 0 0       0 push @first, $f1 unless grep {$f1 eq $_} @first;
  0         0  
761             }
762 0         0 my @days; $rrule.=';BYDAY=';
  0         0  
763 0         0 my $startime = $self->{'StartTime'}; my ($st,$et);
  0         0  
764 0         0 foreach my $d (split(/,/, $days)) {
765 0         0 my $d1 = &weekday_to_WK($d);
766 0 0       0 push @days, $d1 unless grep {$d1 eq $_} @days;
  0         0  
767 0         0 for my $f (@first) {
768 0 0       0 $rrule.=',' unless $rrule =~ /=$/;
769 0         0 $rrule.="$f$d1";
770 0         0 my $t = $self->find_next_time("$d $stime", $starttime);
771 0         0 for (my $i=0;$i<=500;++$i,$t+=7*24*60*60) {
772 0 0 0     0 if (is_week_in_month($f,$t) and
      0        
773             ($t<$st or $st==0)) {
774 0         0 $st = $t;
775 0         0 $et = $self->find_next_time("$d $etime", $st);
776             }
777             }
778             }
779             }
780 0         0 my %vevent = ();
781 0         0 $vevent{'RRULE'} = $rrule;
782 0         0 $vevent{'DTSTART'} = $st;
783 0         0 $vevent{'DTEND'} = $et;
784 0         0 $vevent{'SUMMARY'} = $description;
785 0         0 push @{ $self->{'VEvents'} }, \%vevent;
  0         0  
786 0         0 return;
787             } # end of pattern 1:
788             # thanks to Mike Vasiljevs:
789             # 25 may 2006, adding matching for iso8601 dates
790             #
791             elsif ($timeslot =~ /^(\d\d\d\d-\d\d-\d\d)T(\d\d:\d\d:\d\d)-
792             (\d\d\d\d-\d\d-\d\d)T(\d\d:\d\d:\d\d)$/x) {
793 0         0 my ($hstart, $mstart, $sstart) = split(":", $2);
794 0         0 my ($hend, $mend, $send) = split(":", $4);
795 0         0 $starttime = parse_time("$1 $hstart:$mstart");
796 0         0 $endtime = parse_time("$1 $hend:$mend");
797             ##correct is to use second date in endtime, but it may lead to time leaks!?
798             #$endtime = parse_time("$3 $hend$mend");
799             }
800             elsif ($timeslot =~ /^($REweekday3(?:,$REweekday3)*)$/) {
801 0         0 my ($days) = ($1);
802              
803 0         0 my $rrule = 'FREQ=WEEKLY';
804 0 0       0 if ($description =~ /\s*:biweekly\b\s*/) {
805 0         0 $description = "$` $'";
806 0         0 $rrule .= ':INTERVAL=2';
807             }
808 0 0       0 if ($description =~ /\s*:until\s+/) {
809 0         0 my $p1 = $`; my $p2 = $';
  0         0  
810 0         0 my ($t, $p2n) = parse_time($p2, 1);
811 0         0 $description = "$p1 $p2n";
812 0         0 $rrule .= ";UNTIL=".$self->find_next_time("23:59", $t);
813             }
814 0         0 my $starttime = $self->{'StartTime'};
815 0 0       0 if ($description =~ /:start\s+/) {
816 0         0 my $d1 = $`; my $d2 = $';
  0         0  
817 0         0 ($starttime, $d2) = parse_time($d2, 1);
818 0         0 $description = "$d1$d2";
819             }
820            
821 0         0 foreach my $d (split(/,/, $days)) {
822 0         0 my %vevent = ();
823 0         0 $vevent{'DTSTART'} = $self->find_next_time("$d 00:00", $starttime);
824             # not DTEND signals DayEntry
825 0         0 $vevent{'RRULE'} = $rrule;
826 0         0 $vevent{'SUMMARY'} = $description;
827 0         0 push @{ $self->{'VEvents'} }, \%vevent;
  0         0  
828             }
829 0         0 return;
830             }
831             elsif ($timeslot =~ /^(\d\d\d\d-\d\d-\d\d)((?:\ $REweekday3)?)
832             \ (\d\d?)((?::\d\d)?)-(\d\d?)((?::\d\d)?)(?:am)?$/x) {
833 0 0       0 my $minstart = $4; $minstart = ":00" unless $minstart ne '';
  0         0  
834 0 0       0 my $minend = $6; $minend = ":00" unless $minend ne '';
  0         0  
835 0         0 $starttime = parse_time("$1 $3$minstart");
836 0         0 $endtime = parse_time("$1 $5$minend");
837 0         0 my $w3 = $2; $w3 =~ s/^\s+//;
  0         0  
838 0 0 0     0 die "wrong weekday:($timeslot)" if $w3 ne '' &&
      0        
839             (strftime("%a",localtime($starttime)) ne $w3 ||
840             strftime("%a",localtime($endtime)) ne $w3);
841             }
842             #2003-09-08 Mon 1-2pm
843             elsif ($timeslot =~ /^(\d\d\d\d-\d\d-\d\d)((?: $REweekday3)?) (\d\d?)((?::\d\d)?)-(\d\d?)((?::\d\d)?)pm$/) {
844 0 0       0 my $minstart = $4; $minstart = ":00" unless $minstart ne '';
  0         0  
845 0 0       0 my $minend = $6; $minend = ":00" unless $minend ne '';
  0         0  
846 0         0 $starttime = parse_time("$1 $3$minstart");
847 0         0 $endtime = parse_time("$1 $5$minend");
848              
849 0 0       0 if ($starttime < $endtime) { $starttime += 12*60*60 };
  0         0  
850 0         0 $endtime += 12*60*60;
851              
852 0         0 my $w3 = $2; $w3 =~ s/^\s+//;
  0         0  
853 0 0 0     0 die "wrong weekday:($timeslot)" if $w3 ne '' &&
      0        
854             (strftime("%a",localtime($starttime)) ne $w3 ||
855             strftime("%a",localtime($endtime)) ne $w3);
856             }
857 0         0 else { die "cannot parse timeslot:($timeslot)" }
858              
859 0 0       0 die "start>end: $timeslot" if $starttime > $endtime;
860              
861 0         0 push @{ $self->{'Entries1'}} , { starttime => $starttime,
  0         0  
862             endtime => $endtime,
863             description => $description };
864              
865             }
866             else {
867 0         0 my $col = shift;
868 0         0 my $start = shift;
869 0         0 my $end = shift;
870 0         0 my $text = shift;
871 0         0 push @{ $self->{'Entries'} }, { col => $col,
  0         0  
872             start => $start,
873             end => $end,
874             text => $text };
875             }
876              
877             } # end of add_entry
878              
879             =item find_next_time(time_spec[,start_time])
880              
881             Finds next time starting from start_time according to time_spec
882             specification and returns it. If the start_time is not given, the
883             variable StartTime is used.
884              
885             Examples:
886              
887             $t = $schedule->find_next_time("23:59", $t);
888              
889             =cut
890             sub find_next_time {
891 20     20 1 30 my $self = shift;
892 20         28 my $timedesc = shift;
893              
894 20 50       43 my $starttime = ( $#_ == -1 ? $self->{'StartTime'} : shift @_ );
895              
896 20         31 my $pattern_wday = '*';
897 20         26 my $pattern_hour = '*';
898 20         30 my $pattern_min = '*';
899 20         26 my $pattern_sec = 0;
900              
901 20 50       173 if ($timedesc =~ /^($REweekday3) (\d\d?(?::\d\d)?)((?:[ap]m)?)$/) {
    0          
902 20         47 my $apm = $3;
903 20         42 $pattern_wday = weekday_to_digits($1);
904 20         36 $pattern_hour = $2;
905 20         29 $pattern_min = 0;
906 20 100       51 if ($pattern_hour =~ /:/) { $pattern_min=$'; $pattern_hour=$` }
  13         23  
  13         20  
907 20         30 $pattern_sec = 0;
908              
909 20 50       45 if ($apm eq 'pm') {
    50          
910 0 0       0 die unless $pattern_hour <= 12;
911 0 0       0 if ($pattern_hour < 12) { $pattern_hour += 12 }
  0         0  
912             }
913             elsif ($apm eq 'am') {
914 0 0       0 die unless $pattern_hour <= 12;
915 0 0       0 if ($pattern_hour == 12) { $pattern_hour = 0 }
  0         0  
916             }
917             } elsif ($timedesc =~ /^(\d?\d):(\d?\d)$/) {
918 0         0 $pattern_hour = $1; $pattern_min=$2;
  0         0  
919 0         0 } else { die "cannot parse:($timedesc)" }
920              
921             # find seconds
922 20 50       39 if ($pattern_sec ne '*') {
923 20         396 while ((localtime($starttime))[0] != $pattern_sec)
924 0         0 { $starttime ++ }
925             }
926              
927             # find minutes
928 20 50       64 if ($pattern_min ne '*') {
929 20         265 while ((localtime($starttime))[1] != $pattern_min)
930 390         5549 { $starttime += 60 }
931             }
932              
933             # find hour
934 20 50       58 if ($pattern_hour ne '*') {
935 20         257 while ((localtime($starttime))[2] != $pattern_hour)
936 288         3828 { $starttime += 3600 }
937             }
938              
939             # find weekday
940 20 50       59 if ($pattern_wday ne '*') {
941 20         260 while ((localtime($starttime))[6] != $pattern_wday)
942 46         610 { $starttime += 3600*24 }
943             }
944              
945 20         114 return $starttime;
946             }
947              
948             sub add_time_label {
949 20     20 0 29 my $self = shift;
950 20         29 my $t = shift;
951 20         28 my @r = ();
952 20   100     29 while (@{$self->{'RowLabels'}} and $t gt $self->{'RowLabels'}[0])
  126         370  
953 106         131 { push @r, shift(@{$self->{'RowLabels'}}) }
  106         174  
954 20 100 100     29 push @r, $t unless @{$self->{'RowLabels'}} and $t eq $self->{'RowLabels'}[0];
  20         65  
955 20         28 push @r, @{$self->{'RowLabels'}};
  20         46  
956 20         46 $self->{'RowLabels'} = \@r;
957             }
958              
959             sub todo_list {
960 0     0 0 0 my $self = shift;
961 0         0 my $r = "TO DO list: ";
962 0 0       0 if (! @{ $self->{'ToDo'} } ) { $r .= "" }
  0         0  
  0         0  
963             else {
964             $r .= "
    \n".
965 0         0 join('', map { "
  • $_->{'desc'}\n" }
    • 966 0         0 @{ $self->{'ToDo'} }).
      0         0  
    967             "\n";
    968             }
    969 0         0 return $r;
    970             }
    971              
    972             =item generate_table()
    973              
    974             Returns a weekly table in HTML. Starts with NextTableTime (or
    975             StartTime if NextTableTime does not exist), and updates NextTableTime
    976             so that consecutive call produces the table for the following week.
    977              
    978             The table column headers can be can be changed by setting the field
    979             $obj->{ColLabel} to a format as used by the standard function
    980             strftime. The default format is: ColLabel => "%AEE%Y-%m-%d", which
    981             looks something like:
    982              
    983             Monday
    984             2008-09-01
    985              
    986             The format "%A" would produce just the weekday name.
    987              
    988             Use $obj->{ShowDays} = 'workdays'; to display only work-days; i.e.,
    989             Monday to Friday.
    990              
    991             The table rows include time labeles which are start times and end
    992             times of the events that happend to fall in the table time range, with
    993             additional labels from the variable C<$obj-E{DefaultRowLabels}>.
    994             The default value of the variable DefaulRowLabels is defined as:
    995              
    996             $self->{DefaultRowLabels} = [qw( 08:00 12:00 17:00 )];
    997              
    998             =cut
    999             sub generate_table {
    1000 1     1 1 7 my $self = shift;
    1001 1         2 my (@prepareEntries, @dayEntries);
    1002              
    1003             $self->{'NextTableTime'} = $self->{'StartTime'}
    1004 1 50       5 if ! exists($self->{'NextTableTime'});
    1005 1         2 my $mondaytime = $self->{'NextTableTime'};
    1006              
    1007 1         3 my @showdays = 0..6; # ShowDays: all, workdays
    1008 1 50       3 if ($self->{ShowDays} eq 'workdays') { @showdays = 0..4 }
      0         0  
    1009              
    1010 1         3 my @col_label;
    1011             {
    1012 1         2 my $p = $self->{'ColLabel'};
      1         2  
    1013             @col_label = map {
    1014 1         3 strftime($p, localtime($mondaytime + $_*86400))
      7         246  
    1015             } @showdays;
    1016             }
    1017              
    1018 1         3 foreach my $ve ( @{ $self->{'VEvents'} } ) {
      1         3  
    1019 10 50 33     69 if (exists($ve->{'RRULE'}) &&
        0 0        
    1020             $ve->{'RRULE'} =~ /\bFREQ=WEEKLY\b/) {
    1021 10         15 my $d = 0;
    1022 10         17 my $interval = 1;
    1023 10 50       23 if ($ve->{'RRULE'} =~ /\bINTERVAL=(\d+)/) { $interval = $1 }
      0         0  
    1024 10         13 my $until = undef;
    1025 10 50       20 if ($ve->{'RRULE'} =~ /\bUNTIL=(\d+)/) { $until = $1 }
      0         0  
    1026              
    1027 10         23 while ($d + $ve->{'DTSTART'} < $mondaytime + 86400*scalar(@showdays)) {
    1028 10 50 33     22 if (defined($until) && $d+$ve->{'DTSTART'} > $until) { last }
      0         0  
    1029              
    1030 10 50       20 if ($d+$ve->{'DTSTART'} >= $mondaytime) {
    1031 10 50       17 if (exists($ve->{'DTEND'})) {
    1032             push @prepareEntries,
    1033             { starttime => $d+$ve->{'DTSTART'},
    1034             endtime => $d+$ve->{'DTEND'},
    1035 10         52 description => $ve->{'SUMMARY'} };
    1036             } else {
    1037             push @dayEntries,
    1038             { date => $d+$ve->{'DTSTART'},
    1039 0         0 description => $ve->{'SUMMARY'} };
    1040             }
    1041             }
    1042 10         161 my @a = localtime($d+$ve->{'DTSTART'});
    1043 10         25 $d += 86400*7*$interval;
    1044 10         14 my @b;
    1045 10 50       21 if (exists($ve->{'DTEND'})) {
    1046 10         133 @b = localtime($d+$ve->{'DTEND'});
    1047             }
    1048 0         0 else { @b = localtime($d+$ve->{'DTSTART'} + 60) }
    1049 10         52 $d += ($a[8]-$b[8])*3600; # daylight saving
    1050             }
    1051             }
    1052             # example: RRULE:FREQ=MONTHLY;BYDAY=+3TU
    1053             elsif (exists($ve->{'RRULE'}) &&
    1054             $ve->{'RRULE'} =~ /\bFREQ=MONTHLY;BYDAY=([^;]+)\b/) {
    1055 0         0 my $byday = $1;
    1056 0         0 my $interval = 1;
    1057 0 0       0 if ($ve->{'RRULE'} =~ /\bINTERVAL=(\d+)/) { $interval = $1 }
      0         0  
    1058 0         0 my $until = undef;
    1059 0 0       0 if ($ve->{'RRULE'} =~ /\bUNTIL=(\d+)/) { $until = $1 }
      0         0  
    1060 0         0 my @byday = split(/,/,$byday);
    1061 0         0 my @fwd = (); my %wds;
      0         0  
    1062 0         0 for my $bd (@byday) {
    1063 0 0       0 $bd =~ /^([+-][1-5])(\w\w)$/ or die;
    1064 0         0 my $f = $1, my $wd = $2; push @fwd, $f, $wd;
      0         0  
    1065 0         0 $wds{$wd} = 1;
    1066             }
    1067              
    1068 0         0 my $eventstarti = $ve->{'DTSTART'};
    1069 0 0       0 my $daysincrement = (scalar(keys %wds)==1? 7 : 1);
    1070 0 0       0 unless (defined($ve->{_cache_next}))
    1071 0         0 { $ve->{_cache_next} = { } }
    1072 0         0 while ($eventstarti < $mondaytime + 86400*scalar(@showdays)) {
    1073 0 0 0     0 last if defined($until) && $eventstarti > $until;
    1074 0 0       0 goto L1 if $eventstarti < $mondaytime;
    1075 0 0       0 if ($eventstarti >= $mondaytime) {
    1076 0 0       0 if (exists($ve->{'DTEND'})) {
    1077             push @prepareEntries,
    1078             { starttime => $eventstarti,
    1079             endtime => $eventstarti - $ve->{'DTSTART'}
    1080             + $ve->{'DTEND'},
    1081 0         0 description => $ve->{'SUMMARY'} };
    1082             } else {
    1083             push @dayEntries,
    1084             { date => $eventstarti,
    1085 0         0 description => $ve->{'SUMMARY'} };
    1086             }
    1087             }
    1088            
    1089             L1:
    1090 0 0       0 if (defined($ve->{_cache_next}{$eventstarti}))
    1091 0         0 { $eventstarti = $ve->{_cache_next}{$eventstarti} }
    1092             else {
    1093 0         0 my $t1 = $eventstarti;
    1094 0         0 L2:
    1095             my $t2 = days_increment_DSaware($t1,$daysincrement);
    1096 0 0       0 last unless $t2 < $mondaytime + 86400*scalar(@showdays);
    1097 0 0 0     0 last if defined($until) && $t2 > $until;
    1098 0 0       0 if ($interval>1) { die "TODO" }
      0         0  
    1099 0         0 my $flag = '';
    1100 0         0 for(my $i=0; $i<=$#fwd; $i+=2) {
    1101 0         0 my $f = $fwd[$i]; my $wd = $fwd[$i+1];
      0         0  
    1102 0 0       0 next unless weekday_to_digits($wd)==
    1103             (localtime($t2))[6];
    1104 0 0       0 next unless is_week_in_month($f, $t2);
    1105 0         0 $flag = 1; last;
      0         0  
    1106             }
    1107 0         0 $t1 = $t2;
    1108 0 0       0 goto L2 unless $flag;
    1109 0         0 $eventstarti = $ve->{_cache_next}{$eventstarti} = $t1;
    1110             }
    1111             }
    1112             } # $ve->{'RRULE'} =~ /\bFREQ=MONTHLY;BYDAY=([^;]+)\b/
    1113             } # foreach my $ve ( @{ $self->{'VEvents'} } ) {
    1114              
    1115 1         2 push @prepareEntries, @{ $self->{'Entries1'} };
      1         3  
    1116              
    1117 1         2 foreach my $entry ( @{ $self->{'Entries'} } ) {
      1         3  
    1118 0         0 $self->add_time_label( $entry->{'start'} );
    1119 0         0 $self->add_time_label( $entry->{'end'} );
    1120             }
    1121              
    1122 1         2 foreach my $entry ( @prepareEntries ) {
    1123 10         17 my $starttime = $entry->{'starttime'};
    1124 10         14 my $endtime = $entry->{'endtime'};
    1125              
    1126 10         30 my $col = floor(($starttime - $mondaytime) / 86400);
    1127 10 50 33     37 next if $col < 0 || $col >= scalar(@showdays);
    1128 10         407 my $startlabel = strftime("%H:%M", localtime($starttime));
    1129 10         360 my $endlabel = strftime("%H:%M", localtime($endtime));
    1130              
    1131 10         56 $self->add_time_label($startlabel);
    1132 10         20 $self->add_time_label($endlabel);
    1133             }
    1134              
    1135 1         3 my %eprep;
    1136 1         2 $self->{'overlap'} = [ ];
    1137              
    1138 1         2 foreach my $entry ( @{ $self->{'Entries'} } ) {
      1         3  
    1139 0         0 my $col = $entry->{'col'};
    1140 0         0 my $start = $entry->{'start'};
    1141 0         0 my $end = $entry->{'end'};
    1142 0         0 my $text = $entry->{'text'};
    1143              
    1144 0         0 $self->_table_add(\%eprep,$col, $start, $text, $end);
    1145             }
    1146              
    1147 1         2 foreach my $entry ( @prepareEntries ) {
    1148 10         20 my $starttime = $entry->{'starttime'};
    1149 10         11 my $endtime = $entry->{'endtime'};
    1150 10         18 my $description = $entry->{'description'};
    1151              
    1152 10         28 my $col = floor(($starttime - $mondaytime) / 86400);
    1153 10 50 33     46 next if $col < 0 || $col >= scalar(@showdays);
    1154 10         360 my $startlabel = strftime("%H:%M", localtime($starttime));
    1155 10         315 my $endlabel = strftime("%H:%M", localtime($endtime));
    1156              
    1157 10         42 $self->_table_add(\%eprep,$col, $startlabel, $description, $endlabel);
    1158             }
    1159              
    1160 1         3 my $r = "\n". \n". \n"; \n"; '; "; \n"; \n"; \n" } \n"; \n";
    1161             "
    1162             "\ 
    1163 1         1 my @op = @{ $self->{overlap} };
      1         12  
    1164 1         5 foreach my $di (0 .. $#col_label) {
    1165 7 100       15 $op[$di] = 0 unless defined($op[$di]);
    1166 7 100       15 if ($op[$di] > 0) { $r.= "" } else { $r.="" }
      1         15  
      6         8  
    1167 7         15 $r .= $col_label[$di]."\n";
    1168             }
    1169 1         2 $r .= "
    1170              
    1171             # check if there are any DayEntries
    1172             push @dayEntries, grep { $_->{'date'} - $mondaytime >=0 &&
    1173 0 0       0 $_->{'date'} - $mondaytime <= scalar(@showdays)*86400 }
    1174 1         2 @{ $self->{'DayEntries'} };
      1         3  
    1175 1 50       3 if ( @dayEntries ) {
    1176 0         0 $r .= '
     
    1177 0         0 foreach my $i (0 .. $#col_label) {
    1178            
    1179 0         0 my $r1;
    1180 0         0 foreach my $de (grep { $_->{'date'} - $mondaytime == $i*86400 }
      0         0  
    1181             @dayEntries )
    1182 0         0 { $r1 .= $de->{'description'}."
    \n" }
    1183 0 0       0 $r1 = ' ' unless $r1;
    1184 0 0       0 $r .= ($op[$i]==0 ? "" : "") . "$r1
    1185             }
    1186 0         0 $r .= "
    1187             }
    1188              
    1189 1         2 my $num_of_timelabels = @{$self->{'RowLabels'}};
      1         2  
    1190 1         3 foreach my $ti (0 .. $num_of_timelabels - 1) {
    1191              
    1192 12         21 my $t = $self->{'RowLabels'}[$ti];
    1193 12         20 $r.= "
    $t
    1194 12         22 foreach my $di (0 .. $#col_label) {
    1195 84         142 foreach my $oi (0 .. $op[$di]) {
    1196 120 100       205 next if $oi == 1;
    1197 108         195 my @ind = (\%eprep, $di, $t);
    1198 108 100       196 @ind = (\%eprep, $di, $t, $oi) if ($oi > 0);
    1199 108 100       234 if (! $self->_table_get(@ind)) { $r .= "\ 
      89 100       206  
    1200 9         18 elsif ($self->_table_get(@ind) eq 'continue') { $r.= "\n" }
    1201             else {
    1202 10         11 my $counter = 1;
    1203 10         14 my $j=$ti+1;
    1204 10         24 my @ind1 = (\%eprep, $di, $self->{'RowLabels'}[$j]);
    1205 10 100       20 @ind1 = (\%eprep, $di, $self->{'RowLabels'}[$j], $oi) if $oi > 0;
    1206            
    1207 10 100       17 if ($oi == 0) {
    1208 8   66     34 while ($j <= $num_of_timelabels-1 &&
    1209             $self->_table_get(\%eprep, $di,
    1210             $self->{'RowLabels'}[$j]) eq
    1211             'continue')
    1212 5         8 { ++ $counter; ++$j }
      5         14  
    1213             } else {
    1214 2   66     13 while ($j <= $num_of_timelabels-1 &&
    1215             $self->_table_get(\%eprep, $di, $self->{'RowLabels'}[$j], $oi) eq 'continue')
    1216 4         8 { ++ $counter; ++$j }
      4         8  
    1217             }
    1218 10 100       28 $r.= "
    1219             ($counter > 1 ? " rowspan=$counter" : '').
    1220             ">".$self->_table_get(@ind)."
    1221             }
    1222             }
    1223             }
    1224 12         20 $r.= "
    1225             }
    1226              
    1227 1         11 $r.="
    \n";
    1228              
    1229             $self->{'NextTableTime'} = # fix for daylight saving
    1230 1         3 &find_week_start( $self->{'NextTableTime'} + 86400 * 7 + 7200 );
    1231 1         3 $self->{'RowLabels'} = [ @{ $self->{'DefaultRowLabels'} } ];
      1         4  
    1232 1         64 return $r;
    1233             }
    1234              
    1235             =back
    1236              
    1237             =head1 FUNCTIONS
    1238              
    1239             =cut
    1240              
    1241             sub is_week_in_month {
    1242 0     0 0 0 my $f = shift; # +1, +2, +3, +4, +5, or -1
    1243 0         0 my $t = shift; # time in epoch sec
    1244 0         0 my $d = (localtime($t))[3];
    1245 0         0 my $m = (localtime($t))[4]; #0=Jan
    1246 0         0 my ($lb,$ub);
    1247 0 0 0     0 die if $f>5 or $f<-5;
    1248 0 0       0 if ($f>0) { $lb = 7*$f-6; $ub = 7*$f; }
      0 0       0  
      0         0  
    1249             elsif ($f<0) {
    1250 0         0 my $t1=$t;
    1251 0         0 for(;;) { # find last day in the month
    1252 0         0 $t1+=24*60*60;
    1253 0 0       0 last if (localtime($t1))[4] != $m;
    1254             }
    1255 0         0 $t1-=24*60*60;
    1256 0         0 $ub = (localtime($t1))[3] + ($f+1)*7;
    1257 0         0 $lb = $ub - 6;
    1258             }
    1259 0         0 else { return 1 }
    1260 0 0 0     0 return 1 if $d>=$lb and $d<=$ub;
    1261 0         0 return 0;
    1262             }
    1263              
    1264             =pod
    1265              
    1266             =head2 weekday_to_digits
    1267              
    1268             For example, changes all words "SUNDAY", "Sunday", "SUN", or "Sun" to "00", etc.
    1269              
    1270             =cut
    1271              
    1272             sub weekday_to_digits {
    1273 20     20 1 38 local $_ = shift;
    1274 20         49 s/\b(?:SUN?(?:DAY)?|Sun(?:day)?)\b/00/g;
    1275 20         37 s/\b(?:MON?(?:DAY)?|Mon(?:day)?)\b/01/xg;
    1276 20         38 s/\b(?:TUE?(?:SDAY)?|Tue(?:sday)?)\b/02/xg;
    1277 20         37 s/\b(?:WED?(?:NESDAY)?|Wed(?:nesday)?)\b/03/xg;
    1278 20         42 s/\b(?:THU?(?:RSDAY)?|Thu(?:rsday)?)\b/04/xg;
    1279 20         41 s/\b(?:FRI?(?:DAY)?|Fri(?:day)?)\b/05/xg;
    1280 20         29 s/\b(?:SAT?(?:URDAY)?|Sat(?:urday)?)\b/06/xg;
    1281 20         46 return $_;
    1282             }
    1283              
    1284             # weekday to two uppercase letters
    1285             sub weekday_to_WK {
    1286 0     0 0 0 local $_ = shift;
    1287 0         0 s/\b(?:SUN(?:DAY)?|Sun(?:day)?)\b /SU/xg;
    1288 0         0 s/\b(?:MON(?:DAY)?|Mon(?:day)?)\b /MO/xg;
    1289 0         0 s/\b(?:TUE(?:SDAY)?|Tue(?:sday)?)\b /TU/xg;
    1290 0         0 s/\b(?:WED(?:NESDAY)?|Wed(?:nesday)?)\b/WE/xg;
    1291 0         0 s/\b(?:THU(?:RSDAY)?|Thu(?:rsday)?)\b /TH/xg;
    1292 0         0 s/\b(?:FRI(?:DAY)?|Fri(?:day)?)\b /FR/xg;
    1293 0         0 s/\b(?:SAT(?:URDAY)?|Sat(?:urday)?)\b /SA/xg;
    1294 0         0 return $_;
    1295             }
    1296              
    1297             sub month_to_digits {
    1298 0     0 0 0 local $_ = shift;
    1299 0         0 s/\b(?:JAN(?:UARY)?|Jan(?:uary)?)\b/00/g;
    1300 0         0 s/\b(?:FEB(?:RUARY)?|Feb(?:ruary)?)\b/01/xg;
    1301 0         0 s/\b(?:MAR(?:CH)?|Mar(?:ch)?)\b/02/xg;
    1302 0         0 s/\b(?:APR(?:IL)?|Apr(?:il)?)\b/03/xg;
    1303 0         0 s/\b(?:MAY(?:)?|May(?:)?)\b/04/xg;
    1304 0         0 s/\b(?:JUN(?:E)?|Jun(?:e)?)\b/05/xg;
    1305 0         0 s/\b(?:JUL(?:Y)?|Jul(?:y)?)\b/06/xg;
    1306 0         0 s/\b(?:AUG(?:UST)?|Aug(?:ust)?)\b/07/xg;
    1307 0         0 s/\b(?:SEP(?:TEMBER)?|Sep(?:tember)?)\b/08/xg;
    1308 0         0 s/\b(?:OCT(?:OBER)?|Oct(?:ober)?)\b/09/xg;
    1309 0         0 s/\b(?:NOV(?:EMBER)?|Nov(?:ember)?)\b/10/xg;
    1310 0         0 s/\b(?:DEC(?:EMBER)?|Dec(?:ember)?)\b/11/xg;
    1311 0         0 return $_;
    1312             }
    1313              
    1314             # increment time for certain number of days, daylight saving aware
    1315             sub days_increment_DSaware {
    1316 0     0 0 0 my $t = shift; my $i = shift;
      0         0  
    1317 0         0 my $t1 = $t + 86400*$i;
    1318 0         0 my $t2 = $t; my $t3 = $t1;
      0         0  
    1319 0         0 my @a = localtime($t2);
    1320 0 0 0     0 if ($a[2]==0 && $a[1]==0) # problem with 0h and 23h
        0          
    1321 0         0 { $t2 += 60; $t3 += 60; @a = localtime($t2); }
      0         0  
      0         0  
    1322 0         0 elsif ($a[2]==23) { $t2 -= 60; $t3 -= 60; @a = localtime($t2); }
      0         0  
      0         0  
    1323              
    1324 0         0 my @b = localtime($t3);
    1325 0         0 $t1 += ($a[8]-$b[8])*3600; # daylight saving
    1326 0         0 return $t1;
    1327             }
    1328              
    1329             sub _table_add {
    1330 10     10   20 my $self = shift;
    1331 10         11 my $epr = shift;
    1332 10         15 my $col = shift;
    1333 10         14 my $row = shift;
    1334 10         15 my $des = shift;
    1335 10         15 my $end = shift;
    1336              
    1337 10         13 my @rows = @{$self->{'RowLabels'}};
      10         40  
    1338 10   66     42 while (@rows && $rows[0] ne $row) { shift @rows }
      53         142  
    1339 10 50       20 die unless @rows;
    1340 10 50 33     34 if (!$end || $row eq $end) { splice(@rows,1) }
      0         0  
    1341             else {
    1342 10         15 my @t = (shift @rows);
    1343 10         27 while ($rows[0] ne $end) {
    1344 9 50       17 die unless @rows;
    1345 9         22 push @t, ( shift @rows );
    1346             }
    1347 10         24 @rows = @t;
    1348             }
    1349              
    1350 10         17 my $overlap = 0;
    1351             {
    1352 10         12 my @trows = @rows;
      10         18  
    1353 10         17 while (@trows) {
    1354 25         34 my $r = shift @trows;
    1355 25         35 my $oldoverlap = $overlap;
    1356 25 100 100     77 if ($overlap==0 && defined $epr->{$col, $r}) {
    1357             #$epr->{$col, $r} .= " -CONFLICT- " . $des;
    1358 2         3 $overlap = 2;
    1359             }
    1360 25   100     71 while ($overlap > 0 && defined($epr->{$col,$r,$overlap}))
    1361 1         21 { ++ $overlap }
    1362 25 100       56 if ($overlap > $oldoverlap) { push @trows, @rows }
      2         6  
    1363             }
    1364             }
    1365 10 100       24 $self->{overlap}[$col] = 0 unless defined($self->{overlap}[$col]);
    1366 10 100       18 $self->{overlap}[$col] = $overlap if $overlap > $self->{overlap}[$col];
    1367              
    1368 10         27 $row = shift @rows;
    1369 10 100       19 if ($overlap == 0) {
    1370 8         22 $epr->{$col, $row} = $des;
    1371 8         20 foreach my $r (@rows)
    1372 5         37 { $epr->{$col, $r} = 'continue' }
    1373             } else {
    1374 2         7 $epr->{$col, $row, $overlap} = $des;
    1375 2         4 foreach my $r (@rows)
    1376 4         11 { $epr->{$col, $r, $overlap } = 'continue';
    1377             #$epr->{$col, $r} .= " -CONFLICT- continue";
    1378             }
    1379             }
    1380             }
    1381              
    1382             sub _table_get {
    1383 156     156   201 my $self = shift;
    1384 156         212 my $epr = shift;
    1385 156         185 my $col = shift;
    1386 156         205 my $row = shift;
    1387 156   100     325 my $overlap = shift // 0;
    1388 156 100       333 my $ret = $overlap > 0 ? $epr->{$col, $row, $overlap} : $epr->{$col, $row};
    1389 156 100       406 return defined($ret) ? $ret : '';
    1390             }
    1391              
    1392             =pod
    1393              
    1394             =cut
    1395              
    1396             sub _getfile($) {
    1397 0     0     my $f = shift;
    1398 0           local *F;
    1399 0 0         open(F, "<$f") or die "getfile:cannot open $f:$!";
    1400 0           my @r = ;
    1401 0           close(F);
    1402 0 0         return wantarray ? @r : join ('', @r);
    1403             }
    1404              
    1405             1;
    1406             __END__