=head1 NAME
HTML::Microformats::Datatype::RecurringDateTime - a datetime that recurs
=head1 SYNOPSIS
my $r_datetime = HTML::Microformats::Datatype::RecurringDateTime->new($ical_string);
print "$r_datetime\n";
=cut
package HTML::Microformats::Datatype::RecurringDateTime;
use HTML::Microformats::Utilities qw(searchClass stringify);
use base qw(HTML::Microformats::Datatype);
use strict qw(subs vars); no warnings;
use 5.010;
use HTML::Microformats::Datatype::DateTime;
use RDF::Trine;
use Object::AUTHORITY;
BEGIN {
$HTML::Microformats::Datatype::RecurringDateTime::AUTHORITY = 'cpan:TOBYINK';
$HTML::Microformats::Datatype::RecurringDateTime::VERSION = '0.105';
}
=head1 DESCRIPTION
=head2 Constructors
=over 4
=item C<< $r = HTML::Microformats::Datatype::RecurringDateTime->new($string, [$context]) >>
Creates a new HTML::Microformats::Datatype::RecurringDateTime object.
$string is an iCalendar-RRULE-style string.
=cut
sub new
{
my $class = shift;
return $class->parse_string(@_) if @_;
bless {}, $class;
}
=item C<< $r = HTML::Microformats::Datatype::RecurringDateTime->parse($string, $elem, $context) >>
Creates a new HTML::Microformats::Datatype::RecurringDateTime object.
$string is perhaps an iCalendar-RRULE-style string. $elem is the
XML::LibXML::Element being parsed. $context is the document
context.
This constructor supports a number of experimental microformat
interval patterns. e.g.
<span class="rrule">
The summer lectures are held held <span class="freq">yearly</span>,
every <span class="interval">2</span>nd year (1999, 2001, etc),
every <span class="byday">Sunday</span>
in January <abbr class="bymonth" title="1" style="display:none"></abbr>
at <span class="byhour">8</span>:<span class="byminute">30</span> and
repeated at <span class="byhour">9</span>:30.
</span>
=cut
sub parse
{
my $class = shift;
my $string = shift;
my $elem = shift || undef;
my $context = shift || undef;
my $self = bless {}, $class;
$self->{'_context'} = $context;
$self->{'_id'} = $context->make_bnode;
my @freq_nodes = searchClass('freq', $elem);
unless (@freq_nodes)
{
if (lc $elem->tagName eq 'abbr' and $elem->hasAttribute('title'))
{ return $class->parse_string($elem->getAttribute('title'), $context); }
else
{ return $class->parse_string(''.stringify($elem, 'value'), $context); }
}
$self->{'freq'} = uc stringify($freq_nodes[0], 'value');
foreach my $n ($elem->getElementsByTagName('*'))
{
if ($n->getAttribute('class') =~ /\b (until|count) \b/x)
{
my $p = $1;
unless (defined $self->{'until'} || defined $self->{'count'})
{
$self->{$p} = ''.stringify($n, 'value');
$self->{$p} = HTML::Microformats::Datatype::DateTime->parse($self->{$p}, $elem, $context)
if $p eq 'until';
}
}
elsif ($n->getAttribute('class') =~ /\b (bysecond | byminute | byhour |
bymonthday | byyearday | byweekno | bymonth | bysetpos) \b/x)
{
my $p = $1;
my $v = stringify($n, 'value');
my @v = split ',', $v;
push @{ $self->{$p} }, @v;
}
elsif ($n->getAttribute('class') =~ /\b (byday | wkst) \b/x)
{
my $p = $1;
my $txt = stringify($n, 'value');
my @v = split ',', $txt;
foreach my $v (@v)
{
if ($v =~ /^\s*(\-?[12345])?\s*(MO|TU|WE|TH|FR|SA|SU)/i)
{ $v = uc($1.$2); }
else
{ $v = uc($txt); }
push @{ $self->{$p} }, "$v";
}
}
if ($n->getAttribute('class') =~ /\b interval \b/x)
{
my $v = stringify($n, 'value');
$self->{'interval'} = $v;
}
}
return $self;
}
=item C<< $r = HTML::Microformats::Datatype::RecurringDateTime->parse_string($string, [$context]) >>
Essentially just an alias for C<< new >>.
=back
=cut
sub parse_string
{
my $class = shift;
my $string = shift;
my $context = shift || undef;
my $self = bless {}, $class;
$self->{'_context'} = $context;
$self->{'_id'} = $context->make_bnode;
my @parts = split /\;/, $string;
foreach my $part (@parts)
{
my ($k,$v) = split /\=/, $part;
if ($k =~ /^( byday | wkst | bysecond | byminute | byhour |
bymonthday | byyearday | byweekno | bymonth | bysetpos )$/xi)
{
$self->{ lc $k } = [ split /\,/, $v ];
}
elsif ($k =~ /^( interval | until | count | freq )$/xi)
{
$self->{ lc $k } = uc $v;
}
}
return $self;
}
=head2 Public Methods
=over 4
=item C<< $r->to_string >>
Returns an iCal-RRULE-style formatted string representing the recurrance.
=cut
sub to_string
{
my $self = shift;
my $rv = '';
foreach my $p (qw(freq until count bysecond byminute byhour
bymonthday byyear byweekno bymonth bysetpos byday wkst interval))
{
if (ref $self->{$p} eq 'ARRAY')
{
$rv .= sprintf("%s=%s;", uc $p, (join ',', @{$self->{$p}}))
if @{$self->{$p}};
}
elsif (defined $self->{$p})
{
$rv .= sprintf("%s=%s;", uc $p, $self->{$p});
}
}
$rv =~ s/\;$//;
return $rv;
}
=item C<< $r->datatype >>
Returns an the RDF datatype URI representing the data type of this literal.
=cut
sub datatype
{
my $self = shift;
return 'http://buzzword.org.uk/rdf/icaltzdx#recur';
}
=item C<< $r->add_to_model($model) >>
Adds the recurring datetime to an RDF model as a resource (not a literal).
=back
=cut
sub add_to_model
{
my $self = shift;
my $model = shift;
my $me = RDF::Trine::Node::Blank->new( substr($self->{'_id'}, 2) );
my $ical = 'http://www.w3.org/2002/12/cal/icaltzd#';
foreach my $p (qw(freq until count bysecond byminute byhour
bymonthday byyear byweekno bymonth bysetpos byday wkst interval))
{
$model->add_statement(RDF::Trine::Statement->new(
$me,
RDF::Trine::Node::Resource->new("${ical}${p}"),
RDF::Trine::Node::Literal->new( (ref $self->{$p} eq 'ARRAY') ? (join ',', @{$self->{$p}}) : $self->{$p} ),
))
if defined $self->{$p};
}
$model->add_statement(RDF::Trine::Statement->new(
$me,
RDF::Trine::Node::Resource->new("http://www.w3.org/1999/02/22-rdf-syntax-ns#type"),
RDF::Trine::Node::Resource->new("http://buzzword.org.uk/rdf/icaltzdx#Recur"),
));
$model->add_statement(RDF::Trine::Statement->new(
$me,
RDF::Trine::Node::Resource->new("http://www.w3.org/1999/02/22-rdf-syntax-ns#value"),
RDF::Trine::Node::Literal->new($self->to_string, undef, $self->datatype),
));
return $self;
}
sub TO_JSON
{
my $self = shift;
return $self->to_string;
}
1;
__END__
=head1 BUGS
Please report any bugs to L<http://rt.cpan.org/>.
=head1 SEE ALSO
L<HTML::Microformats>,
L<HTML::Microformats::Datatype>.
=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