=head1 NAME
HTML::Microformats::Datatype::Duration - floating periods of time
=head1 SYNOPSIS
my $duration = HTML::Microformats::Datatype::Duration->new($d);
print "$duration\n";
=cut
package HTML::Microformats::Datatype::Duration;
use strict qw(subs vars); no warnings;
use overload '""'=>\&to_string, '+'=>\&add, '-'=>\&subtract, '<=>'=>\&compare, 'cmp'=>\&compare;
use base qw(Exporter HTML::Microformats::Datatype);
our @EXPORT = qw();
our @EXPORT_OK = qw(compare add subtract);
use DateTime;
use DateTime::Duration;
use HTML::Microformats::Utilities qw(searchClass stringify);
use Object::AUTHORITY;
BEGIN {
$HTML::Microformats::Datatype::Duration::AUTHORITY = 'cpan:TOBYINK';
$HTML::Microformats::Datatype::Duration::VERSION = '0.105';
}
=head1 DESCRIPTION
=head2 Constructors
=over 4
=item C<< $d = HTML::Microformats::Datatype::Duration->new($duration) >>
Creates a new HTML::Microformats::Datatype::Duration object.
$duration is a DateTime::Duration object.
=cut
sub new
{
my $class = shift;
my $duration_obj = shift;
my $this = {};
$this->{d} = $duration_obj;
bless $this, $class;
return $this;
}
=item C<< $d = HTML::Microformats::Datatype::Duration->parse($string, $elem, $context) >>
Creates a new HTML::Microformats::Datatype::Duration object.
$string is a duration represented in ISO 8601 format, for example:
'P1Y' or 'PT2H29M58.682S'. $elem is the XML::LibXML::Element
being parsed. $context is the document context.
The standard way of representing durations in Microformats is
as an ISO 8601 string:
<abbr class="duration" title="P4DT4H">4 and a half days</abbr>
This constructor also supports a number of experimental microformat
duration patterns. ISO-31 class names are supported:
<div class="duration">
<span claa="d">4</span> and
<abbr title="12" class="h">a half</abbr> days.
</div>
As are metric/SI measures (in seconds):
<span class="duration">124 s</span>
<span class="duration">124</span> seconds
Or using an hMeasure microformat with no 'item' property, the 'type' property
either absent or a case-insensitive match of 'duration' and a unit property
of 's'/'sec'/'seconds', 'min'/'minutes', 'h'/'hours' or 'd'/'days'. For example:
<span class="duration hmeasure">
<b class="unit">Days</b>: <span class="num">4.5</span>
</span>
=back
=cut
sub parse
{
my $class = shift;
my $string = shift;
my $elem = shift||undef;
my $page = shift||undef;
my $pkg = __PACKAGE__;
# Try for nested class='s', class='min', class='h', etc. Standard=ISO-31.
if ($elem)
{
my ($d, $h, $min, $s, $n);
my $success = 0;
my $X = {};
# Find values.
no strict;
foreach my $x (qw(d h min s))
{
my @tmp = searchClass($x, $elem);
if (@tmp)
{
my $y = stringify($tmp[0], {'abbr-pattern'=>1});
$y =~ s/\,/\./;
$X->{$x} = "$y"; # MagicString -> string.
$success++;
}
}
if ($success)
{
# Cope with fractions.
foreach my $frac (qw(d=24.h h=60.min min=60.s s=1000000000.n))
{
my ($big, $mult, $small) = split /[\=\.]/, $frac;
next unless ($X->{$big} =~ /\./);
my $int_part = int($X->{$big});
my $frac_part = $X->{$big} - $int_part;
$X->{$big} = $int_part;
$X->{$small} += ($mult * $frac_part);
}
use strict qw(subs vars); no warnings;
$X->{'n'} = int($X->{'n'});
# Construct and return object.
my $dur = DateTime::Duration->new(
days => $X->{'d'}||0,
hours => $X->{'h'}||0,
minutes => $X->{'min'}||0,
seconds => $X->{'s'}||0,
nanoseconds => $X->{'n'}||0
);
my $rv = new(__PACKAGE__, $dur);
$rv->{string} = $string;
$rv->{element} = $elem;
return $rv;
}
}
# Commas as decimal points.
my $string2 = $string;
$string2 =~ s/\,/\./g;
# Standard=ISO-8601.
if ($string2 =~ /^
\s*
([\+\-])? # Potentially negitive...
P # Period of...
(?:([\d\.]*)Y)? # n Years
(?:([\d\.]*)M)? # n Months
(?:([\d\.]*)W)? # n Weeks
(?:([\d\.]*)D)? # n Days
(?:
T # And a time of...
(?:([\d\.]*)H)? # n Hours
(?:([\d\.]*)M)? # n Minutes
(?:([\d\.]*)S)? # n Seconds
)?
\s*
/ix)
{
my $X = {};
$X->{'I'} = $1;
$X->{'y'} = $2;
$X->{'m'} = $3;
$X->{'w'} = $4;
$X->{'d'} = $5;
$X->{'h'} = $6;
$X->{'min'} = $7;
$X->{'s'} = $8;
$X->{'n'} = 0;
# Handle fractional
no strict;
foreach my $frac (qw(y=12.m m=30.d w=7.d d=24.h h=60.min min=60.s s=1000000000.n))
{
my ($big, $mult, $small) = split /[\=\.]/, $frac;
next unless ($X->{$big} =~ /\./);
my $int_part = int($X->{$big});
my $frac_part = $X->{$big} - $int_part;
$X->{$big} = $int_part;
$X->{$small} += ($mult * $frac_part);
}
use strict qw(subs vars); no warnings;
$X->{'n'} = int($X->{'n'});
# Construct and return object.
my $dur = DateTime::Duration->new(
years => $X->{'y'}||0,
months => $X->{'m'}||0,
weeks => $X->{'w'}||0,
days => $X->{'d'}||0,
hours => $X->{'h'}||0,
minutes => $X->{'min'}||0,
seconds => $X->{'s'}||0,
nanoseconds => $X->{'n'}||0
);
my $rv = $X->{'I'} eq '-' ? $pkg->new($dur->inverse)
: $pkg->new($dur);
$rv->{string} = $string;
$rv->{element} = $elem;
return $rv;
}
# Duration as a simple number of seconds. Standard=SI.
elsif ($string2 =~ /^\s* (\-?)(\d*)(?:\.(\d+))? \s* S? \s*$/ix && ($1||$2))
{
my $s = $2;
my $n = "0.$3" * 1000000000;
# Construct and return object.
my $dur = DateTime::Duration->new(
seconds => $s,
nanoseconds => $n
);
my $rv = $1 eq '-' ? $pkg->new($dur->inverse)
: $pkg->new($dur);
$rv->{'string'} = $string;
$rv->{'element'} = $elem;
return $rv;
}
# Look for hMeasure.
elsif ($elem && $page)
{
# By this point, we're on a clone of the element, and certain class data
# within it may have been destroyed. This is a little hack to find our
# way back to the *real* element!
my $real;
my @real = $page->document->findnodes($elem->getAttribute('data-cpan-html-microformats-nodepath'));
$real = $real[0] if @real;
return $string unless ($real);
my @measures;
if ($real->getAttribute('class') =~ /\b(hmeasure)\b/)
{ push @measures, HTML::Microformats::hMeasure->new($real, $page); }
else
{ @measures = HTML::Microformats::hMeasure->extract_all($real, $page); }
foreach my $m (@measures)
{
next if $m->data->{'item'} || $m->data->{'item_link'} || $m->data->{'item_label'} ;
next if defined $m->data->{'type'} && $m->data->{'type'} !~ /^\s*(duration)\s*$/i;
my ($dur, $neg);
my $n = $m->data->{'num'};
$n = "$n"; # MagicString -> string
if ($n < 0)
{
$neg = 1;
$n = 0 - $n;
}
if (defined $m->data->{'unit'} && $m->data->{'unit'} =~ /^\s* s ( ec (ond)? s? )? \s*$/ix)
{
# print "hMeasure duration in seconds.\n";
my $seconds = int($n); $n -= $seconds; $n *= 1000000000;
my $nanoseconds = int($n);
# Construct and return object.
$dur = DateTime::Duration->new(
seconds => $seconds,
nanoseconds => $nanoseconds
);
}
elsif (defined $m->data->{'unit'} && $m->data->{'unit'} =~ /^\s* min ( (ute)? s? )? \s*$/ix)
{
# print "hMeasure duration in minutes.\n";
my $minutes = int($n); $n -= $minutes; $n *= 60;
my $seconds = int($n); $n -= $seconds; $n *= 1000000000;
my $nanoseconds = int($n);
# Construct and return object.
$dur = DateTime::Duration->new(
minutes => $minutes,
seconds => $seconds,
nanoseconds => $nanoseconds
);
}
elsif (defined $m->data->{'unit'} && $m->data->{'unit'} =~ /^\s* h ( our s? )? \s*$/ix)
{
# print "hMeasure duration in hours.\n";
my $hours = int($n); $n -= $hours; $n *= 60;
my $minutes = int($n); $n -= $minutes; $n *= 60;
my $seconds = int($n);
# Construct and return object.
$dur = DateTime::Duration->new(
hours => $hours,
minutes => $minutes,
seconds => $seconds
);
}
elsif (defined $m->data->{'unit'} && $m->data->{'unit'} =~ /^\s* d ( ay s? )? \s*$/ix)
{
# print "hMeasure duration in days.\n";
my $days = int($n); $n -= $days; $n *= 24;
my $hours = int($n); $n -= $hours; $n *= 60;
my $minutes = int($n); $n -= $minutes; $n *= 60;
my $seconds = int($n);
# Construct and return object.
$dur = DateTime::Duration->new(
days => $days,
hours => $hours,
minutes => $minutes,
seconds => $seconds
);
}
if ($dur)
{
my $rv = ($neg==1) ? $pkg->new($dur->inverse)
: $pkg->new($dur);
$rv->{'string'} = $string;
$rv->{'element'} = $elem;
$rv->{'hmeasure'} = $m;
return $rv;
}
}
}
return $string;
}
=head2 Public Methods
=over 4
=item C<< $d->duration >>
Returns a DateTime::Duration object.
=cut
sub duration
{
my $self = shift;
return $self->{d}
}
=item C<< $d->to_string >>
Returns an ISO 8601 formatted string representing the duration.
=cut
sub to_string
{
my $self = shift;
my $str;
# We coerce weeks into days and nanoseconds into fractions of a second
# for compatibility with xsd:duration.
if ($self->{d}->is_negative)
{ $str .= '-P'; }
else
{ $str .= 'P'; }
if ($self->{d}->years)
{ $str .= $self->{d}->years.'Y'; }
if ($self->{d}->months)
{ $str .= $self->{d}->months.'M'; }
if ($self->{d}->weeks || $self->{d}->days)
{ $str .= ($self->{d}->days + (7 * $self->{d}->weeks)).'D'; }
$str .= 'T';
if ($self->{d}->hours)
{ $str .= $self->{d}->hours.'H'; }
if ($self->{d}->minutes)
{ $str .= $self->{d}->minutes.'M'; }
if ($self->{d}->seconds || $self->{d}->nanoseconds)
{ $str .= ($self->{d}->seconds + ($self->{d}->nanoseconds / 1000000000)).'S'; }
$str =~ s/T$//;
return $str;
}
sub TO_JSON
{
my $self = shift;
return $self->to_string;
}
=item C<< $d->datatype >>
Returns an the RDF datatype URI representing the data type of this literal.
=back
=cut
sub datatype
{
my $self = shift;
return 'http://www.w3.org/2001/XMLSchema#duration';
}
=head2 Functions
=over 4
=item C<< compare($a, $b) >>
Compares durations $a and $b. Return values are as per 'cmp' (see L<perlfunc>).
Note that there is not always a consistent answer when comparing durations. 30 days
is longer than a month in February, but shorter than a month in January. Durations
are compared as if they were applied to the current datetime (i.e. now).
This function is not exported by default.
Can also be used as a method:
$a->compare($b);
=cut
sub compare
{
my $this = shift;
my $that = shift;
return DateTime::Duration->compare($this->{d}, $that->{d}, DateTime->now);
}
=item C<< $c = add($a, $b) >>
Adds two durations together.
This function is not exported by default.
Can also be used as a method:
$c = $a->add($b);
=cut
sub add
{
my $this = shift;
my $that = shift;
my $sign = shift || '+';
my $rv = $this->{d}->clone;
if ($sign eq '-')
{ $rv -= $that->{d}; }
else
{ $rv += $that->{d}; }
return new(__PACKAGE__, $rv);
}
=item C<< $c = subtract($a, $b) >>
Subtracts duration $b from $a.
This function is not exported by default.
Can also be used as a method:
$c = $a->subtract($b);
=back
=cut
sub subtract
{
return add(@_, '-');
}
1;
__END__
=head1 BUGS
Please report any bugs to L<http://rt.cpan.org/>.
=head1 SEE ALSO
L<HTML::Microformats>,
L<HTML::Microformats::Datatype>,
L<DateTime::Duration>.
=head1 AUTHOR
Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
=head1 COPYRIGHT AND LICENCE
Copyright 2008-2012 Toby Inkster
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 DISCLAIMER OF WARRANTIES
THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
=cut