File Coverage

blib/lib/iCal/Parser/HTML.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

# $Id: HTML.pm 517 2008-06-30 23:48:04Z rick $
package iCal::Parser::HTML;

use strict;
use warnings;

# Get version from subversion url of tag or branch.
our $VERSION= do {(q$URL: svn+ssh://xpc/var/lib/svn/rick/perl/ical/iCal-Parser-HTML/tags/1.07/lib/iCal/Parser/HTML.pm $=~ m$.*/(?:tags|branches)/([^/ \t]+)$)[0]||'0.1'};

our @ISA = qw(Exporter);
our @EXPORT_OK=qw($xml $xsl);

use iCal::Parser::SAX;
use XML::LibXML;
use XML::LibXML::SAX::Builder;
use XML::LibXSLT;

our $xsl=XML::LibXSLT->new;
our $xml=XML::LibXML->new;

our %sheet_cache=();

sub new {
    my $class=shift;
    return bless {@_},$class;
}
sub parse {
    my($self,%args)=@_;
    my $type=delete $args{type};
    my $files=delete $args{files};
    my $url=delete $args{url}||'';
    #adjust dates to appropriate period
    my $start=$args{start};
    unless(ref $start) {
	$start=$args{start}=$self->parse_partial_datetime($start);
    }
    $start->subtract(days=>$start->dow-1) if $type eq 'week';
    $start->set(day=>1) if $type eq 'month';
    $start->set(day=>1,month=>1) if $type eq 'year';
    $args{end}=$start->clone->add("${type}s"=>1);

    my $sink=XML::LibXML::SAX::Builder->new;
    my $parser=iCal::Parser::SAX->new(Handler=>$sink,%args);
    my $result=$parser->parse_uris(@$files);

    my $sheet=$sheet_cache{$type}||=$xsl
    ->parse_stylesheet($xml->parse_file(get_sheet_dir() . $type . '.xsl'));

    return $sheet->output_string
    ($sheet->transform($result,$self->sheet_args($args{start},$url)));
}
sub parse_partial_datetime {
    my($self,$string)=@_;
    my($y,$m,$d)=($string=~ m/(\d{4})-?(\d{2})?-?(\d{2})?/);

    my $date=$y ? DateTime->new(year=>$y,
				($m ? (month=>$m) :()),
				($d ? (day=>$d):())
			       ) : DateTime->now;
}
sub sheet_args {
    my($self,$date,$url)=@_;
    my %args;
    foreach my $t qw(week month year) {
		$args{$t}=$date->$t();
    }
    $args{date}='"'.$date->ymd .'"';
    $args{'base-url'}='"'.$url.'"';
    return %args;
}
sub get_sheet_dir {
    my $key=__PACKAGE__ . '.pm';
    $key=~s|::|/|go;
    my $path=$INC{$key};
    $path=~s|\.pm$|/stylesheet/|go;
    return $path;
}
1;
__END__