View | Details | Raw Unified | Return to bug 6431
Collapse All | Expand All

(-)a/Koha/Calendar.pm (+650 lines)
Line 0 Link Here
1
package Koha::Calendar;
2
3
# Copyright Koha Physics Library UNLP <matias_veleda@hotmail.com>
4
# Parts Copyright Catalyst IT 2011
5
#
6
# This file is part of Koha.
7
#
8
# Koha is free software; you can redistribute it and/or modify it under the
9
# terms of the GNU General Public License as published by the Free Software
10
# Foundation; either version 2 of the License, or (at your option) any later
11
# version.
12
#
13
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
14
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
15
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License along with
18
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
19
# Suite 330, Boston, MA  02111-1307 USA
20
21
use strict;
22
use warnings;
23
use vars qw($VERSION @EXPORT);
24
25
use Carp;
26
use Date::Calc qw( Date_to_Days );
27
28
BEGIN {
29
    # set the version for version checking
30
    $VERSION = 3.01;
31
    require Exporter;
32
    @EXPORT = qw(
33
        &get_week_days_holidays
34
        &get_day_month_holidays
35
        &get_exception_holidays 
36
        &get_single_holidays
37
        &insert_week_day_holiday
38
        &insert_day_month_holiday
39
        &insert_single_holiday
40
        &insert_exception_holiday
41
        &ModWeekdayholiday
42
        &ModDaymonthholiday
43
        &ModSingleholiday
44
        &ModExceptionholiday
45
        &delete_holiday
46
        &isHoliday
47
        &addDate
48
        &daysBetween
49
    );
50
}
51
52
=head1 NAME
53
54
Koha::Calendar - Koha module dealing with holidays.
55
56
=head1 SYNOPSIS
57
58
    use Koha::Calendar;
59
60
=head1 DESCRIPTION
61
62
This package is used to deal with holidays. Through this package, you can set 
63
all kind of holidays for the library.
64
65
=head1 FUNCTIONS
66
67
=head2 new
68
69
  $calendar = Koha::Calender->new(branchcode => $branchcode, context => $context);
