655
|
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.
|