File Coverage

blib/lib/Number/Compare/Date.pm
Criterion Covered Total %
statement 25 25 100.0
branch 3 4 75.0
condition 2 2 100.0
subroutine 7 7 100.0
pod 1 1 100.0
total 38 39 97.4


line stmt bran cond sub pod time code
1             package Number::Compare::Date;
2 1     1   36800 use Number::Compare;
  1         483  
  1         25  
3 1     1   6 use base qw(Number::Compare);
  1         2  
  1         101  
4 1     1   745 use Date::Parse;
  1         7409  
  1         126  
5              
6 1     1   5 use strict;
  1         1  
  1         26  
7             #use warnings;
8 1     1   5 use Carp qw(croak);
  1         2  
  1         36  
9              
10 1     1   4 use vars qw($VERSION);
  1         1  
  1         181  
11             $VERSION = "0.02";
12              
13             =head1 NAME
14              
15             Number::Compare::Date - Like Number::Compare, but for epoch seconds
16              
17             =head1 SYNOPSIS
18              
19             use Number::Compare::Date;
20              
21             my $y2k = Number::Compare::Date->new(">=2000-01-01");
22              
23             if ($y2k->(time))
24             { print "Run for the hills, the y2k bug's gonna eat you " }
25              
26             =head1 DESCRIPTION
27              
28             A simple extension to Number::Compare that allows you to compare
29             dates against numbers (which should be epoch seconds.) The value
30             that is compared can either be epoch seconds:
31              
32             my $perl583 = Number::Compare::Date->new("<1072915199");
33              
34             Or it can be anything Date::Parse can recognise:
35              
36             my $perl583 = Number::Compare->new('
37              
38             If you don't use a comparison operator (C<< < >>, C<< <= >>, C<< >= >>
39             or C<< > >>), then the module will check if the date is equal.
40              
41             See L for more formats.
42              
43             =cut
44              
45             sub parse_to_perl
46             {
47 15     15 1 18435 shift;
48 15         19 my $test = shift;
49              
50             # get the test and the date bit separated
51 15 50       119 my ($comparison, $target) =
52             $test =~ m{^
53             ([<>]=?)? # comparison
54             (.*?) # value
55             $}ix
56             or croak "don't understand '$test' as a test";
57              
58             # check that the comparison is defined
59 15   100     43 $comparison ||= "==";
60              
61             # check if the target is all digits
62 15 100       53 unless ($target =~ m/^\d+$/)
63 10         29 { $target = str2time($target) }
64              
65 15         1956 return "$comparison $target"
66             }
67              
68             =head1 AUTHOR
69              
70             Written by Mark Fowler Emark@twoshortplanks.comE
71              
72             Copyright Profero 2003. All Rights Reserved.
73              
74             This program is free software; you can redistribute it
75             and/or modify it under the same terms as Perl itself.
76              
77             =head1 BUGS
78              
79             Doesn't cope with anything outside the epoch range on your
80             machine. Isn't DateTime compatible.
81              
82             Bugs should be reported to the open source development team
83             at Profero via the CPAN RT system.
84              
85             L.
86              
87             =head1 SEE ALSO
88              
89             L, L
90              
91             =cut
92              
93             1;