root/Date-Range-Birth/trunk/lib/Date/Range/Birth.pm

Revision 365 (checked in by miyagawa, 18 years ago)

Initial revision

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
Line 
1 package Date::Range::Birth;
2
3 use strict;
4 use vars qw($VERSION);
5 $VERSION = '0.01';
6
7 use base qw(Date::Range);
8
9 use Date::Calc;
10 use Date::Simple;
11
12 sub _croak { require Carp; Carp::croak(@_) }
13
14 sub new {
15     my($class, $age, $date) = @_;
16     $date ||= Date::Simple->new; # default today
17     unless (UNIVERSAL::isa($date, 'Date::Simple')) {
18         _croak("date should be given as Date::Simple object: $date");
19     }
20
21     my($start, $end);
22     if (ref($age) && ref($age) eq 'ARRAY') {
23         ($start, $end) = $class->_from_array($age, $date);
24     }
25     elsif ($age =~ /^\d+$/) {
26         ($start, $end) = $class->_from_age($age, $date);
27     } else {
28         _croak("invalid argument for Date::Range::Birth: $age");
29     }
30     return $class->SUPER::new($start, $end);
31 }
32
33 sub _from_age {
34     my($class, $age, $date) = @_;
35
36     my @start = Date::Calc::Add_Delta_YMD(_ymd($date),  - $age - 1, 0, 1);
37     my @end   = Date::Calc::Add_Delta_YMD(_ymd($date),  - $age , 0, 0);
38
39     return Date::Simple->new(@start), Date::Simple->new(@end);
40 }
41
42 sub _from_array {
43     my($class, $age, $date) = @_;
44     my @ages = sort { $a <=> $b } @$age;
45     @ages == 2 or _croak("Date::Range::Birth: invalid number of args in age");
46
47     # old's start to young's end
48     my @start = Date::Calc::Add_Delta_YMD(_ymd($date),  - $ages[1] - 1, 0, 1);
49     my @end   = Date::Calc::Add_Delta_YMD(_ymd($date),  - $ages[0] , 0, 0);
50
51     return Date::Simple->new(@start), Date::Simple->new(@end);
52 }
53
54 sub _ymd {
55     my $date = shift;
56     return $date->year, $date->month, $date->day;
57 }
58
59 1;
60 __END__
61
62 =head1 NAME
63
64 Date::Range::Birth - range of birthday for an age
65
66 =head1 SYNOPSIS
67
68   use Date::Range::Birth;
69
70   # birthday for those who are 24 years old now
71   my $range = Date::Range::Birth->new(24);
72
73   # birthday for those who are 24 years old in 2001-01-01
74   my $date   = Date::Simple->new(2001, 1, 1);
75   my $range2 = Date::Range::Birth->new(24, $date);
76
77   # birthday for those who are between 20 and 30 yeard old now
78   my $range3 = Date::Range::Birth->new([ 20, 30 ]);
79
80 =head1 DESCRIPTION
81
82 Date::Range::Birth is a subclass of Date::Range, which provides a way
83 to construct range of dates for birthday.
84
85 =head1 METHODS
86
87 =over 4
88
89 =item new
90
91   $range = Date::Range::Birth->new($age);
92   $range = Date::Range::Birth->new($age, $date);
93   $range = Date::Range::Birth->new([ $young, $old ]);
94   $range = Date::Range::Birth->new([ $young, $old ], $date);
95
96 returns Date::Range::Birth object for birthday of the age. If C<$date>
97 (Date::Simple object) provided, returns range of birthday for those
98 who are C<$age> years old in C<$date>. Default is today (now).
99
100 If the age is provided as array reference (like C<[ $young, $old ]>),
101 returns range of birthday for those who are between C<$young> -
102 C<$old> years old.
103
104 =back
105
106 Other methods are inherited from Date::Range. See L<Date::Range> for
107 details.
108
109 =head1 AUTHOR
110
111 Original idea by ikechin E<lt>ikebe@cpan.orgE<gt>
112
113 Code implemented by Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>
114
115 This library is free software; you can redistribute it and/or modify
116 it under the same terms as Perl itself.
117
118 =head1 SEE ALSO
119
120 L<Date::Range>, L<Date::Simple>, L<Date::Calc>
121
122 =cut
Note: See TracBrowser for help on using the browser.