File Coverage

blib/lib/Directory/Organize.pm
Criterion Covered Total %
statement 136 149 91.2
branch 57 78 73.0
condition 22 36 61.1
subroutine 11 11 100.0
pod 6 6 100.0
total 232 280 82.8


line stmt bran cond sub pod time code
1             # vim: set ts=4 sw=4 tw=78 et si:
2              
3             package Directory::Organize;
4              
5 1     1   4654 use strict;
  1         2  
  1         25  
6 1     1   4 use warnings;
  1         2  
  1         22  
7 1     1   369 use version; our $VERSION = qv('v1.0.0');
  1         1668  
  1         5  
8              
9             sub new {
10 1     1 1 16 my $self = shift;
11 1   33     9 my $type = ref($self) || $self;
12              
13 1         4 $self = bless {}, $type;
14 1         8 $self->{basedir} = shift;
15 1         6 $self->set_today();
16              
17 1         5 return $self;
18             } # new();
19              
20             sub get_descriptions {
21 6     6 1 33 my $self = shift;
22              
23 6 50       20 if (!exists $self->{descriptions}) {
24 6         20 $self->_read_descriptions();
25             }
26 6 50       22 return wantarray ? @{$self->{descriptions}} : $self->{descriptions};
  6         35  
27             } # get_descriptions()
28              
29             sub new_dir {
30 3     3 1 20 my ($self,$descr) = @_;
31             my $daydir = sprintf "%4.4d/%2.2d/%2.2d", $self->{tyear}, $self->{tmonth}
32 3         19 , $self->{tday};
33 3         11 my $dirprefix = qq($self->{basedir}/$daydir);
34 3         6 my $suffix = q();
35 3 100       50 if (-d $dirprefix) {
36 1         5 $suffix = 'a';
37 1         23 while (-d qq($dirprefix$suffix)) {
38 0         0 $suffix++;
39             }
40             }
41 3         13 my $path = qq($dirprefix$suffix/);
42 3         8 my $dir = q();
43 3         27 while ($path =~ s{^([^/]*)/}{}) {
44 12 50       52 if ($1) {
45 12         34 $dir .= $1;
46 12 50 66     513 (-d $dir) || mkdir($dir,0777) || return undef;
47 12         109 $dir .= '/';
48             }
49             else {
50 0 0       0 $dir = '/' unless ($dir);
51             }
52             }
53 3         11 my $project = qq($dirprefix$suffix/.project);
54 3 50 33     210 if ($descr and open (my $PROJ,'>',$project)) {
55 3         57 print $PROJ qq($descr\n);
56 3         102 close $PROJ;
57             }
58 3         27 return qq($dirprefix$suffix);
59             } # new_dir()
60              
61             sub set_pattern {
62 2     2 1 299 my ($self,$pattern) = @_;
63              
64             # do nothing with unchanged pattern
65 2 50 66     13 if ($pattern
      33        
66             && defined $self->{pattern}
67             && $self->{pattern} eq $pattern) {
68 0         0 return;
69             }
70 2 50 66     14 if (!$pattern and !defined $self->{pattern}) {
71 0         0 return;
72             }
73 2         6 delete $self->{descriptions};
74 2 100       8 if (!$pattern) {
75 1         5 delete $self->{pattern};
76             }
77             else {
78 1         5 $self->{pattern} = $pattern;
79             }
80             } # set_pattern()
81              
82             sub set_time_constraint {
83 4     4 1 1010 my ($self,$op,$year,$month,$day) = @_;
84 4 50 33     32 if (defined $year and $op =~ /^[=<>]$/) {
85 4         14 $self->{tc}->{op} = $op;
86 4         17 $self->{tc}->{year} = sprintf "%04d",$year;
87 4 50       17 $self->{tc}->{month} = sprintf "%02d",$month if (defined $month);
88 4 100       16 $self->{tc}->{day} = sprintf "%02d",$day if (defined $day);
89 4         17 delete $self->{descriptions};
90             }
91             else {
92 0 0       0 if ($self->{tc}) {
93 0         0 delete $self->{descriptions};
94 0         0 delete $self->{tc};
95             }
96             }
97             } # set_time_constraint()
98              
99             sub set_today {
100 7     7 1 1018 my $self = shift;
101 7         21 my ($tday,$tmonth,$tyear) = @_;
102 7 100       25 if (defined $tyear) {
103 3         10 $self->{tday} = $tday;
104 3         6 $self->{tmonth} = $tmonth;
105 3         7 $self->{tyear} = $tyear;
106 3         10 return;
107             }
108 4         88 my ($day,$month,$year) = (localtime)[3,4,5];
109 4         17 $year += 1900;
110 4         8 $month += 1;
111 4 100       16 if (defined $tmonth) {
    100          
112 1         3 $self->{tday} = $tday;
113 1         3 $self->{tmonth} = $tmonth;
114 1         4 $self->{tyear} = $year;
115             }
116             elsif (defined $tday) {
117 1         4 $self->{tday} = $tday;
118 1         3 $self->{tmonth} = $month;
119 1         3 $self->{tyear} = $year;
120             }
121             else {
122 2         8 $self->{tday} = $day;
123 2         6 $self->{tmonth} = $month;
124 2         6 $self->{tyear} = $year;
125             }
126 4         13 return;
127             } # set_today()
128              
129             sub _not_in_tc {
130 20     20   62 my ($self,$year,$month,$day) = @_;
131 20         40 my ($tc,$tc_date,$date,$result);
132              
133 20         42 $tc = $self->{tc};
134              
135 20 100       58 if (defined $day) {
    100          
136 8 100       22 if (defined $tc->{day}) {
    50          
137 7         21 $tc_date = $tc->{year} . $tc->{month} . $tc->{day};
138 7         23 $date = $year . $month . substr($day,0,2);
139             }
140             elsif (defined $tc->{month}) {
141 1         3 $tc_date = $tc->{year} . $tc->{month};
142 1         4 $date = $year . $month;
143             }
144             else {
145 0         0 $tc_date = $tc->{year};
146 0         0 $date = $year;
147             }
148             }
149             elsif (defined $month) {
150 8 100       25 if (defined $tc->{day}) {
    50          
151 6         18 $tc_date = $tc->{year} . $tc->{month};
152 6         13 $date = $year . $month;
153 6 100       20 $date++ if ('>' eq $tc->{op});
154 6 100       32 $date-- if ('<' eq $tc->{op});
155             }
156             elsif (defined $tc->{month}) {
157 2         7 $tc_date = $tc->{year} . $tc->{month};
158 2         5 $date = $year . $month;
159             }
160             else {
161 0         0 $tc_date = $tc->{year};
162 0         0 $date = $year;
163             }
164             }
165             else {
166 4 50       12 if (defined $tc->{month}) {
167 4         11 $tc_date = $tc->{year};
168 4         8 $date = $year;
169 4 100       15 $date++ if ('>' eq $tc->{op});
170 4 100       16 $date-- if ('<' eq $tc->{op});
171             }
172             else {
173 0         0 $tc_date = $tc->{year};
174 0         0 $date = $year;
175             }
176             }
177             $result = '<' eq $tc->{op} ? $date ge $tc_date
178 20 100       64 : '>' eq $tc->{op} ? $date le $tc_date
    100          
179             : $date ne $tc_date
180             ;
181 20         143 return $result;
182             } # _not_in_tc()
183              
184             sub _read_descriptions {
185 6     6   13 my $self = shift;
186 6         15 my $base = $self->{basedir};
187 6         15 $self->{descriptions} = [];
188              
189 6 50       192 if (opendir my $BASEDIR, $base) {
190              
191 6         33 my %dirs = map { ("$_" => {}) }
192 6         156 grep { m/^ # match names with
  30         122  
193             \d{4} # four digits
194             $ # exactly
195             /x }
196             readdir( $BASEDIR );
197 6         76 closedir $BASEDIR;
198              
199             YEAR:
200 6         29 for my $year (reverse sort keys %dirs) {
201 6 50 66     36 next if ($self->{tc} && $self->_not_in_tc($year));
202 6 50       184 if (opendir my $YEARDIR, qq($base/$year)) {
203 12         53 my %mdirs = map { ("$_" => {}) }
204 6         130 grep { m/^ # match names with
  24         102  
205             \d{2} # two digits
206             $ # exactly
207             /x }
208             readdir( $YEARDIR );
209 6         25 $dirs{$year} = \%mdirs;
210 6         70 closedir $YEARDIR;
211             }
212              
213             MONTH:
214 6         20 for my $month (reverse sort keys %{$dirs{$year}}) {
  6         37  
215 12 100 100     68 next if ($self->{tc} && $self->_not_in_tc($year,$month));
216 10 50       318 if (opendir my $MONTHDIR, qq($base/$year/$month)) {
217 14         73 my %ddirs = map { ("$_" => {}) }
218 10 100       219 grep { m/^ # match names that start
  34         400  
219             \d{2} # with two digits
220             /x
221             && -d qq($base/$year/$month/$_) }
222             readdir($MONTHDIR);
223 10         41 $dirs{$year}->{$month} = \%ddirs;
224 10         32 close $MONTHDIR;
225             }
226              
227             DAY:
228 10         21 for my $day (reverse sort keys %{$dirs{$year}->{$month}}) {
  10         51  
229             next if ($self->{tc}
230 14 100 100     66 && $self->_not_in_tc($year,$month,$day));
231 13         41 my $path = qq($year/$month/$day);
232 13         31 my $desc = "";
233 13 50 33     695 if (-f qq($base/$path/.project)
234             and open my $PROJECT, '<', qq($base/$path/.project)) {
235 13         194 $desc = <$PROJECT>;
236 13         130 close $PROJECT;
237 13         46 chomp $desc;
238             }
239 13 100 100     75 if ($self->{pattern} && $desc !~ /$self->{pattern}/i) {
240 2         25 next;
241             }
242 11         20 push @{$self->{descriptions}}, [ $path, $desc ];
  11         173  
243             }
244             }
245             }
246             }
247 6         28 return;
248             } # _read_descriptions();
249              
250             1;
251              
252             __END__