1package CVSMonitor::DateDepth; 2 3# This package implements a rough date with a specific date 4# depth. ( Year, Month, Day ) 5# 6# As input we only take ISO formatted date fragments. 7# We only go as low as days. 8 9use strict; 10use UNIVERSAL 'isa'; 11 12# Resolution hash 13use vars qw{@resolution %rhash}; 14BEGIN { 15 push @resolution, { 16 isolate => '^(\d{4})', 17 seperate => '^(\d{4})$', 18 depth => 'year', 19 }; 20 push @resolution, { 21 isolate => '^(\d{4}\/\d{2})', 22 seperate => '^(\d{4})\/(\d{2})$', 23 depth => 'month', 24 }; 25 push @resolution, { 26 isolate => '^(\d{4}\/\d{2}\/\d{2})', 27 seperate => '^(\d{4})\/(\d{2})\/(\d{2})$', 28 depth => 'day', 29 }; 30 %rhash = (); 31 $rhash{$_->{depth}} = $_ foreach @resolution; 32} 33 34 35 36 37##################################################################### 38# Constructor 39 40sub new { 41 my $class = shift; 42 my $date = shift; 43 44 my $self; 45 if ( $date =~ /$resolution[0]->{seperate}/ ) { 46 # Year 47 $self = { 48 year => $1, 49 month => undef, 50 day => undef, 51 depth => 0, 52 }; 53 54 } elsif ( $date =~ /$resolution[1]->{seperate}/ ) { 55 # Year/Month 56 $self = { 57 year => $1, 58 month => $2, 59 day => undef, 60 depth => 1, 61 }; 62 63 } elsif ( $date =~ /$resolution[2]->{seperate}/ ) { 64 # Year/Month/Day 65 $self = { 66 year => $1, 67 month => $2, 68 day => $3, 69 depth => 2, 70 }; 71 72 } else { 73 return $class->_error( "Unsupported date format" ); 74 } 75 76 bless $self, $class; 77} 78 79# What level of depth is a particular date 80sub getDepthOf { 81 my $class = shift; 82 my $string = shift; 83 return 'year' if $string =~ /$resolution[0]->{seperate}/; 84 return 'month' if $string =~ /$resolution[1]->{seperate}/; 85 return 'day' if $string =~ /$resolution[2]->{seperate}/; 86 undef; 87} 88 89# Get the isolate and seperate regexs if you want them 90sub isolate_regex { 91 my $class = shift; 92 my $depth = shift or return undef; 93 my $resolution = $rhash{$depth} or return undef; 94 qr/$resolution->{isolate}/; 95} 96sub seperate_regex { 97 my $class = shift; 98 my $depth = shift or return undef; 99 my $resolution = $rhash{$depth} or return undef; 100 qr/$resolution->{seperate}/; 101} 102 103sub year { $_[0]->{year} } 104sub month { $_[0]->{month} } 105sub day { $_[0]->{day} } 106sub depth { $_[0]->{depth} } 107 108# Get depth as a string 109sub depthString { 110 my $self = shift; 111 if ( $self->{depth} == 0 ) { 112 return 'year'; 113 } elsif ( $self->{depth} == 1 ) { 114 return 'month'; 115 } elsif ( $self->{depth} == 2 ) { 116 return 'day'; 117 } else { 118 return undef; 119 } 120} 121 122# Get the month including the year 123sub fullMonth { 124 my $self = shift; 125 return undef unless $self->{depth} >= 1; 126 "$self->{year}/$self->{month}"; 127} 128 129 130 131 132 133 134##################################################################### 135# Increment and Decrement 136 137# Increment the at our depth 138sub increment { 139 my $self = shift; 140 ($self->{depth} == 0) ? $self->incrementYear 141 : ($self->{depth} == 1) ? $self->incrementMonth 142 : $self->incrementDay; 143} 144 145# Increment the year 146sub incrementYear { $_[0]->{year}++; 1; } 147 148# Increment the month 149sub incrementMonth { 150 my $self = shift; 151 return undef unless $self->{depth} > 0; 152 153 $self->{month}++; 154 if ( $self->{month} > 12 ) { 155 $self->{year}++; 156 $self->{month} = 1; 157 } 158 159 1; 160} 161 162# Increment the day 163sub incrementDay { 164 my $self = shift; 165 return undef unless $self->{depth} > 1; 166 167 $self->{day}++; 168 if ( $self->{day} > $self->_lastDay ) { 169 $self->incrementMonth; 170 $self->{day} = 1; 171 } 172 173 1; 174} 175 176# Decrement the date 177sub decrement { 178 my $self = shift; 179 ($self->{depth} == 0) ? $self->decrementYear 180 : ($self->{depth} == 1) ? $self->decrementMonth 181 : $self->decrementDay; 182} 183 184# Decrement the year 185sub decrementYear { 186 my $self = shift; 187 $self->{year}--; 188 1; 189} 190 191# Decrement the month 192sub decrementMonth { 193 my $self = shift; 194 return undef unless $self->{depth}; 195 196 $self->{month}--; 197 if ( $self->{month} == 0 ) { 198 $self->{month} = 12; 199 $self->{year}--; 200 } 201 202 1; 203} 204 205# Decrement the day 206sub decrementDay { 207 my $self = shift; 208 return undef unless $self->{depth} > 1; 209 210 $self->{day}--; 211 if ( $self->{day} == 0 ) { 212 $self->{month}--; 213 $self->{day} = $self->_lastDay; 214 } 215 216 1; 217} 218 219 220 221 222 223##################################################################### 224# Comparison 225 226# Equality 227sub equals { 228 my $self = shift; 229 my $rhs = shift; 230 231 # Convert the RHS to an object if needed 232 unless ( isa( $rhs, 'CVSMonitor::DateDepth' ) ) { 233 $rhs = CVSMonitor::DateDepth->new( $rhs ) or die "Invalid Date comparison call"; 234 } 235 236 # Check they are of the same depth 237 unless ( $self->{depth} == $rhs->{depth} ) { 238 die "Dates are of dissimilar depth"; 239 } 240 241 # Do the equality check 242 $self->toString eq $rhs->toString; 243} 244use overload '=' => \= 245 246# Less than 247sub lessthan { 248 my $self = shift; 249 my $rhs = shift; 250 my $reversed = shift; 251 252 # Convert the RHS to an object if needed 253 unless ( isa( $rhs, 'CVSMonitor::DateDepth' ) ) { 254 $rhs = CVSMonitor::DateDepth->new( $rhs ) or die "Invalid Date comparison call"; 255 } 256 257 # Check they are of the same depth 258 unless ( $self->{depth} == $rhs->{depth} ) { 259 die "Dates are of dissimilar depth"; 260 } 261 262 # Fix reversal if required 263 ($self, $rhs) = ($rhs, $self) if $reversed; 264 265 # Do the comparison. 266 $self->toString lt $rhs->toString; 267} 268use overload '<' => \&lessthan; 269 270# Greater than 271sub greaterthan { 272 my $self = shift; 273 my $rhs = shift; 274 my $reversed = shift; 275 276 # Convert the RHS to an object if needed 277 unless ( isa( $rhs, 'CVSMonitor::DateDepth' ) ) { 278 $rhs = CVSMonitor::DateDepth->new( $rhs ) or die "Invalid Date comparison call"; 279 } 280 281 # Check they are of the same depth 282 unless ( $self->{depth} == $rhs->{depth} ) { 283 die "Dates are of dissimilar depth"; 284 } 285 286 # Fix reversal if required 287 ($self, $rhs) = ($rhs, $self) if $reversed; 288 289 # Do the comparison 290 $self->toString gt $rhs->toString; 291} 292use overload '>' => \&greaterthan; 293 294# Is a particular date "in" our date 295sub isIn { 296 my $self = shift; 297 my $other = shift; 298 my $string = $self->toString; 299 $other =~ /^$string/ ? 1 : 0; 300} 301 302 303 304 305 306##################################################################### 307# Other usefull methods 308 309sub toString { 310 my $self = shift; 311 join '/', map { length($_) < 2 ? ('0'.$_) : $_ } 312 grep { defined $_ } 313 ( $self->{year}, $self->{month}, $self->{day} ); 314} 315use overload '""' => \&toString; 316 317# Create a statistics totals generator 318sub toTotalHash { { 319 date => shift->toString, 320 commits => 0, 321 changes => 0, 322 add => 0, 323 remove => 0, 324 increase => 0, 325 decrease => 0, 326 karma => 0, 327 }; 328} 329 330# Find the highest and lowest dates in a module 331sub findDateLimits { 332 my $class = shift; 333 my $Source = shift; 334 my $depth = shift; 335 336 # Check the depth 337 my $regex = $class->isolate_regex( $depth ) or return undef; 338 339 # Get the elements to find the range of 340 my $Elements; 341 if ( isa( $Source, 'CVSMonitor::MetaData::Activity' ) ) { 342 $Elements = $Source; 343 } elsif ( can( $Source, 'getChangeSets' ) ) { 344 $Elements = $Source->getChangeSets; 345 } elsif ( can( $Source, 'getVersions' ) ) { 346 $Elements = $Source->getVersions; 347 } else { 348 return undef; 349 } 350 351 # Populate the initial minimum and maximum values 352 return undef unless scalar @$Elements; 353 my $first = $Elements->[0]; 354 return undef unless $first->date =~ $regex; 355 my ($min, $max) = ($1, $1); 356 357 # Iterate over the versions 358 foreach ( @$Elements ) { 359 return undef unless $_->date =~ $regex; 360 $min = $1 if $1 lt $min; 361 $max = $1 if $1 gt $max; 362 } 363 364 [ $min, $max ]; 365} 366 367 368 369 370 371##################################################################### 372# Utility methods 373 374# Get the current day, month or year as an object 375sub now { 376 my $class = shift; 377 my $depth = shift || 'month'; 378 379 # Get the date componants 380 my @t = gmtime time; 381 382 # Create an ISO formatted GMT date 383 $t[4] += 1; 384 $t[5] += 1900; 385 $t[3] = '0' . $t[3] if length $t[3] < 2; 386 $t[4] = '0' . $t[4] if length $t[4] < 2; 387 388 if ( $depth eq 'day' ) { 389 return $class->new( "$t[5]/$t[4]/$t[3]" ); 390 } elsif ( $depth eq 'month' ) { 391 return $class->new( "$t[5]/$t[4]" ); 392 } elsif ( $depth eq 'year' ) { 393 return $class->new( $t[5] ); 394 } else { 395 return undef; 396 } 397} 398 399# Find the last day of our current month 400use vars qw{@lastDay}; 401BEGIN { 402 @lastDay = qw{0 31 0 31 30 31 30 31 31 30 31 30 31}; 403} 404sub _lastDay { 405 my $self = shift; 406 if ( $lastDay[ $self->{month} ] ) { 407 return $lastDay[ $self->{month} ]; 408 } 409 410 # Handle the rules for February 411 return 28 unless $self->{month} % 4; 412 return 29 unless $self->{month} % 100; 413 return 28 unless $self->{month} % 400; 414 29; 415} 416 417sub _error { $CVSMonitor::MetaData::errstr = $_[1]; undef } 418 4191; 420 421__END__ 422 423# Copyright (C) 2002-2004 Adam Kennedy 424# 425# This program is free software; you can redistribute it and/or modify 426# it under the terms of the GNU General Public License as published by 427# the Free Software Foundation; either version 2 of the License, or 428# (at your option) any later version. 429# 430# This program is distributed in the hope that it will be useful, 431# but WITHOUT ANY WARRANTY; without even the implied warranty of 432# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 433# GNU General Public License for more details. 434# 435# You should have received a copy of the GNU General Public License 436# along with this program; if not, write to the Free Software 437# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 438# 439# Should you wish to utilise this software under a different licence, 440# please contact the author. 441