70
71
Each library branch has its own Calendar.  
72
C<$branchcode> specifies which Calendar you want.
73
74
=cut
75
76
sub new {
77
    my $classname = shift @_;
78
    my %options = @_;
79
    my $self = bless({}, $classname);
80
    foreach my $optionName (keys %options) {
81
        $self->{lc($optionName)} = $options{$optionName};
82
    }
83
    defined($self->{branchcode}) or croak "No branchcode argument to new.  Should be Koha::Calender->new(branchcode => \$branchcode)";
84
    $self->_init($self->{branchcode});
85
    return $self;
86
}
87
88
sub _init {
89
    my $self = shift @_;
90
    my $branch = shift;
91
    defined($branch) or die "No branchcode sent to _init";  # must test for defined here and above to allow ""
92
    my $dbh = $self->{context}->dbh();
93
    my $repeatable = $dbh->prepare( 'SELECT *
94
                                       FROM repeatable_holidays
95
                                      WHERE ( branchcode = ? )
96
                                        AND (ISNULL(weekday) = ?)' );
97
    $repeatable->execute($branch,0);
98
    my %week_days_holidays;
99
    while (my $row = $repeatable->fetchrow_hashref) {
100
        my $key = $row->{weekday};
101
        $week_days_holidays{$key}{title}       = $row->{title};
102
        $week_days_holidays{$key}{description} = $row->{description};
103
    }
104
    $self->{'week_days_holidays'} = \%week_days_holidays;
105
106
    $repeatable->execute($branch,1);
107
    my %day_month_holidays;
108
    while (my $row = $repeatable->fetchrow_hashref) {
109
        my $key = $row->{month} . "/" . $row->{day};
110
        $day_month_holidays{$key}{title}       = $row->{title};
111
        $day_month_holidays{$key}{description} = $row->{description};
112
        $day_month_holidays{$key}{day} = sprintf("%02d", $row->{day});
113
        $day_month_holidays{$key}{month} = sprintf("%02d", $row->{month});
114
    }
115
    $self->{'day_month_holidays'} = \%day_month_holidays;
116
117
    my $special = $dbh->prepare( 'SELECT day, month, year, title, description
118
                                    FROM special_holidays
119
                                   WHERE ( branchcode = ? )
120
                                     AND (isexception = ?)' );
121
    $special->execute($branch,1);
122
    my %exception_holidays;
123
    while (my ($day, $month, $year, $title, $description) = $special->fetchrow) {
124
        $exception_holidays{"$year/$month/$day"}{title} = $title;
125
        $exception_holidays{"$year/$month/$day"}{description} = $description;
126
        $exception_holidays{"$year/$month/$day"}{date} = 
127
		sprintf("%04d-%02d-%02d", $year, $month, $day);
128
    }
129
    $self->{'exception_holidays'} = \%exception_holidays;
130
131
    $special->execute($branch,0);
132
    my %single_holidays;
133
    while (my ($day, $month, $year, $title, $description) = $special->fetchrow) {
134
        $single_holidays{"$year/$month/$day"}{title} = $title;
135
        $single_holidays{"$year/$month/$day"}{description} = $description;
136
        $single_holidays{"$year/$month/$day"}{date} = 
137
		sprintf("%04d-%02d-%02d", $year, $month, $day);
138
    }
139
    $self->{'single_holidays'} = \%single_holidays;
140
    return $self;
141
}
142
143
=head2 get_week_days_holidays
144
145
   $week_days_holidays = $calendar->get_week_days_holidays();
146
147
Returns a hash reference to week days holidays.
148
149
=cut
150
151
sub get_week_days_holidays {
152
    my $self = shift @_;
153
    my $week_days_holidays = $self->{'week_days_holidays'};
154
    return $week_days_holidays;
155
}
156
157
=head2 get_day_month_holidays
158
159
   $day_month_holidays = $calendar->get_day_month_holidays();
160
161
Returns a hash reference to day month holidays.
162
163
=cut
164
165
sub get_day_month_holidays {
166
    my $self = shift @_;
167
    my $day_month_holidays = $self->{'day_month_holidays'};
168
    return $day_month_holidays;
169
}
170
171
=head2 get_exception_holidays
172
173
    $exception_holidays = $calendar->exception_holidays();
174
175
Returns a hash reference to exception holidays. This kind of days are those
176
which stands for a holiday, but you wanted to make an exception for this particular
177
date.
178
179
=cut
180
181
sub get_exception_holidays {
182
    my $self = shift @_;
183
    my $exception_holidays = $self->{'exception_holidays'};
184
    return $exception_holidays;
185
}
186
187
=head2 get_single_holidays
188
189
    $single_holidays = $calendar->get_single_holidays();
190
191
Returns a hash reference to single holidays. This kind of holidays are those which
192
happend just one time.
193
194
=cut
195
196
sub get_single_holidays {
197
    my $self = shift @_;
198
    my $single_holidays = $self->{'single_holidays'};
199
    return $single_holidays;
200
}
201
202
=head2 insert_week_day_holiday
203
204
    insert_week_day_holiday(weekday => $weekday,
205
                            title => $title,
206
                            description => $description);
207
208
Inserts a new week day for $self->{branchcode}.
209
210
C<$day> Is the week day to make holiday.
211
212
C<$title> Is the title to store for the holiday formed by $year/$month/$day.
213
214
C<$description> Is the description to store for the holiday formed by $year/$month/$day.
215
216
=cut
217
218
sub insert_week_day_holiday {
219
    my $self = shift @_;
220
    my %options = @_;
221
222
    my $dbh = $self->{context}->dbh();
223
    my $insertHoliday = $dbh->prepare("insert into repeatable_holidays (id,branchcode,weekday,day,month,title,description) values ( '',?,?,NULL,NULL,?,? )"); 
224
	$insertHoliday->execute( $self->{branchcode}, $options{weekday},$options{title}, $options{description});
225
    $self->{'week_days_holidays'}->{$options{weekday}}{title} = $options{title};
226
    $self->{'week_days_holidays'}->{$options{weekday}}{description} = $options{description};
227
    return $self;
228
}
229
230
=head2 insert_day_month_holiday
231
232
    insert_day_month_holiday(day => $day,
233
                             month => $month,
234
                             title => $title,
235
                             description => $description);
236
237
Inserts a new day month holiday for $self->{branchcode}.
238
239
C<$day> Is the day month to make the date to insert.
240
241
C<$month> Is month to make the date to insert.
242
243
C<$title> Is the title to store for the holiday formed by $year/$month/$day.
244
245
C<$description> Is the description to store for the holiday formed by $year/$month/$day.
246
247
=cut
248
249
sub insert_day_month_holiday {
250
    my $self = shift @_;
251
    my %options = @_;
252
253
    my $dbh = $self->{context}->dbh();
254
    my $insertHoliday = $dbh->prepare("insert into repeatable_holidays (id,branchcode,weekday,day,month,title,description) values ('', ?, NULL, ?, ?, ?,? )");
255
	$insertHoliday->execute( $self->{branchcode}, $options{day},$options{month},$options{title}, $options{description});
256
    $self->{'day_month_holidays'}->{"$options{month}/$options{day}"}{title} = $options{title};
257
    $self->{'day_month_holidays'}->{"$options{month}/$options{day}"}{description} = $options{description};
258
    return $self;
259
}
260
261
=head2 insert_single_holiday
262
263
    insert_single_holiday(day => $day,
264
                          month => $month,
265
                          year => $year,
266
                          title => $title,
267
                          description => $description);
268
269
Inserts a new single holiday for $self->{branchcode}.
270
271
C<$day> Is the day month to make the date to insert.
272
273
C<$month> Is month to make the date to insert.
274
275
C<$year> Is year to make the date to insert.
276
277
C<$title> Is the title to store for the holiday formed by $year/$month/$day.
278
279
C<$description> Is the description to store for the holiday formed by $year/$month/$day.
280
281
=cut
282
283
sub insert_single_holiday {
284
    my $self = shift @_;
285
    my %options = @_;
286
    
287
	my $dbh = $self->{context}->dbh();
288
    my $isexception = 0;
289
    my $insertHoliday = $dbh->prepare("insert into special_holidays (id,branchcode,day,month,year,isexception,title,description) values ('', ?,?,?,?,?,?,?)");
290
	$insertHoliday->execute( $self->{branchcode}, $options{day},$options{month},$options{year}, $isexception, $options{title}, $options{description});
291
    $self->{'single_holidays'}->{"$options{year}/$options{month}/$options{day}"}{title} = $options{title};
292
    $self->{'single_holidays'}->{"$options{year}/$options{month}/$options{day}"}{description} = $options{description};
293
    return $self;
294
}
295
296
=head2 insert_exception_holiday
297
298
    insert_exception_holiday(day => $day,
299
                             month => $month,
300
                             year => $year,
301
                             title => $title,
302
                             description => $description);
303
304
Inserts a new exception holiday for $self->{branchcode}.
305
306
C<$day> Is the day month to make the date to insert.
307
308
C<$month> Is month to make the date to insert.
309
310
C<$year> Is year to make the date to insert.
311
312
C<$title> Is the title to store for the holiday formed by $year/$month/$day.
313
314
C<$description> Is the description to store for the holiday formed by $year/$month/$day.
315
316
=cut
317
318
sub insert_exception_holiday {
319
    my $self = shift @_;
320
    my %options = @_;
321
322
    my $dbh = $self->{context}->dbh();
323
    my $isexception = 1;
324
    my $insertException = $dbh->prepare("insert into special_holidays (id,branchcode,day,month,year,isexception,title,description) values ('', ?,?,?,?,?,?,?)");
325
	$insertException->execute( $self->{branchcode}, $options{day},$options{month},$options{year}, $isexception, $options{title}, $options{description});
326
    $self->{'exception_holidays'}->{"$options{year}/$options{month}/$options{day}"}{title} = $options{title};
327
    $self->{'exception_holidays'}->{"$options{year}/$options{month}/$options{day}"}{description} = $options{description};
328
    return $self;
329
}
330
331
=head2 ModWeekdayholiday
332
333
    ModWeekdayholiday(weekday =>$weekday,
334
                      title => $title,
335
                      description => $description)
336
337
Modifies the title and description of a weekday for $self->{branchcode}.
338
339
C<$weekday> Is the title to update for the holiday.
340
341
C<$description> Is the description to update for the holiday.
342
343
=cut
344
345
sub ModWeekdayholiday {
346
    my $self = shift @_;
347
    my %options = @_;
348
349
    my $dbh = $self->{context}->dbh();
350
    my $updateHoliday = $dbh->prepare("UPDATE repeatable_holidays SET title = ?, description = ? WHERE branchcode = ? AND weekday = ?");
351
    $updateHoliday->execute( $options{title},$options{description},$self->{branchcode},$options{weekday}); 
352
    $self->{'week_days_holidays'}->{$options{weekday}}{title} = $options{title};
353
    $self->{'week_days_holidays'}->{$options{weekday}}{description} = $options{description};
354
    return $self;
355
}
356
357
=head2 ModDaymonthholiday
358
359
    ModDaymonthholiday(day => $day,
360
                       month => $month,
361
                       title => $title,
362
                       description => $description);
363
364
Modifies the title and description for a day/month holiday for $self->{branchcode}.
365
366
C<$day> The day of the month for the update.
367
368
C<$month> The month to be used for the update.
369
370
C<$title> The title to be updated for the holiday.
371
372
C<$description> The description to be update for the holiday.
373
374
=cut
375
376
sub ModDaymonthholiday {
377
    my $self = shift @_;
378
    my %options = @_;
379
380
    my $dbh = $self->{context}->dbh();
381
    my $updateHoliday = $dbh->prepare("UPDATE repeatable_holidays SET title = ?, description = ? WHERE month = ? AND day = ? AND branchcode = ?");
382
       $updateHoliday->execute( $options{title},$options{description},$options{month},$options{day},$self->{branchcode}); 
383
    $self->{'day_month_holidays'}->{"$options{month}/$options{day}"}{title} = $options{title};
384
    $self->{'day_month_holidays'}->{"$options{month}/$options{day}"}{description} = $options{description};
385
    return $self;
386
}
387
388
=head2 ModSingleholiday
389
390
    ModSingleholiday(day => $day,
391
                     month => $month,
392
                     year => $year,
393
                     title => $title,
394
                     description => $description);
395
396
Modifies the title and description for a single holiday for $self->{branchcode}.
397
398
C<$day> Is the day of the month to make the update.
399
400
C<$month> Is the month to make the update.
401
402
C<$year> Is the year to make the update.
403
404
C<$title> Is the title to update for the holiday formed by $year/$month/$day.
405
406
C<$description> Is the description to update for the holiday formed by $year/$month/$day.
407
408
=cut
409
410
sub ModSingleholiday {
411
    my $self = shift @_;
412
    my %options = @_;
413
414
    my $dbh = $self->{context}->dbh();
415
    my $isexception = 0;
416
    my $updateHoliday = $dbh->prepare("UPDATE special_holidays SET title = ?, description = ? WHERE day = ? AND month = ? AND year = ? AND branchcode = ? AND isexception = ?");
417
      $updateHoliday->execute($options{title},$options{description},$options{day},$options{month},$options{year},$self->{branchcode},$isexception);    
418
    $self->{'single_holidays'}->{"$options{year}/$options{month}/$options{day}"}{title} = $options{title};
419
    $self->{'single_holidays'}->{"$options{year}/$options{month}/$options{day}"}{description} = $options{description};
420
    return $self;
421
}
422
423
=head2 ModExceptionholiday
424
425
    ModExceptionholiday(day => $day,
426
                        month => $month,
427
                        year => $year,
428
                        title => $title,
429
                        description => $description);
430
431
Modifies the title and description for an exception holiday for $self->{branchcode}.
432
433
C<$day> Is the day of the month for the holiday.
434
435
C<$month> Is the month for the holiday.
436
437
C<$year> Is the year for the holiday.
438
439
C<$title> Is the title to be modified for the holiday formed by $year/$month/$day.
440
441
C<$description> Is the description to be modified for the holiday formed by $year/$month/$day.
442
443
=cut
444
445
sub ModExceptionholiday {
446
    my $self = shift @_;
447
    my %options = @_;
448
449
    my $dbh = $self->{context}->dbh();
450
    my $isexception = 1;
451
    my $updateHoliday = $dbh->prepare("UPDATE special_holidays SET title = ?, description = ? WHERE day = ? AND month = ? AND year = ? AND branchcode = ? AND isexception = ?");
452
    $updateHoliday->execute($options{title},$options{description},$options{day},$options{month},$options{year},$self->{branchcode},$isexception);    
453
    $self->{'exception_holidays'}->{"$options{year}/$options{month}/$options{day}"}{title} = $options{title};
454
    $self->{'exception_holidays'}->{"$options{year}/$options{month}/$options{day}"}{description} = $options{description};
455
    return $self;
456
}
457
458
=head2 delete_holiday
459
460
    delete_holiday(weekday => $weekday
461
                   day => $day,
462
                   month => $month,
463
                   year => $year);
464
465
Delete a holiday for $self->{branchcode}.
466
467
C<$weekday> Is the week day to delete.
468
469
C<$day> Is the day month to make the date to delete.
470
471
C<$month> Is month to make the date to delete.
472
473
C<$year> Is year to make the date to delete.
474
475
=cut
476
477
sub delete_holiday {
478
    my $self = shift @_;
479
    my %options = @_;
480
481
    # Verify what kind of holiday that day is. For example, if it is
482
    # a repeatable holiday, this should check if there are some exception
483
	# for that holiday rule. Otherwise, if it is a regular holiday, it´s 
484
    # ok just deleting it.
485
486
    my $dbh = $self->context->dbh();
487
    my $isSingleHoliday = $dbh->prepare("SELECT id FROM special_holidays WHERE (branchcode = ?) AND (day = ?) AND (month = ?) AND (year = ?)");
488
    $isSingleHoliday->execute($self->{branchcode}, $options{day}, $options{month}, $options{year});
489
    if ($isSingleHoliday->rows) {
490
        my $id = $isSingleHoliday->fetchrow;
491
        $isSingleHoliday->finish; # Close the last query
492
493
        my $deleteHoliday = $dbh->prepare("DELETE FROM special_holidays WHERE id = ?");
494
        $deleteHoliday->execute($id);
495
        delete($self->{'single_holidays'}->{"$options{year}/$options{month}/$options{day}"});
496
    } else {
497
        $isSingleHoliday->finish; # Close the last query
498
499
        my $isWeekdayHoliday = $dbh->prepare("SELECT id FROM repeatable_holidays WHERE branchcode = ? AND weekday = ?");
500
        $isWeekdayHoliday->execute($self->{branchcode}, $options{weekday});
501
        if ($isWeekdayHoliday->rows) {
502
            my $id = $isWeekdayHoliday->fetchrow;
503
            $isWeekdayHoliday->finish; # Close the last query
504
505
            my $updateExceptions = $dbh->prepare("UPDATE special_holidays SET isexception = 0 WHERE (WEEKDAY(CONCAT(special_holidays.year,'-',special_holidays.month,'-',special_holidays.day)) = ?) AND (branchcode = ?)");
506
            $updateExceptions->execute($options{weekday}, $self->{branchcode});
507
            $updateExceptions->finish; # Close the last query
508
509
            my $deleteHoliday = $dbh->prepare("DELETE FROM repeatable_holidays WHERE id = ?");
510
            $deleteHoliday->execute($id);
511
            delete($self->{'week_days_holidays'}->{$options{weekday}});
512
        } else {
513
            $isWeekdayHoliday->finish; # Close the last query
514
515
            my $isDayMonthHoliday = $dbh->prepare("SELECT id FROM repeatable_holidays WHERE (branchcode = ?) AND (day = ?) AND (month = ?)");
516
            $isDayMonthHoliday->execute($self->{branchcode}, $options{day}, $options{month});
517
            if ($isDayMonthHoliday->rows) {
518
                my $id = $isDayMonthHoliday->fetchrow;
519
                $isDayMonthHoliday->finish;
520
                my $updateExceptions = $dbh->prepare("UPDATE special_holidays SET isexception = 0 WHERE (special_holidays.branchcode = ?) AND (special_holidays.day = ?) and (special_holidays.month = ?)");
521
                $updateExceptions->execute($self->{branchcode}, $options{day}, $options{month});
522
                $updateExceptions->finish; # Close the last query
523
524
                my $deleteHoliday = $dbh->prepare("DELETE FROM repeatable_holidays WHERE (id = ?)");
525
                $deleteHoliday->execute($id);
526
                delete($self->{'day_month_holidays'}->{"$options{month}/$options{day}"});
527
            }
528
        }
529
    }
530
    return $self;
531
}
532
533
=head2 isHoliday
534
535
    $isHoliday = isHoliday($day, $month $year);
536
537
C<$day> Is the day to check whether if is a holiday or not.
538
539
C<$month> Is the month to check whether if is a holiday or not.
540
541
C<$year> Is the year to check whether if is a holiday or not.
542
543
=cut
544
545
sub isHoliday {
546
    my ($self, $day, $month, $year) = @_;
547
	# FIXME - date strings are stored in non-padded metric format. should change to iso.
548
	# FIXME - should change arguments to accept C4::Dates object
549
	$month=$month+0;
550
	$year=$year+0;
551
	$day=$day+0;
552
    my $weekday = &Date::Calc::Day_of_Week($year, $month, $day) % 7; 
553
    my $weekDays   = $self->get_week_days_holidays();
554
    my $dayMonths  = $self->get_day_month_holidays();
555
    my $exceptions = $self->get_exception_holidays();
556
    my $singles    = $self->get_single_holidays();
557
    if (defined($exceptions->{"$year/$month/$day"})) {
558
        return 0;
559
    } else {
560
        if ((exists($weekDays->{$weekday})) ||
561
            (exists($dayMonths->{"$month/$day"})) ||
562
            (exists($singles->{"$year/$month/$day"}))) {
563
		 	return 1;
564
        } else {
565
            return 0;
566
        }
567
    }
568
569
}
570
571
=head2 addDate
572
573
    my ($day, $month, $year, $hour, $minute, $seconds) = $calendar->addDate($date, $offset)
574
575
C<$date> is a Koha::Dates object representing the starting date of the interval.
576
577
C<$offset> Is the number of minutes that this function has to count from $date.
578
579
=cut
580
581
sub addDate {
582
    my ($self, $startdate, $offset) = @_;
583
    my ($date,$time) = split (" ", $startdate->output('iso'));
584
    my ($year,$month,$day) = split("-",$date);
585
    my ($hour,$min,$sec) = split(":",$time);
586
	my $daystep = 1;
587
	if ($offset < 0) { # In case $offset is negative
588
       # $offset = $offset*(-1);
589
		$daystep = -1;
590
    }
591
	my $daysMode = C4::Context->preference('useDaysMode');
592
    if ($daysMode eq 'Datedue') {
593
# Offset is minutes
594
        ($year, $month, $day, $hour, $min, $sec) = &Date::Calc::Add_Delta_DHMS($year, $month, $day, 0,0,$offset,0 );
595
	 	while ($self->isHoliday($day, $month, $year)) {
596
            ($year, $month, $day, $hour, $min, $sec) = &Date::Calc::Add_Delta_DHMS($year, $month, $day, $daystep, 0, 0, 0); # add 1 day
597
        }
598
    } elsif($daysMode eq 'Calendar') {
599
        while ($offset !=  0) {
600
            ($year, $month, $day, $hour, $min, $sec) = &Date::Calc::Add_Delta_Days($year, $month, $day, $daystep);
601
            if (!($self->isHoliday($day, $month, $year))) {
602
                $offset = $offset - $daystep;
603
			}
604
        }
605
	} else { ## ($daysMode eq 'Days') 
606
        ($year, $month, $day) = &Date::Calc::Add_Delta_Days($year, $month, $day, $offset );
607
    }
608
    return(Koha::Dates->new( sprintf("%04d-%02d-%02d",$year,$month,$day),'iso'));
609
}
610
611
=head2 daysBetween
612
613
    my $daysBetween = $calendar->daysBetween($startdate, $enddate)
614
615
C<$startdate> and C<$enddate> are C4::Dates objects that define the interval.
616
617
Returns the number of non-holiday days in the interval.
618
useDaysMode syspref has no effect here.
619
=cut
620
621
sub daysBetween ($$$) {
622
    my $self      = shift or return undef;
623
    my $startdate = shift or return undef;
624
    my $enddate   = shift or return undef;
625
	my ($yearFrom,$monthFrom,$dayFrom) = split("-",$startdate->output('iso'));
626
	my ($yearTo,  $monthTo,  $dayTo  ) = split("-",  $enddate->output('iso'));
627
	if (Date_to_Days($yearFrom,$monthFrom,$dayFrom) > Date_to_Days($yearTo,$monthTo,$dayTo)) {
628
		return 0;
629
		# we don't go backwards  ( FIXME - handle this error better )
630
	}
631
    my $count = 0;
632
    while (1) {
633
        ($yearFrom != $yearTo or $monthFrom != $monthTo or $dayFrom != $dayTo) or last; # if they all match, it's the last day
634
        unless ($self->isHoliday($dayFrom, $monthFrom, $yearFrom)) {
635
            $count++;
636
        }
637
        ($yearFrom, $monthFrom, $dayFrom) = &Date::Calc::Add_Delta_Days($yearFrom, $monthFrom, $dayFrom, 1);
638
    }
639
    return($count);
640
}
641
642
1;
643
644
__END__
645
646
=head1 AUTHOR
647
648
Koha Physics Library UNLP <matias_veleda@hotmail.com>
649
650
=cut
(-)a/Koha/Dates.pm (-1 / +367 lines)
Line 0 Link Here
0
- 
1
package Koha::Dates;
2
3
# This file is part of Koha.
4
#
5
# Koha is free software; you can redistribute it and/or modify it under the
6
# terms of the GNU General Public License as published by the Free Software
7
# Foundation; either version 2 of the License, or (at your option) any later
8
# version.
9
#
10
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
11
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13
#
14
# You should have received a copy of the GNU General Public License along with
15
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
16
# Suite 330, Boston, MA  02111-1307 USA
17
18
use strict;
19
use warnings;
20
use Carp;
21
use C4::Context;
22
# use C4::Debug;
23
use Exporter;
24
use POSIX qw(strftime);
25
use Date::Calc qw(check_date check_time);
26
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
27
use vars qw($debug $cgi_debug);
28
29
BEGIN {
30
    $VERSION   = 0.04;
31
    @ISA       = qw(Exporter);
32
    @EXPORT_OK = qw(format_date_in_iso format_date);
33
}
34
35
use vars qw($prefformat);
36
37
sub _prefformat {
38
    unless ( defined $prefformat ) {
39
        $prefformat = C4::Context->preference('dateformat'); # FIXME
40
    }
41
    return $prefformat;
42
}
43
44
our %format_map = (
45
    iso    => 'yyyy-mm-dd HH:MM:SS',
46
    metric => 'dd/mm/yyyy HH:MM:SS',
47
    us     => 'mm/dd/yyyy HH:MM:SS',
48
    sql    => 'yyyymmdd    HHMMSS',
49
    rfc822 => 'a, dd b y HH:MM:SS z ',
50
);
51
our %posix_map = (
52
    iso      => '%F %H:%M:%S',             # or %F, "Full Date"
53
    metric   => '%d/%m/%Y',
54
    us       => '%m/%d/%Y',
55
    sql      => '%Y%m%d    %H%M%S',
56
    rfc822   => '%a, %d %b %Y %H:%M:%S %z',
57
);
58
59
our %dmy_subs = (                     # strings to eval  (after using regular expression returned by regexp below)
60
                                      # make arrays for POSIX::strftime()
61
    iso    => '[(($6||0),($5||0),($4||0),$3, $2 - 1, $1 - 1900)]',
62
    metric => '[(($6||0),($5||0),($4||0),$1, $2 - 1, $3 - 1900)]',
63
    us     => '[(($6||0),($5||0),($4||0),$2, $1 - 1, $3 - 1900)]',
64
    sql    => '[(($6||0),($5||0),($4||0),$3, $2 - 1, $1 - 1900)]',
65
    rfc822 => '[($7, $6, $5, $2, $3, $4 - 1900, $8)]',
66
);
67
68
our @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
69
70
our @days = qw(Sun Mon Tue Wed Thu Fri Sat);
71
72
sub regexp ($;$) {
73
    my $self   = shift;
74
    my $delim  = qr/:?\:|\/|-/;                                                                  # "non memory" cluster: no backreference
75
    my $format = (@_) ? _recognize_format(shift) : ( $self->{'dateformat'} || _prefformat() );
76
77
    # Extra layer of checking $self->{'dateformat'}.
78
    # Why?  Because it is assumed you might want to check regexp against an *instantiated* Dates object as a
79
    # way of saying "does this string match *whatever* format that Dates object is?"
80
81
    ( $format eq 'sql' )
82
      and return qr/^(\d{4})(\d{1,2})(\d{1,2})(?:\s{4}(\d{2})(\d{2})(\d{2}))?/;
83
    ( $format eq 'iso' )
84
      and return qr/^(\d{4})$delim(\d{1,2})$delim(\d{1,2})(?:(?:\s{1}|T)(\d{2})\:?(\d{2})\:?(\d{2}))?Z?/;
85
    ( $format eq 'rfc822' )
86
      and return qr/^([a-zA-Z]{3}),\s{1}(\d{1,2})\s{1}([a-zA-Z]{3})\s{1}(\d{4})\s{1}(\d{1,2})\:(\d{1,2})\:(\d{1,2})\s{1}(([\-|\+]\d{4})|([A-Z]{3}))/;
87
    return qr/^(\d{1,2})$delim(\d{1,2})$delim(\d{4})(?:\s{1}(\d{1,2})\:?(\d{1,2})\:?(\d{1,2}))?/;    # everything else
88
}
89
90
sub dmy_map ($$) {
91
    my $self    = shift;
92
    my $val     = shift or return undef;
93
    my $dformat = $self->{'dateformat'} or return undef;
94
    my $re      = $self->regexp();
95
    my $xsub    = $dmy_subs{$dformat};
96
    $debug and print STDERR "xsub: $xsub \n";
97
    if ( $val =~ /$re/ ) {
98
        my $aref = eval $xsub;
99
        if ($dformat eq 'rfc822') {
100
            $aref = _abbr_to_numeric($aref, $dformat);
101
            pop(@{$aref}); #pop off tz offset because we are not setup to handle tz conversions just yet
102
        }
103
        _check_date_and_time($aref);
104
        push @{$aref}, (-1,-1,1); # for some reason unknown to me, setting isdst to -1 or undef causes strftime to fail to return the tz offset which is required in RFC822 format -chris_n
105
        return @{$aref};
106
    }
107
108
    # $debug and
109
    carp "Illegal Date '$val' does not match '$dformat' format: " . $self->visual();
110
    return 0;
111
}
112
113
sub _abbr_to_numeric {
114
    my $aref    = shift;
115
    my $dformat = shift;
116
    my ($month_abbr, $day_abbr) = ($aref->[4], $aref->[3]) if $dformat eq 'rfc822';
117
118
    for( my $i = 0; $i < scalar(@months); $i++ ) {
119
        if ( $months[$i] =~ /$month_abbr/ ) {
120
            $aref->[4] = $i-1;
121
            last;
122
        }
123
    };
124
125
    for( my $i = 0; $i < scalar(@days); $i++ ) {
126
        if ( $days[$i] =~ /$day_abbr/ ) {
127
            $aref->[3] = $i;
128
            last;
129
        }
130
    };
131
    return $aref;
132
}
133
134
sub _check_date_and_time {
135
    my $chron_ref = shift;
136
    my ( $year, $month, $day ) = _chron_to_ymd($chron_ref);
137
    unless ( check_date( $year, $month, $day ) ) {
138
        carp "Illegal date specified (year = $year, month = $month, day = $day)";
139
    }
140
    my ( $hour, $minute, $second ) = _chron_to_hms($chron_ref);
141
    unless ( check_time( $hour, $minute, $second ) ) {
142
        carp "Illegal time specified (hour = $hour, minute = $minute, second = $second)";
143
    }
144
}
145
146
sub _chron_to_ymd {
147
    my $chron_ref = shift;
148
    return ( $chron_ref->[5] + 1900, $chron_ref->[4] + 1, $chron_ref->[3] );
149
}
150
151
sub _chron_to_hms {
152
    my $chron_ref = shift;
153
    return ( $chron_ref->[2], $chron_ref->[1], $chron_ref->[0] );
154
}
155
156
sub new {
157
    my $this  = shift;
158
    my $class = ref($this) || $this;
159
    my $self  = {};
160
    bless $self, $class;
161
    return $self->init(@_);
162
}
163
164
sub init ($;$$) {
165
    my $self = shift;
166
    my $dformat;
167
    $self->{'dateformat'} = $dformat = ( scalar(@_) >= 2 ) ? $_[1] : _prefformat();
168
    ( $format_map{$dformat} ) or croak "Invalid date format '$dformat' from " . ( ( scalar(@_) >= 2 ) ? 'argument' : 'system preferences' );
169
    $self->{'dmy_arrayref'} = [ ( (@_) ? $self->dmy_map(shift) : localtime ) ];
170
    $debug and warn "(during init) \@\$self->{'dmy_arrayref'}: " . join( ' ', @{ $self->{'dmy_arrayref'} } ) . "\n";
171
    return $self;
172
}
173
174
sub output ($;$) {
175
    my $self = shift;
176
    my $newformat = (@_) ? _recognize_format(shift) : _prefformat();
177
    return ( eval { POSIX::strftime( $posix_map{$newformat}, @{ $self->{'dmy_arrayref'} } ) } || undef );
178
}
179
180
sub today ($;$) {    # NOTE: sets date value to today (and returns it in the requested or current format)
181
    my $class = shift;
182
    $class = ref($class) || $class;
183
    my $format = (@_) ? _recognize_format(shift) : _prefformat();
184
    return $class->new()->output($format);
185
}
186
187
sub _recognize_format($) {
188
    my $incoming = shift;
189
    ( $incoming eq 'syspref' ) and return _prefformat();
190
    ( scalar grep ( /^$incoming$/, keys %format_map ) == 1 ) or croak "The format you asked for ('$incoming') is unrecognized.";
191
    return $incoming;
192
}
193
194
sub DHTMLcalendar ($;$) {    # interface to posix_map
195
    my $class = shift;
196
    my $format = (@_) ? shift : _prefformat();
197
    return $posix_map{$format};
198
}
199
200
sub format {                 # get or set dateformat: iso, metric, us, etc.
201
    my $self = shift;
202
    (@_) or return $self->{'dateformat'};
203
    $self->{'dateformat'} = _recognize_format(shift);
204
}
205
206
sub visual {
207
    my $self = shift;
208
    if (@_) {
209
        return $format_map{ _recognize_format(shift) };
210
    }
211
    $self eq __PACKAGE__ and return $format_map{ _prefformat() };
212
    return $format_map{ eval { $self->{'dateformat'} } || _prefformat() };
213
}
214
215
# like the functions from the old C4::Date.pm
216
sub format_date {
217
    return __PACKAGE__->new( shift, 'iso' )->output( (@_) ? shift : _prefformat() );
218
}
219
220
sub format_date_in_iso {
221
    return __PACKAGE__->new( shift, _prefformat() )->output('iso');
222
}
223
224
1;
225
__END__
226
227
=head1 C4::Dates.pm - a more object-oriented replacement for Date.pm.
228
229
The core problem to address is the multiplicity of formats used by different Koha 
230
installations around the world.  We needed to move away from any hard-coded values at
231
the script level, for example in initial form values or checks for min/max date. The
232
reason is clear when you consider string '07/01/2004'.  Depending on the format, it 
233
represents July 1st (us), or January 7th (metric), or an invalid value (iso).
234
235
The formats supported by Koha are:
236
    iso - ISO 8601 (extended)
237
    us - U.S. standard
238
    metric - European standard (slight misnomer, not really decimalized metric)
239
    sql - log format, not really for human consumption
240
    rfc822 - Standard for using with RSS feeds, etc.
241
242
=head2 ->new([string_date,][date_format])
243
244
Arguments to new() are optional.  If string_date is not supplied, the present system date is
245
used.  If date_format is not supplied, the system preference from C4::Context is used. 
246
247
Examples:
248
249
        my $now   = C4::Dates->new();
250
        my $date1 = C4::Dates->new("09-21-1989","us");
251
        my $date2 = C4::Dates->new("19890921    143907","sql");
252
253
=head2 ->output([date_format])
254
255
The date value is stored independent of any specific format.  Therefore any format can be 
256
invoked when displaying it. 
257
258
        my $date = C4::Dates->new();    # say today is July 12th, 2010
259
        print $date->output("iso");     # prints "2010-07-12"
260
        print "\n";
261
        print $date->output("metric");  # prints "12-07-2010"
262
263
However, it is still necessary to know the format of any incoming date value (e.g., 
264
setting the value of an object with new()).  Like new(), output() assumes the system preference
265
date format unless otherwise instructed.
266
267
=head2 ->format([date_format])
268
269
With no argument, format returns the object's current date_format.  Otherwise it attempts to 
270
set the object format to the supplied value.
271
272
Some previously desireable functions are now unnecessary.  For example, you might want a 
273
method/function to tell you whether or not a Dates.pm object is of the 'iso' type.  But you 
274
can see by this example that such a test is trivial to accomplish, and not necessary to 
275
include in the module:
276
277
        sub is_iso {
278
            my $self = shift;
279
            return ($self->format() eq "iso");
280
        }
281
282
Note: A similar function would need to be included for each format. 
283
284
Instead a dependent script can retrieve the format of the object directly and decide what to
285
do with it from there:
286
287
        my $date = C4::Dates->new();
288
        my $format = $date->format();
289
        ($format eq "iso") or do_something($date);
290
291
Or if you just want to print a given value and format, no problem:
292
293
        my $date = C4::Dates->new("1989-09-21", "iso");
294
        print $date->output;
295
296
Alternatively:
297
298
        print C4::Dates->new("1989-09-21", "iso")->output;
299
300
Or even:
301
302
        print C4::Dates->new("21-09-1989", "metric")->output("iso");
303
304
=head2 "syspref" -- System Preference(s)
305
306
Perhaps you want to force data obtained in a known format to display according to the user's system
307
preference, without necessarily knowing what that preference is.  For this purpose, you can use the
308
psuedo-format argument "syspref".  
309
310
For example, to print an ISO date (from the database) in the <systempreference> format:
311
312
        my $date = C4::Dates->new($date_from_database,"iso");
313
        my $datestring_for_display = $date->output("syspref");
314
        print $datestring_for_display;
315
316
Or even:
317
318
        print C4::Dates->new($date_from_database,"iso")->output("syspref");
319
320
If you just want to know what the <systempreferece> is, a default Dates object can tell you:
321
322
        C4::Dates->new()->format();
323
324
=head2 ->DHMTLcalendar([date_format])
325
326
Returns the format string for DHTML Calendar Display based on date_format.  
327
If date_format is not supplied, the return is based on system preference.
328
329
        C4::Dates->DHTMLcalendar(); #  e.g., returns "%m/%d/%Y" for 'us' system preference
330
331
=head3 Error Handling
332
333
Some error handling is provided in this module, but not all.  Requesting an unknown format is a 
334
fatal error (because it is programmer error, not user error, typically).  
335
336
Scripts must still perform validation of user input.  Attempting to set an invalid value will 
337
return 0 or undefined, so a script might check as follows:
338
339
        my $date = C4::Dates->new($input) or deal_with_it("$input didn't work");
340
341
To validate before creating a new object, use the regexp method of the class:
342
343
        $input =~ C4::Dates->regexp("iso") or deal_with_it("input ($input) invalid as iso format");
344
        my $date = C4::Dates->new($input,"iso");
345
346
More verbose debugging messages are sent in the presence of non-zero $ENV{"DEBUG"}.
347
348
Notes: if the date in the db is null or empty, interpret null expiration to mean "never expires".
349
350
=head3 _prefformat()
351
352
This internal function is used to read the preferred date format
353
from the system preference table.  It reads the preference once, 
354
then caches it.
355
356
This replaces using the package variable $prefformat directly, and
357
specifically, doing a call to C4::Context->preference() during
358
module initialization.  That way, C4::Dates no longer has a
359
compile-time dependency on having a valid $dbh.
360
361
=head3 TO DO
362
363
If the date format is not in <systempreference>, we should send an error back to the user. 
364
This kind of check should be centralized somewhere.  Probably not here, though.
365
366
=cut
367

Return to bug 6431