line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Gantry::Plugins::Calendar; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
77112
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
50
|
|
4
|
1
|
|
|
1
|
|
651
|
use Gantry::Utils::HTML qw( :all ); |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
269
|
|
5
|
1
|
|
|
1
|
|
512
|
use Gantry::Utils::Validate; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
34
|
|
6
|
1
|
|
|
|
|
69
|
use Date::Calc qw( Add_Delta_YMD |
7
|
|
|
|
|
|
|
Day_of_Week |
8
|
|
|
|
|
|
|
Day_of_Week_Abbreviation |
9
|
|
|
|
|
|
|
Day_of_Week_to_Text |
10
|
|
|
|
|
|
|
Days_in_Month |
11
|
|
|
|
|
|
|
Month_to_Text |
12
|
1
|
|
|
1
|
|
5
|
check_date ); |
|
1
|
|
|
|
|
1
|
|
13
|
|
|
|
|
|
|
|
14
|
1
|
|
|
1
|
|
4
|
use Exporter; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
2019
|
|
15
|
|
|
|
|
|
|
our @ISA = qw( Exporter ); |
16
|
|
|
|
|
|
|
our @EXPORT = qw( |
17
|
|
|
|
|
|
|
do_calendar_month |
18
|
|
|
|
|
|
|
calendar_month_js |
19
|
|
|
|
|
|
|
); |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
############################################################ |
22
|
|
|
|
|
|
|
# Functions # |
23
|
|
|
|
|
|
|
############################################################ |
24
|
|
|
|
|
|
|
#------------------------------------------------- |
25
|
|
|
|
|
|
|
# $site->do_calendar_month( $r, @p ) |
26
|
|
|
|
|
|
|
#------------------------------------------------- |
27
|
|
|
|
|
|
|
sub do_calendar_month { |
28
|
0
|
|
|
0
|
1
|
|
my ( $site, $name, $year, $month ) = @_; |
29
|
|
|
|
|
|
|
|
30
|
0
|
|
|
|
|
|
my $chk = Gantry::Utils::Validate->new(); |
31
|
|
|
|
|
|
|
|
32
|
0
|
|
|
|
|
|
$site->template_disable( 1 ); |
33
|
|
|
|
|
|
|
|
34
|
0
|
0
|
|
|
|
|
$name = '' if ( ! $chk->is_text( $name ) ); |
35
|
0
|
0
|
|
|
|
|
$year = ( 1900 + ( localtime() )[5] ) if ( ! $chk->is_number( $year ) ); |
36
|
0
|
0
|
|
|
|
|
$month = ( 1 + ( localtime() )[4] ) if ( ! $chk->is_number( $month ) ); |
37
|
|
|
|
|
|
|
|
38
|
0
|
|
|
|
|
|
my @output = ( |
39
|
|
|
|
|
|
|
'', |
40
|
|
|
|
|
|
|
'', |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
_calendar_month( |
50
|
|
|
|
|
|
|
$site->r, |
51
|
|
|
|
|
|
|
( $site->location . "/calendar_month/$name" ), |
52
|
|
|
|
|
|
|
$month, |
53
|
|
|
|
|
|
|
$year, |
54
|
|
|
|
|
|
|
1, |
55
|
|
|
|
|
|
|
\&_calendar_day |
56
|
|
|
|
|
|
|
), |
57
|
|
|
|
|
|
|
'', |
58
|
|
|
|
|
|
|
); |
59
|
|
|
|
|
|
|
|
60
|
0
|
|
|
|
|
|
return( join "\n", @output ); |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
} # END $site->do_calendar |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
#------------------------------------------------- |
65
|
|
|
|
|
|
|
# _calendar_day( $year, $month, $day ) |
66
|
|
|
|
|
|
|
#------------------------------------------------- |
67
|
|
|
|
|
|
|
sub _calendar_day { |
68
|
0
|
|
|
0
|
|
|
my ( $year, $month, $day ) = @_; |
69
|
|
|
|
|
|
|
|
70
|
0
|
|
|
|
|
|
return( ht_a( 'javascript://', "$day", |
71
|
|
|
|
|
|
|
"onClick=\"SendDate('$month-$day-$year')\"" ) ); |
72
|
|
|
|
|
|
|
} # END calendar_day |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
#------------------------------------------------- |
75
|
|
|
|
|
|
|
# $site->calendar_month_js( $form_id ) |
76
|
|
|
|
|
|
|
#------------------------------------------------- |
77
|
|
|
|
|
|
|
sub calendar_month_js { |
78
|
0
|
|
|
0
|
1
|
|
my( $site, $form_id ) = @_; |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
# prepend document. to form_id id is not specified |
81
|
0
|
0
|
|
|
|
|
if ( $form_id !~ /^document\./i ) { |
82
|
0
|
|
|
|
|
|
$form_id = 'document.' . $form_id; |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
|
85
|
0
|
|
|
|
|
|
my $popup_url = $site->location . "/calendar_month/"; |
86
|
|
|
|
|
|
|
|
87
|
0
|
|
|
|
|
|
return( qq! |
88
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
! ); |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
} # end: calendar_month_js |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
#------------------------------------------------- |
108
|
|
|
|
|
|
|
# _calendar_month( $r, etc... ) |
109
|
|
|
|
|
|
|
#------------------------------------------------- |
110
|
|
|
|
|
|
|
sub _calendar_month { |
111
|
0
|
|
|
0
|
|
|
my ( $r, $root, $month, $year, $select, $function, @params ) = @_; |
112
|
|
|
|
|
|
|
|
113
|
0
|
|
|
|
|
|
my $chk = Gantry::Utils::Validate->new(); |
114
|
|
|
|
|
|
|
|
115
|
0
|
0
|
0
|
|
|
|
if ( ( ! $chk->is_integer( $month ) ) |
|
|
|
0
|
|
|
|
|
116
|
|
|
|
|
|
|
|| ( $month > 13 ) || ( $month < 1 ) ) { |
117
|
0
|
|
|
|
|
|
return( 'Malformed month.' ); |
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
|
120
|
0
|
0
|
0
|
|
|
|
if ( ( ! $chk->is_integer( $year ) ) || ( length( $year ) != 4) ) { |
121
|
0
|
|
|
|
|
|
return( 'Malformed year.' ); |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
# Fix up some variables. |
125
|
0
|
|
|
|
|
|
my $month_max = Days_in_Month( $year, $month ); |
126
|
0
|
|
|
|
|
|
my $offset = Day_of_Week( $year, $month, 1 ); |
127
|
0
|
0
|
|
|
|
|
$offset = ( $offset == 7 ) ? 0 : $offset; |
128
|
0
|
|
|
|
|
|
$root =~ s/\/$//; |
129
|
|
|
|
|
|
|
|
130
|
0
|
|
|
|
|
|
my @lines = ht_table( { 'cols' => '7' } ); |
131
|
|
|
|
|
|
|
|
132
|
0
|
0
|
0
|
|
|
|
if ( defined $select && $select ) { |
133
|
|
|
|
|
|
|
|
134
|
0
|
|
|
|
|
|
my ( $syear, $smonth ) = Add_Delta_YMD( $year, $month, 1, 0, -6, 0); |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
# Build the month options. |
137
|
0
|
|
|
|
|
|
my @items; |
138
|
0
|
|
|
|
|
|
for my $option ( -6..6 ) { |
139
|
0
|
|
|
|
|
|
push( @items, "$syear/$smonth", Month_to_Text($smonth)." $syear" ); |
140
|
|
|
|
|
|
|
|
141
|
0
|
|
|
|
|
|
( $syear, $smonth ) = Add_Delta_YMD( $syear, $smonth, 1, 0, 1, 0); |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
# Push on the month select box. |
145
|
0
|
0
|
|
|
|
|
push( @lines, |
|
|
0
|
|
|
|
|
|
146
|
|
|
|
|
|
|
ht_form_js( $root ), |
147
|
|
|
|
|
|
|
ht_tr(), |
148
|
|
|
|
|
|
|
ht_td( { class => 'head', align => 'center' }, |
149
|
|
|
|
|
|
|
ht_a( ( ( ( $month - 1 ) < 1 ) ? |
150
|
|
|
|
|
|
|
"$root/". ( $year - 1 ). "/12" : |
151
|
|
|
|
|
|
|
"$root/$year/" . ($month - 1) ), |
152
|
|
|
|
|
|
|
'<<' ) ), |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
ht_td( { class => 'head', align => 'center', colspan => '5' }, |
155
|
|
|
|
|
|
|
ht_select( 'month', 1, "$year/$month", '', |
156
|
|
|
|
|
|
|
qq!onChange="window.location = '$root/' !. |
157
|
|
|
|
|
|
|
q!+ month.options[month.selectedIndex].!. |
158
|
|
|
|
|
|
|
q!value;"!, @items ) ), |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
ht_td( { class => 'head', align => 'center' }, |
162
|
|
|
|
|
|
|
ht_a( ( ( ( $month + 1 ) > 12 ) ? |
163
|
|
|
|
|
|
|
"$root/". ( $year + 1 ) . "/01" : |
164
|
|
|
|
|
|
|
"$root/$year/" . ($month + 1) ), |
165
|
|
|
|
|
|
|
'>>' ) ), |
166
|
|
|
|
|
|
|
ht_utr(), |
167
|
|
|
|
|
|
|
ht_uform() ); |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
else { |
170
|
0
|
|
|
|
|
|
push( @lines, ht_tr(), |
171
|
|
|
|
|
|
|
ht_td( { class => 'head', |
172
|
|
|
|
|
|
|
align => 'center', |
173
|
|
|
|
|
|
|
colspan => '7' }, |
174
|
|
|
|
|
|
|
Month_to_Text( $month ) , " $year" ), |
175
|
|
|
|
|
|
|
ht_utr() ); |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
|
178
|
0
|
|
|
|
|
|
push( @lines, ht_tr(), |
179
|
|
|
|
|
|
|
ht_td( { class => 'date', align => 'center' }, |
180
|
|
|
|
|
|
|
Day_of_Week_Abbreviation( 7 ) ) ); |
181
|
|
|
|
|
|
|
|
182
|
0
|
|
|
|
|
|
for ( my $i = 1; $i < 7; $i++ ) { |
183
|
0
|
|
|
|
|
|
push( @lines, ht_td( { class => 'date', align => 'center' }, |
184
|
|
|
|
|
|
|
Day_of_Week_Abbreviation( $i ) ) ); |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
|
187
|
0
|
|
|
|
|
|
push( @lines, ht_utr() ); |
188
|
|
|
|
|
|
|
|
189
|
0
|
0
|
|
|
|
|
my $extra = ( ( ( $month_max % 7 ) + $offset ) > 7 ) ? 1 : 0 ; |
190
|
0
|
|
|
|
|
|
my $rows = int( $month_max / 7 ) + $extra + 1; |
191
|
|
|
|
|
|
|
|
192
|
0
|
|
|
|
|
|
for ( my $i = 0; $i < $rows; $i++ ) { |
193
|
0
|
|
|
|
|
|
push( @lines, ht_tr() ); |
194
|
|
|
|
|
|
|
|
195
|
0
|
|
|
|
|
|
for ( my $j = 1; $j < 8; $j++ ) { |
196
|
0
|
|
|
|
|
|
my $k = $j + ( $i * 7 ) + ( $offset * -1 ); |
197
|
|
|
|
|
|
|
|
198
|
0
|
0
|
0
|
|
|
|
if ( ( $k > 0 ) && ( $k < ( $month_max + 1 ) ) ) { |
199
|
0
|
|
|
|
|
|
push( @lines, ht_td( { class => 'day', align => 'center' }, |
200
|
|
|
|
|
|
|
&$function( $year, $month, $k, @params )) ); |
201
|
|
|
|
|
|
|
} |
202
|
|
|
|
|
|
|
else { |
203
|
0
|
|
|
|
|
|
push( @lines, ht_td( { class => 'day' }, ' ' ) ); |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
} |
206
|
0
|
|
|
|
|
|
push( @lines, ht_utr() ); |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
|
209
|
0
|
|
|
|
|
|
return( @lines, ht_utable() ); |
210
|
|
|
|
|
|
|
} # END _calendar_month |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
#------------------------------------------------- |
213
|
|
|
|
|
|
|
# _cal_week( $r, etc... ) |
214
|
|
|
|
|
|
|
#------------------------------------------------- |
215
|
|
|
|
|
|
|
# Draws one full week. $function is what you want |
216
|
|
|
|
|
|
|
# it to do for each day in the week. |
217
|
|
|
|
|
|
|
#------------------------------------------------- |
218
|
|
|
|
|
|
|
sub _calendar_week { |
219
|
0
|
|
|
0
|
|
|
my ( $r, $root, $day, $month, $year, $function, @params ) = @_; |
220
|
|
|
|
|
|
|
|
221
|
0
|
|
|
|
|
|
my $chk = Gantry::Utils::Validate->new(); |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
# Validate our input. |
224
|
0
|
0
|
|
|
|
|
return( 'Malformed day.' ) if ( ! $chk->is_number( $day ) ); |
225
|
0
|
0
|
|
|
|
|
return( 'Malformed month' ) if ( ! $chk->is_number( $month ) ); |
226
|
0
|
0
|
|
|
|
|
return( 'Malformed year' ) if ( ! $chk->is_number( $year ) ); |
227
|
0
|
0
|
|
|
|
|
return( 'Bad Date' ) if ( ! check_date( $year, $month, $day ) ); |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
# Figure some numbers out. |
230
|
0
|
|
|
|
|
|
my( $syear, $smonth, $sday ) = Add_Delta_YMD( $year, $month, $day, 0,0,-3); |
231
|
0
|
|
|
|
|
|
my( $eyear, $emonth, $eday ) = Add_Delta_YMD( $year, $month, $day, 0,0,3); |
232
|
0
|
|
|
|
|
|
my( $lyear, $lmonth, $lday ) = Add_Delta_YMD( $year, $month, $day, 0,0,-6); |
233
|
0
|
|
|
|
|
|
my( $gyear, $gmonth, $gday ) = Add_Delta_YMD( $year, $month, $day, 0,0,6); |
234
|
0
|
|
|
|
|
|
$root =~ s/\/$//; |
235
|
|
|
|
|
|
|
|
236
|
0
|
|
|
|
|
|
my @lines=( ht_table( {} ), |
237
|
|
|
|
|
|
|
ht_tr(), |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
ht_td( { class => 'head', align => 'center' }, |
240
|
|
|
|
|
|
|
ht_a( "$root/$lyear/$lmonth/$lday", '<<' ) ), |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
ht_td( { class => 'head', align => 'center', colspan => '5' }, |
243
|
|
|
|
|
|
|
qq!$sday!, |
244
|
|
|
|
|
|
|
Month_to_Text( $smonth ), |
245
|
|
|
|
|
|
|
qq! $syear -- $eday !, |
246
|
|
|
|
|
|
|
Month_to_Text( $emonth ), qq! $eyear! ), |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
ht_td( { class => 'head', align => 'center' }, |
249
|
|
|
|
|
|
|
ht_a( "$root/$gyear/$gmonth/$gday", '>>' ) ), |
250
|
|
|
|
|
|
|
ht_utr(), |
251
|
|
|
|
|
|
|
ht_tr() ); |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
# Blammo, week headers. |
254
|
0
|
|
|
|
|
|
for ( -3..3 ) { |
255
|
0
|
|
|
|
|
|
my $wdt = Day_of_Week_to_Text( Day_of_Week( $syear, $smonth, $sday ) ); |
256
|
|
|
|
|
|
|
|
257
|
0
|
|
|
|
|
|
push( @lines, ht_td( { class => 'head', align => 'center' }, |
258
|
|
|
|
|
|
|
qq!$wdt !, |
259
|
|
|
|
|
|
|
qq!( $syear/$smonth/$sday )! ) ); |
260
|
|
|
|
|
|
|
|
261
|
0
|
|
|
|
|
|
( $syear, $smonth, $sday ) = |
262
|
|
|
|
|
|
|
Add_Delta_YMD( $syear, $smonth, $sday, 0, 0, 1); |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
|
265
|
0
|
|
|
|
|
|
push( @lines, ht_utr(), ht_tr() ); |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
# Put on the actual week days now. |
268
|
0
|
|
|
|
|
|
( $syear, $smonth, $sday ) = Add_Delta_YMD( $year, $month, $day, 0, 0, -3); |
269
|
|
|
|
|
|
|
|
270
|
0
|
|
|
|
|
|
for ( -3..3 ) { |
271
|
0
|
|
|
|
|
|
push( @lines, ht_td( { class => 'day' }, |
272
|
|
|
|
|
|
|
&$function( $syear, $smonth, $sday, @params ) ) ); |
273
|
|
|
|
|
|
|
|
274
|
0
|
|
|
|
|
|
( $syear, $smonth, $sday ) = |
275
|
|
|
|
|
|
|
Add_Delta_YMD( $syear, $smonth, $sday, 0, 0, 1); |
276
|
|
|
|
|
|
|
} |
277
|
|
|
|
|
|
|
|
278
|
0
|
|
|
|
|
|
return( @lines, ht_utr(), ht_utable() ); |
279
|
|
|
|
|
|
|
} # END _calendar_week |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
#------------------------------------------------- |
282
|
|
|
|
|
|
|
# _calendar_year( $r, etc... ) |
283
|
|
|
|
|
|
|
#------------------------------------------------- |
284
|
|
|
|
|
|
|
# Draws one full year. Function is what you want |
285
|
|
|
|
|
|
|
# it to do for every day in the year. |
286
|
|
|
|
|
|
|
#------------------------------------------------- |
287
|
|
|
|
|
|
|
sub _calendar_year { |
288
|
0
|
|
|
0
|
|
|
my ( $r, $root, $year, $function, @params ) = @_; |
289
|
|
|
|
|
|
|
|
290
|
0
|
|
|
|
|
|
my $chk = Gantry::Utils::Validate->new(); |
291
|
|
|
|
|
|
|
|
292
|
0
|
0
|
0
|
|
|
|
if ( ( ! $chk->is_number( $year ) ) || ( length( $year ) != 4 ) ) { |
293
|
0
|
|
|
|
|
|
return ( 'Malformed Year.' ); |
294
|
|
|
|
|
|
|
} |
295
|
|
|
|
|
|
|
|
296
|
0
|
|
|
|
|
|
$root =~ s/\/$//; |
297
|
|
|
|
|
|
|
|
298
|
0
|
|
|
|
|
|
my @lines = ( ht_table( { 'cols' => '3' } ), |
299
|
|
|
|
|
|
|
ht_tr(), |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
ht_td( { align => 'left' }, |
302
|
|
|
|
|
|
|
ht_a( "$root/". ( $year - 1 ), '<<' ) ), |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
ht_td( { align => 'center' }, |
305
|
|
|
|
|
|
|
qq!$year! ), |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
ht_td( { align => 'right' }, |
308
|
|
|
|
|
|
|
ht_a( "$root/". ( $year + 1 ), '>>' ) ), |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
ht_utr(), |
311
|
|
|
|
|
|
|
ht_tr() ); |
312
|
|
|
|
|
|
|
|
313
|
0
|
|
|
|
|
|
for ( my $i = 0; $i < 12; $i++ ) { |
314
|
0
|
0
|
|
|
|
|
push( @lines, ht_utr(), ht_tr() ) if ( ( $i % 3 ) == 0 ); |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
# Put each month on. |
317
|
0
|
|
|
|
|
|
push( @lines, ht_td( { class => 'base', valign => 'top' }, |
318
|
|
|
|
|
|
|
_calendat_month( $r, $root, $i+1, $year, 0, |
319
|
|
|
|
|
|
|
$function, @params ) ) ); |
320
|
|
|
|
|
|
|
} |
321
|
|
|
|
|
|
|
|
322
|
0
|
|
|
|
|
|
return( @lines, |
323
|
|
|
|
|
|
|
ht_utr(), |
324
|
|
|
|
|
|
|
ht_tr(), |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
ht_td( { align => 'left' }, |
327
|
|
|
|
|
|
|
ht_a( "$root/". ( $year - 1 ), '<<' ) ), |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
ht_td( { align => 'center' }, |
330
|
|
|
|
|
|
|
qq!$year! ), |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
ht_td( { align => 'right' }, |
333
|
|
|
|
|
|
|
ht_a( "$root/". ( $year + 1 ), '>>' ) ), |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
ht_utr(), |
336
|
|
|
|
|
|
|
ht_utable() ); |
337
|
|
|
|
|
|
|
} # END _calendar_year |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
# EOF |
340
|
|
|
|
|
|
|
1; |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
__END__ |