File Coverage

blib/lib/Date/Calendar/Year.pm
Criterion Covered Total %
statement 316 395 80.0
branch 97 154 62.9
condition 50 105 47.6
subroutine 27 36 75.0
pod 0 21 0.0
total 490 711 68.9


line stmt bran cond sub pod time code
1              
2             ###############################################################################
3             ## ##
4             ## Copyright (c) 2000 - 2009 by Steffen Beyer. ##
5             ## All rights reserved. ##
6             ## ##
7             ## This package is free software; you can redistribute it ##
8             ## and/or modify it under the same terms as Perl itself. ##
9             ## ##
10             ###############################################################################
11              
12             package Date::Calendar::Year;
13              
14 5     5   5477 BEGIN { eval { require bytes; }; }
  5         138  
15 5     5   25 use strict;
  5         10  
  5         195  
16 5     5   26 use vars qw( @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION );
  5         9  
  5         741  
17              
18             require Exporter;
19              
20             @ISA = qw(Exporter);
21              
22             @EXPORT = qw();
23              
24             @EXPORT_OK = qw( check_year empty_period );
25              
26             %EXPORT_TAGS = (all => [@EXPORT_OK]);
27              
28             $VERSION = '6.3';
29              
30 5     5   30 use Bit::Vector;
  5         13  
  5         362  
31 5     5   1029 use Carp::Clan qw(^Date::);
  5         2193  
  5         49  
32 5     5   2717 use Date::Calc::Object qw(:ALL);
  5         10  
  5         17403  
