File Coverage

blib/lib/HTML/Tag/MONTH.pm
Criterion Covered Total %
statement 50 50 100.0
branch 12 14 85.7
condition n/a
subroutine 8 8 100.0
pod 0 1 0.0
total 70 73 95.8


line stmt bran cond sub pod time code
1             package HTML::Tag::MONTH;
2              
3 1     1   6 use strict;
  1         2  
  1         37  
4 1     1   5 use warnings;
  1         1  
  1         33  
5              
6 1     1   6 use base qw(Class::AutoAccess HTML::Tag::SELECT);
  1         1  
  1         756  
7              
8 1     1   6 use Tie::IxHash;
  1         2  
  1         23  
9 1     1   5 use Class::AutoAccess;
  1         1  
  1         19  
10              
11 1     1   511 use HTML::Tag::Lang qw(@month);
  1         3  
  1         128  
12              
13             our $VERSION = '1.00';
14              
15             BEGIN {
16 1     1   689 our $class_def = {
17             element => 'MONTH',
18             tag => 'SELECT',
19             selected => '',
20             value => '',
21             maybenull => 0,
22             permitted => undef ,
23             }
24             }
25              
26             sub inner {
27 5     5 0 7 my $self = shift;
28 5         6 my $ret = '';
29 5 100       16 $ret .= qq|\n| if ($self->maybenull);
30 5         52 my @permitted;
31 5 100       18 if ($self->permitted) {
32             # to be sure that permitted are real numbers
33 2         10 push @permitted,$_+0 for (@{$self->permitted});
  2         6  
34             } else {
35 3         40 @permitted = (1..12);
36             }
37 5         162 my @cmonth = localtime();
38 5         11 my $cmonth = $cmonth[4]+1;
39 5         13 my @mlist = ($cmonth..12);
40             # intersect @permitted with mlist
41 5         6 my @msect; tie my %munion,'Tie::IxHash'; tie my %msect,'Tie::IxHash';
  5         21  
  5         70  
42 5 100       76 foreach my $e (@mlist, @permitted) { $munion{$e}++ && $msect{$e}++ }
  60         1314  
43 5         144 @msect = keys %msect;
44 5         106 foreach (@msect) {
45 13         113 $_ = sprintf('%02d',$_);
46 13 50       48 $ret .= qq|
47             qq|>$_ - $month[$_-1]\n|;
48             }
49 5 50       40 unless ($cmonth == 1) {
50 5         16 @mlist = (1..$cmonth-1);
51             # intersect @permitted with mlist
52 5         25 %munion = () ;%msect = ();
  5         1269  
53 5 100       349 foreach my $e (@mlist, @permitted) { $munion{$e}++ && $msect{$e}++ }
  80         1716  
54 5         101 @msect = keys %msect;
55 5         171 foreach (@msect) {
56 27         211 $_ = sprintf('%02d',$_);
57 27 100       71 $ret .= qq|
58             qq|>$_ - $month[$_-1]\n|;
59             }
60             }
61 5         105 return $ret;
62             }
63              
64              
65             1;
66              
67             # vim: set ts=2: