1 ############################################################################ |
|
2 # Copyright (c) 1998 Enno Derksen |
|
3 # All rights reserved. |
|
4 # This program is free software; you can redistribute it and/or modify it |
|
5 # under the same terms as Perl itself. |
|
6 ############################################################################ |
|
7 |
|
8 package XML::XQL::Date; |
|
9 |
|
10 use vars qw(@ISA); |
|
11 @ISA = qw( XML::XQL::PrimitiveType ); |
|
12 |
|
13 use strict; |
|
14 use Carp; |
|
15 |
|
16 BEGIN |
|
17 { |
|
18 # Date::Manip relies on setting of $TZ. |
|
19 unless (defined $ENV{TZ}) |
|
20 { |
|
21 $ENV{TZ} = "EST5EDT"; |
|
22 warn "XML::XQL::Date - setting timezone \$ENV{TZ} to EST5EDT (east coast USA.) Set your TZ environment variable to avoid this message."; |
|
23 } |
|
24 } |
|
25 use Date::Manip; |
|
26 |
|
27 BEGIN { |
|
28 # add date() implementation to XQL engine. |
|
29 XML::XQL::defineFunction ("date", \&XML::XQL::Date::date, 1, 1, 1); |
|
30 }; |
|
31 |
|
32 use overload |
|
33 'fallback' => 1, # use default operators, if not specified |
|
34 '<=>' => \&compare, # also takes care of <, <=, ==, != etc. |
|
35 'cmp' => \&compare, # also takes care of le, lt, eq, ne, etc. |
|
36 '""' => \&yyyymmddhhmmss; # conversion to string uses yyyymmddhhmmss |
|
37 |
|
38 sub new |
|
39 { |
|
40 my $class = shift; |
|
41 |
|
42 my (%args); |
|
43 if (@_ < 2) |
|
44 { |
|
45 my $str = @_ ? $_[0] : ""; |
|
46 %args = (String => $str); |
|
47 } |
|
48 else |
|
49 { |
|
50 %args = @_; |
|
51 } |
|
52 |
|
53 my $self = bless \%args, $class; |
|
54 |
|
55 if (@_ < 2) |
|
56 { |
|
57 my $date = $self->createInternal (@_ ? $_[0] : "now"); |
|
58 $date = "" unless isValidDate ($date); |
|
59 $self->{Internal} = $date; |
|
60 } |
|
61 $self; |
|
62 } |
|
63 |
|
64 sub createInternal |
|
65 { |
|
66 my ($self, $str) = @_; |
|
67 Date::Manip::ParseDate ($str); |
|
68 |
|
69 # From Date::Manip: |
|
70 # |
|
71 # 2 digit years fall into the 100 year period given by [ CURR-N, |
|
72 # CURR+(99-N) ] where N is 0-99. Default behavior is 89, but other useful |
|
73 # numbers might be 0 (forced to be this year or later) and 99 (forced to be |
|
74 # this year or earlier). It can also be set to "c" (current century) or |
|
75 # "cNN" (i.e. c18 forces the year to bet 1800-1899). Also accepts the |
|
76 # form cNNNN to give the 100 year period NNNN to NNNN+99. |
|
77 #$Date::Manip::YYtoYYYY=89; |
|
78 |
|
79 # Use this to force the current date to be set to this: |
|
80 #$Date::Manip::ForceDate=""; |
|
81 } |
|
82 |
|
83 sub isValidDate # static method |
|
84 { |
|
85 my ($date) = @_; |
|
86 return 0 unless defined $date; |
|
87 |
|
88 my $year = substr ($date, 0, 4) || 0; |
|
89 |
|
90 $year > 1500; |
|
91 #?? arbitrary limit - years < 100 cause problems in Date::Manip |
|
92 } |
|
93 |
|
94 sub ymdhms |
|
95 { |
|
96 my $self = shift; |
|
97 if (@_) |
|
98 { |
|
99 my ($y, $mon, $d, $h, $m, $s) = @; |
|
100 #?? implement |
|
101 } |
|
102 else |
|
103 { |
|
104 #?? test: x skips a character. Format: "YYYYMMDDhh:mm::ss" |
|
105 return () unless length $self->{Internal}; |
|
106 # print "ymhds " . $self->{Internal} . "\n"; |
|
107 unpack ("A4A2A2A2xA2xA2", $self->{Internal}); |
|
108 } |
|
109 } |
|
110 |
|
111 sub yyyymmddhhmmss |
|
112 { |
|
113 my ($self) = @_; |
|
114 my ($y, $mon, $d, $h, $m, $s) = $self->ymdhms; |
|
115 |
|
116 $y ? "$y-$mon-${d}T$h:$m:$s" : ""; |
|
117 # using Date::Manip::UnixDate is a bit too slow for my liking |
|
118 #?? could add support for other formats |
|
119 } |
|
120 |
|
121 sub xql_toString |
|
122 { |
|
123 #?? use $_[0]->{String} or |
|
124 $_[0]->yyyymmddhhmmss; |
|
125 } |
|
126 |
|
127 sub xql_compare |
|
128 { |
|
129 my ($self, $other) = @_; |
|
130 my $type = ref ($self); |
|
131 if (ref ($other) ne $type) |
|
132 { |
|
133 my $str = $other->xql_toString; |
|
134 # Allow users to plug in their own Date class |
|
135 $other = eval "new $type (\$str)"; |
|
136 #?? check result? |
|
137 } |
|
138 #print "date::compare self=" . $self->{Internal} . " other=" . $other->{Internal}. "\n"; |
|
139 $self->{Internal} cmp $other->{Internal}; |
|
140 } |
|
141 |
|
142 sub xql_setSourceNode |
|
143 { |
|
144 $_[0]->{SourceNode} = $_[1]; |
|
145 } |
|
146 |
|
147 sub xql_sourceNode |
|
148 { |
|
149 $_[0]->{SourceNode}; |
|
150 } |
|
151 |
|
152 sub xql_setValue |
|
153 { |
|
154 my ($self, $val) = @_; |
|
155 $self->{Internal} = $self->createInternal ($val); |
|
156 $self->{String} = $val; |
|
157 } |
|
158 |
|
159 # The XQL date() function |
|
160 sub date # static method |
|
161 { |
|
162 my ($context, $listref, $text) = @_; |
|
163 |
|
164 $text = XML::XQL::toList ($text->solve ($context, $listref)); |
|
165 my @result = (); |
|
166 for my $val (@$text) |
|
167 { |
|
168 # Using xql_new allows users to plug-in their own Date class |
|
169 my $date = XML::XQL::xql_new ("date", $val->xql_toString); |
|
170 # print "date $val " . XML::XQL::d($val) . " " . $date->xql_toString . "\n"; |
|
171 push @result, $date; |
|
172 } |
|
173 \@result; |
|
174 } |
|
175 |
|
176 1; # module return code |
|
177 |
|
178 __END__ |
|
179 |
|
180 =head1 NAME |
|
181 |
|
182 XML::XQL::Date - Adds an XQL::Node type for representing and comparing dates and times |
|
183 |
|
184 =head1 SYNOPSIS |
|
185 |
|
186 use XML::XQL; |
|
187 use XML::XQL::Date; |
|
188 |
|
189 my $query = new XML::XQL::Query (Expr => "doc//timestamp[. < date('12/31/1999')]"); |
|
190 my @results = $query->solve ($doc); |
|
191 |
|
192 =head1 DESCRIPTION |
|
193 |
|
194 This package uses the L<Date::Manip> package to add an XQL node type |
|
195 (called XML::XQL::Date) that can be used to represent dates and times. |
|
196 The Date::Manip package can parse almost any date or time format imaginable. |
|
197 (I tested it with Date::Manip 5.33 and I know for sure that it doesn't work |
|
198 with 5.20 or lower.) |
|
199 |
|
200 It also adds the XQL B<date> function which creates an XML::XQL::Date |
|
201 object from a string. See L<XML::XQL::Tutorial> for a description of the date() |
|
202 function. |
|
203 |
|
204 You can plug in your own Date type, if you don't want to use Date::Manip |
|
205 for some reason. See L<XML::XQL> and the XML::XQL::Date source file for |
|
206 more details. |
|