33              
34             sub check_year
35             {
36 609     609 0 1675 my($year) = shift_year(\@_);
37              
38 609 50 33     3654 if (($year < 1583) || ($year > 2299))
39             {
40 0         0 croak("given year ($year) out of range [1583..2299]");
41             }
42             }
43              
44             sub empty_period
45             {
46 0 0   0 0 0 carp("dates interval is empty") if ($^W);
47             }
48              
49             sub _invalid_
50             {
51 0     0   0 my($item,$name) = @_;
52              
53 0         0 croak("date '$item' for day '$name' is invalid");
54             }
55              
56             sub _check_init_date_
57             {
58 21778     21778   44216 my($item,$name,$year,$yy,$mm,$dd) = @_;
59              
60 21778 50 33     73883 &_invalid_($item,$name)
61             unless (($year == $yy) && (check_date($yy,$mm,$dd)));
62             }
63              
64             sub _check_callback_date_
65             {
66 743     743   1284 my($name,$year,$yy,$mm,$dd) = @_;
67              
68 743 50 33     3337 croak("callback function for day '$name' returned invalid date")
69             unless (($year == $yy) && (check_date($yy,$mm,$dd)));
70             }
71              
72             sub _set_date_
73             {
74 23668     23668   41356 my($self,$name,$yy,$mm,$dd,$flag) = @_;
75 23668         22539 my($type,$index);
76              
77 23668         25355 $type = 0;
78 23668   100     46152 $flag ||= '';
79 23668         54659 $index = $self->date2index($yy,$mm,$dd);
80 23668 100       58968 if ($flag ne '#')
81             {
82 2077 100       3354 if ($flag eq ':') { ${$self}{'HALF'}->Bit_On( $index ); $type = 1; }
  28         58  
  28         141  
  28         45  
83 2049         2583 else { ${$self}{'FULL'}->Bit_On( $index ); $type = 2; }
  2049         9408  
  2049         2956  
84             }
85 23668         121786 $self->{'TAGS'}{$index}{$name} |= $type;
86             }
87              
88             sub _set_fixed_date_
89             {
90 20582     20582   25054 my($self) = shift;
91 20582         22411 my($item) = shift;
92 20582         22190 my($name) = shift;
93 20582         23486 my($year) = shift;
94 20582   50     39989 my($lang) = shift || 0;
95              
96 20582 100       56033 if ($_[1] =~ /^[a-zA-Z]+$/)
97             {
98 847 50       2382 &_invalid_($item,$name) unless ($_[1] = Decode_Month($_[1]),$lang);
99             }
100 20582         46355 &_check_init_date_($item,$name,$year,@_);
101 20582         48054 &_set_date_($self,$name,@_);
102             }
103              
104             sub date2index
105             {
106 23732     23732 0 38273 my($self) = shift;
107 23732         63417 my($yy,$mm,$dd) = shift_date(\@_);
108 23732         38962 my($year,$index);
109              
110 23732         22734 $year = ${$self}{'YEAR'};
  23732         39784  
111 23732 50       46131 if ($yy != $year)
112             {
113 0         0 croak("given year ($yy) != object's year ($year)");
114             }
115 23732 50 33     55826 if ((check_date($yy,$mm,$dd)) &&
  23732   33     97377  
116 23732         73487 (($index = (Date_to_Days($yy,$mm,$dd) - ${$self}{'BASE'})) >= 0) &&
117             ($index < ${$self}{'DAYS'}))
118             {
119 23732         56951 return $index;
120             }
121 0         0 else { croak("invalid date ($yy,$mm,$dd)"); }
122             }
123              
124             sub index2date
125             {
126 24     24 0 38 my($self,$index) = @_;
127 24         46 my($year,$yy,$mm,$dd);
128              
129 24         29 $year = ${$self}{'YEAR'};
  24         45  
130 24         37 $yy = $year;
131 24         29 $mm = 1;
132 24         29 $dd = 1;
133 24 50 33     121 if (($index == 0) ||
  20   33     130  
      33        
      66        
134             (($index > 0) &&
135             ($index < ${$self}{'DAYS'}) &&
136             (($yy,$mm,$dd) = Add_Delta_Days($year,1,1, $index)) &&
137             ($yy == $year)))
138             {
139 24         120 return Date::Calc->new($yy,$mm,$dd);
140             }
141 0         0 else { croak("invalid index ($index)"); }
142             }
143              
144             sub new
145             {
146 191     191 0 656 my($class) = shift;
147 191         604 my($year) = shift_year(\@_);
148 191         347 my($profile) = shift;
149 191   100     713 my($lang) = shift || 0;
150 191         317 my($self);
151              
152 191         422 &check_year($year);
153 191         336 $self = { };
154 191   50     917 $class = ref($class) || $class || 'Date::Calendar::Year';
155 191         651 bless($self, $class);
156 191         607 $self->init($year,$profile,$lang,@_);
157 191         1912 return $self;
158             }
159              
160             sub init
161             {
162 191     191 0 301 my($self) = shift;
163 191         585 my($year) = shift_year(\@_);
164 191         411 my($profile) = shift;
165 191   100     804 my($lang) = shift || 0;
166 191         341 my($days,$dow,$name,$item,$flag,$temp,$n);
167 0         0 my(@weekend,@easter,@date);
168              
169 191 100       474 if (@_ > 0) { @weekend = @_; }
  3         6  
170 188         389 else { @weekend = (6,7); } # Mon=1 Tue=2 Wed=3 Thu=4 Fri=5 Sat=6 Sun=7
171 191         420 &check_year($year);
172 191 50       497 croak("given profile is not a HASH ref") unless (ref($profile) eq 'HASH');
173 191         725 $days = Days_in_Year($year,12);
174 191         328 ${$self}{'YEAR'} = $year;
  191         613  
175 191         299 ${$self}{'DAYS'} = $days;
  191         360  
176 191         542 ${$self}{'BASE'} = Date_to_Days($year,1,1);
  191         443  
177 191         322 ${$self}{'TAGS'} = { };
  191         532  
178 191         1323 ${$self}{'HALF'} = Bit::Vector->new($days);
  191         381  
179 191         697 ${$self}{'FULL'} = Bit::Vector->new($days);
  191         367  
180 191         794 ${$self}{'WORK'} = Bit::Vector->new($days);
  191         419  
181 191         682 $dow = Day_of_Week($year,1,1); # Mon=1 Tue=2 Wed=3 Thu=4 Fri=5 Sat=6 Sun=7
182 191         437 foreach $item (@weekend)
183             {
184 386   50     993 $n = $item || 0;
185 386 50 33     1675 if (($n >= 1) and ($n <= 7))
186             {
187 386         681 $n -= $dow;
188 386         973 while ($n < 0) { $n += 7; }
  8         17  
189 386         835 while ($n < $days) { ${$self}{'FULL'}->Bit_On( $n ); $n += 7; }
  20432         19039  
  20432         45853  
  20432         37317  
190             }
191             }
192 191         908 @easter = Easter_Sunday($year);
193 191 50       1272 $lang = Decode_Language($lang) unless ($lang =~ /^\d+$/);
194 191 100 66     1192 $lang = Language() unless (($lang >= 1) and ($lang <= Languages()));
195 191         249 foreach $name (keys %{$profile})
  191         6614  
196             {
197 23678         42394 @date = ();
198 23678         22066 $item = ${$profile}{$name};
  23678         49179  
199 23678 100 66     291587 if (ref($item))
    100 100        
    100 100        
    100 33        
    50          
200             {
201 753 50       1529 if (ref($item) eq 'CODE')
202             {
203 753 100       2618 if (@date = &$item($year,$name))
204             {
205 743         1697 &_check_callback_date_($name,$year,@date);
206 743         1974 &_set_date_($self,$name,@date);
207             }
208             }
209 0         0 else { croak("value for day '$name' is not a CODE ref"); }
210             }
211             elsif ($item =~ /^ ([#:]?) ([+-]\d+) $/x)
212             {
213 1196         2416 $flag = $1;
214 1196         1789 $temp = $2;
215 1196 100       2721 if ($temp == 0) { @date = @easter; }
  109         305  
216 1087         3380 else { @date = Add_Delta_Days(@easter, $temp); }
217 1196         3270 &_check_init_date_($item,$name,$year,@date);
218 1196         2789 &_set_date_($self,$name,@date,$flag);
219             }
220             elsif (($item =~ /^ ([#:]?) (\d+) \. (\d+) \.? $/x) ||
221             ($item =~ /^ ([#:]?) (\d+) \.? ([a-zA-Z]+) \.? $/x) ||
222             ($item =~ /^ ([#:]?) (\d+) - (\d+|[a-zA-Z]+) -? $/x))
223             {
224 19729         35739 $flag = $1;
225 19729         60565 @date = ($year,$3,$2);
226 19729         43529 &_set_fixed_date_($self,$item,$name,$year,$lang,@date,$flag);
227             }
228             elsif (($item =~ /^ ([#:]?) (\d+) \/ (\d+) $/x) ||
229             ($item =~ /^ ([#:]?) ([a-zA-Z]+) \/? (\d+) $/x))
230             {
231 853         1719 $flag = $1;
232 853         2744 @date = ($year,$2,$3);
233 853         1785 &_set_fixed_date_($self,$item,$name,$year,$lang,@date,$flag);
234             }
235             elsif (($item =~ /^ ([#:]?) ([1-5]) ([a-zA-Z]+) (\d+) $/x) ||
236             ($item =~ /^ ([#:]?) ([1-5]) \/ ([1-7]|[a-zA-Z]+) \/ (\d+|[a-zA-Z]+) $/x))
237             {
238 1147         2463 $flag = $1;
239 1147         1603 $n = $2;
240 1147         1972 $dow = $3;
241 1147         1889 $temp = $4;
242 1147 50       4024 if ($dow =~ /^[a-zA-Z]+$/)
243             {
244 1147 50       3394 &_invalid_($item,$name) unless ($dow = Decode_Day_of_Week($dow,$lang));
245             }
246 1147 50       3995 if ($temp =~ /^[a-zA-Z]+$/)
247             {
248 1147 50       3197 &_invalid_($item,$name) unless ($temp = Decode_Month($temp,$lang));
249             }
250             else
251             {
252 0 0 0     0 &_invalid_($item,$name) unless (($temp > 0) && ($temp < 13));
253             }
254 1147 100       3580 unless (@date = Nth_Weekday_of_Month_Year($year,$temp,$dow,$n))
255             {
256 69 50       191 if ($n == 5)
257             {
258 69 50       228 &_invalid_($item,$name)
259             unless (@date = Nth_Weekday_of_Month_Year($year,$temp,$dow,4));
260             }
261 0         0 else { &_invalid_($item,$name); }
262             }
263 1147         3718 &_set_date_($self,$name,@date,$flag);
264             }
265             else
266             {
267 0         0 croak("unrecognized date '$item' for day '$name'");
268             }
269             }
270 191         3934 ${$self}{'HALF'}->AndNot( ${$self}{'HALF'}, ${$self}{'FULL'} );
  191         395  
  191         411  
  191         1791  
271             }
272              
273             sub vec_full # full holidays
274             {
275 7     7 0 230 my($self) = @_;
276              
277 7         7 return ${$self}{'FULL'};
  7         19  
278             }
279              
280             sub vec_half # half holidays
281             {
282 1     1 0 7 my($self) = @_;
283              
284 1         1 return ${$self}{'HALF'};
  1         3  
285             }
286              
287             sub vec_work # work space
288             {
289 0     0 0 0 my($self) = @_;
290              
291 0         0 return ${$self}{'WORK'};
  0         0  
292             }
293              
294             sub val_days
295             {
296 1     1 0 11 my($self) = @_;
297              
298 1         2 return ${$self}{'DAYS'};
  1         3  
299             }
300              
301             sub val_base
302             {
303 0     0 0 0 my($self) = @_;
304              
305 0         0 return ${$self}{'BASE'};
  0         0  
306             }
307              
308             sub val_year
309             {
310 0     0 0 0 my($self) = @_;
311              
312 0         0 return ${$self}{'YEAR'};
  0         0  
313             }
314              
315             sub year # as a shortcut and to enable shift_year
316             {
317 173     173 0 275 my($self) = @_;
318              
319 173         215 return ${$self}{'YEAR'};
  173         803  
320             }
321              
322             sub labels
323             {
324 10     10 0 23 my($self) = shift;
325 10         14 my(@date);
326             my($index);
327 0         0 my(%result);
328              
329 10 50       19 if (@_)
330             {
331 10         28 @date = shift_date(\@_);
332 10         31 $index = $self->date2index(@date);
333 10 50       37 if (defined $self->{'TAGS'}{$index})
334             {
335 10 50 33     39 if (defined wantarray and wantarray)
336             {
337             return
338             (
339 10         106 Day_of_Week_to_Text(Day_of_Week(@date)),
340 10         27 keys(%{$self->{'TAGS'}{$index}})
341             );
342             }
343             else
344             {
345 0         0 return 1 + scalar( keys(%{$self->{'TAGS'}{$index}}) );
  0         0  
346             }
347             }
348             else
349             {
350 0 0 0     0 if (defined wantarray and wantarray)
351             {
352 0         0 return( Day_of_Week_to_Text(Day_of_Week(@date)) );
353             }
354             else
355             {
356 0         0 return 1;
357             }
358             }
359             }
360             else
361             {
362 0         0 local($_);
363 0         0 %result = ();
364 0         0 foreach $index (keys %{$self->{'TAGS'}})
  0         0  
365             {
366 0         0 grep( $result{$_} = 0, keys(%{$self->{'TAGS'}{$index}}) );
  0         0  
367             }
368 0 0 0     0 if (defined wantarray and wantarray)
369             {
370 0         0 return( keys %result );
371             }
372             else
373             {
374 0         0 return scalar( keys %result );
375             }
376             }
377             }
378              
379             sub search
380             {
381 5     5 0 12 my($self,$pattern) = @_;
382 5         8 my($index,$label,$upper);
383 0         0 my(@result);
384              
385 5         9 local($_);
386 5         9 @result = ();
387 5         17 $pattern = ISO_UC($pattern);
388 5         7 foreach $index (keys %{$self->{'TAGS'}})
  5         70  
389             {
390 238         873 LABEL:
391 238         251 foreach $label (keys %{$self->{'TAGS'}{$index}})
392             {
393 248         553 $upper = ISO_UC($label);
394 5 100   5   10724 if (index($upper,$pattern) >= $[)
  5         195459  
  5         10515  
  248         1284  
395             {
396 5         11 push( @result, $index );
397 5         16 last LABEL;
398             }
399             }
400             }
401 5         43 return( map( $self->index2date($_), sort {$a<=>$b} @result ) );
  0         0  
402             }
403              
404             sub tags
405             {
406 0     0 0 0 my($self) = shift;
407 0         0 my(%result) = ();
408 0         0 my($index);
409             my(@date);
410              
411 0 0 0     0 if (@_ == 1 and not ref($_[0]))
412             {
413 0         0 $index = shift;
414             }
415             else
416             {
417 0         0 @date = shift_date(\@_);
418 0         0 $index = $self->date2index(@date);
419             }
420 0 0 0     0 if (exists $self->{'TAGS'}{$index} and
421             defined $self->{'TAGS'}{$index})
422             {
423 0         0 %result = %{$self->{'TAGS'}{$index}};
  0         0  
424             }
425 0         0 return \%result;
426             }
427              
428             sub _interval_workdays_
429             {
430 41     41   59 my($self,$lower,$upper) = @_;
431 41         53 my($work,$full,$half,$days);
432              
433 41         42 $work = ${$self}{'WORK'};
  41         67  
434 41         43 $full = ${$self}{'FULL'};
  41         57  
435 41         44 $half = ${$self}{'HALF'};
  41         57  
436 41         147 $work->Empty();
437 41         105 $work->Interval_Fill($lower,$upper);
438 41         226 $work->AndNot($work,$full);
439 41         118 $days = $work->Norm();
440 41         123 $work->And($work,$half);
441 41         106 $days -= $work->Norm() * 0.5;
442 41         147 return $days;
443             }
444              
445             sub _delta_workdays_
446             {
447 20     20   31 my($self,$lower_index,$upper_index,$include_lower,$include_upper) = @_;
448 20         18 my($days);
449              
450 20         19 $days = ${$self}{'DAYS'};
  20         30  
451 20 50 33     101 if (($lower_index < 0) || ($lower_index >= $days))
452             {
453 0         0 croak("invalid lower index ($lower_index)");
454             }
455 20 50 33     76 if (($upper_index < 0) || ($upper_index >= $days))
456             {
457 0         0 croak("invalid upper index ($upper_index)");
458             }
459 20 50       39 if ($lower_index > $upper_index)
460             {
461 0         0 croak("lower index ($lower_index) > upper index ($upper_index)");
462             }
463 20 100       37 $lower_index++ unless ($include_lower);
464 20 100       37 $upper_index-- unless ($include_upper);
465 20 50 33     117 if (($upper_index < 0) ||
      33        
466             ($lower_index >= $days) ||
467             ($lower_index > $upper_index))
468             {
469 0         0 &empty_period();
470 0         0 return 0;
471             }
472 20         48 return $self->_interval_workdays_($lower_index,$upper_index);
473             }
474              
475             sub delta_workdays
476             {
477 20     20 0 27 my($self) = shift;
478 20         57 my($yy1,$mm1,$dd1) = shift_date(\@_);
479 20         61 my($yy2,$mm2,$dd2) = shift_date(\@_);
480 20         37 my($including1,$including2) = (shift,shift);
481 20         23 my($index1,$index2);
482              
483 20         45 $index1 = $self->date2index($yy1,$mm1,$dd1);
484 20         57 $index2 = $self->date2index($yy2,$mm2,$dd2);
485 20 50       46 if ($index1 > $index2)
486             {
487 0         0 return -$self->_delta_workdays_(
488             $index2,$index1,$including2,$including1);
489             }
490             else
491             {
492 20         55 return $self->_delta_workdays_(
493             $index1,$index2,$including1,$including2);
494             }
495             }
496              
497             sub _move_forward_
498             {
499 25     25   339 my($self,$index,$rest,$sign) = @_;
500 25         29 my($limit,$year,$full,$half,$loop,$min,$max);
501              
502 25 50       63 if ($sign == 0)
503             {
504 0         0 return( $self->index2date($index), $rest, 0 );
505             }
506 25         26 $limit = ${$self}{'DAYS'} - 1;
  25         64  
507 25         27 $year = ${$self}{'YEAR'};
  25         47  
508 25         26 $full = ${$self}{'FULL'};
  25         91  
509 25         22 $half = ${$self}{'HALF'};
  25         43  
510 25         32 $loop = 1;
511 25 100       47 if ($sign > 0)
512             {
513 13 50       28 $rest = -$rest if ($rest < 0);
514 13         67 while ($loop)
515             {
516 20         23 $loop = 0;
517 20 50 66     209 if ($full->bit_test($index) &&
      66        
518             (($min,$max) = $full->Interval_Scan_inc($index)) &&
519             ($min == $index))
520             {
521 13 100       23 if ($max >= $limit)
522             {
523 1         5 return( Date::Calc->new(++$year,1,1), $rest, +1 );
524             }
525 12         19 else { $index = $max + 1; }
526             }
527 19 100       70 if ($half->bit_test($index))
    100          
528             {
529 8 100       18 if ($rest >= 0.5) { $rest -= 0.5; $index++; $loop = 1; }
  6         8  
  6         7  
  6         7  
530             }
531 3         6 elsif ($rest >= 1.0) { $rest -= 1.0; $index++; $loop = 1; }
  3         6  
  3         4  
532 19 100 100     87 if ($loop && ($index > $limit))
533             {
534 2         10 return( Date::Calc->new(++$year,1,1), $rest, +1 );
535             }
536             }
537 10         31 return( $self->index2date($index), $rest, 0 );
538             }
539             else # ($sign < 0)
540             {
541 12 50       35 $rest = -$rest if ($rest > 0);
542 12         27 while ($loop)
543             {
544 24         27 $loop = 0;
545 24 50 66     191 if ($full->bit_test($index) &&
      66        
546             (($min,$max) = $full->Interval_Scan_dec($index)) &&
547             ($max == $index))
548             {
549 12 100       33 if ($min <= 0)
550             {
551 1         4 return( Date::Calc->new(--$year,12,31), $rest, -1 );
552             }
553 11         14 else { $index = $min - 1; }
554             }
555 23 100       88 if ($half->bit_test($index))
    100          
556             {
557 8 100       21 if ($rest <= -0.5) { $rest += 0.5; $index--; $loop = 1; }
  6         7  
  6         7  
  6         8  
558             }
559 8         11 elsif ($rest <= -1.0) { $rest += 1.0; $index--; $loop = 1; }
  8         10  
  8         10  
560 23 100 100     101 if ($loop && ($index < 0))
561             {
562 2         8 return( Date::Calc->new(--$year,12,31), $rest, -1 );
563             }
564             }
565 9         24 return( $self->index2date($index), $rest, 0 );
566             }
567             }
568              
569             sub add_delta_workdays
570             {
571 14     14 0 26 my($self) = shift;
572 14         46 my($yy,$mm,$dd) = shift_date(\@_);
573 14         41 my($days) = shift;
574 14         19 my($sign) = shift;
575 14         20 my($index,$full,$half,$limit,$diff,$guess);
576              
577 14         42 $index = $self->date2index($yy,$mm,$dd); # check date
578 14 50       47 if ($sign == 0)
579             {
580 0         0 return( Date::Calc->new($yy,$mm,$dd), $days, 0 );
581             }
582 14 100       29 $days = -$days if ($days < 0);
583 14 50       34 if ($days < 2) # other values possible for fine-tuning optimal speed
584             {
585 0         0 return( $self->_move_forward_($index,$days,$sign) );
586             }
587             # else sufficiently large distance
588 14         15 $full = ${$self}{'FULL'};
  14         31  
589 14         18 $half = ${$self}{'HALF'};
  14         28  
590 14 100       33 if ($sign > 0)
591             {
592             # First, check against whole rest of year:
593 8         8 $limit = ${$self}{'DAYS'} - 1;
  8         16  
594 8         40 $diff = $self->_interval_workdays_($index,$limit);
595 8 100       35 if ($days >= $diff)
596             {
597 4         7 $days -= $diff;
598 4         27 return( Date::Calc->new(++$yy,1,1), $days, +1 );
599             }
600             # else ($days < $diff)
601             # Now calculate proportional jump (approximatively):
602 4         11 $guess = $index + int($days * ($limit-$index+1) / $diff);
603 4 50       12 $guess = $limit if ($guess > $limit);
604 4 50       10 if ($index + 2 > $guess) # again, other values possible for fine-tuning
605             {
606 0         0 return( $self->_move_forward_($index,$days,+1) );
607             }
608             # else sufficiently long jump
609 4         13 $diff = $self->_interval_workdays_($index,$guess-1);
610 4         18 while ($days < $diff) # reverse gear (jumped too far)
611             {
612 0         0 $guess--;
613 0 0       0 unless ($full->bit_test($guess))
614             {
615 0 0       0 if ($half->bit_test($guess)) { $diff -= 0.5; }
  0         0  
616 0         0 else { $diff -= 1.0; }
617             }
618             }
619             # Now move in original direction:
620 4         6 $days -= $diff;
621 4         14 return( $self->_move_forward_($guess,$days,+1) );
622             }
623             else # ($sign < 0)
624             {
625             # First, check against whole rest of year:
626 6         9 $limit = 0;
627 6         14 $diff = $self->_interval_workdays_($limit,$index);
628 6 100       18 if ($days >= $diff)
629             {
630 3         5 $days -= $diff;
631 3         15 return( Date::Calc->new(--$yy,12,31), -$days, -1 );
632             }
633             # else ($days < $diff)
634             # Now calculate proportional jump (approximatively):
635 3         8 $guess = $index - int($days * ($index+1) / $diff);
636 3 50       11 $guess = $limit if ($guess < $limit);
637 3 50       12 if ($guess > $index - 2) # again, other values possible for fine-tuning
638             {
639 0         0 return( $self->_move_forward_($index,-$days,-1) );
640             }
641             # else sufficiently long jump
642 3         9 $diff = $self->_interval_workdays_($guess+1,$index);
643 3         10 while ($days < $diff) # reverse gear (jumped too far)
644             {
645 0         0 $guess++;
646 0 0       0 unless ($full->bit_test($guess))
647             {
648 0 0       0 if ($half->bit_test($guess)) { $diff -= 0.5; }
  0         0  
649 0         0 else { $diff -= 1.0; }
650             }
651             }
652             # Now move in original direction:
653 3         5 $days -= $diff;
654 3         12 return( $self->_move_forward_($guess,-$days,-1) );
655             }
656             }
657              
658             sub is_full
659             {
660 0     0 0   my($self) = shift;
661 0           my(@date) = shift_date(\@_);
662              
663 0           return $self->vec_full->bit_test( $self->date2index(@date) );
664             }
665              
666             sub is_half
667             {
668 0     0 0   my($self) = shift;
669 0           my(@date) = shift_date(\@_);
670              
671 0           return $self->vec_half->bit_test( $self->date2index(@date) );
672             }
673              
674             sub is_work
675             {
676 0     0 0   my($self) = shift;
677 0           my(@date) = shift_date(\@_);
678              
679 0           return $self->vec_work->bit_test( $self->date2index(@date) );
680             }
681              
682             1;
683              
684             __END__