package WebCoso::XSLT;
use strict;
use warnings;
use WebCoso::Common;
use Path::Class;
use XML::LibXML;
use XML::LibXSLT;
use DateTime::Format::Strptime;
use Log::Log4perl ':easy';
use Data::Dumper;
use XML::LibXSLT::EXSLT;
my $NS='http://webcoso.thenautilus.net/';
sub new {
my ($class,%opts)=@_;
my $self={%opts};
$self->{xml_parser}=XML::LibXML->new();
$self->{xslt_proc}=XML::LibXSLT->new();
XML::LibXSLT::EXSLT->apply_to($self->{xslt_proc});
$self->{xslt_proc}->register_function($NS,'title-for',
sub{$self->getTitleForXML(@_)});
$self->{xslt_proc}->register_function($NS,'dst-uri-for',
sub{WebCoso::Common::dstUriFor(@_)});
$self->{xslt_proc}->register_function($NS,'tagged',sub{$self->getTagsXML});
$self->{xslt_proc}->register_function($NS,'changes',sub{$self->getChangesXML});
$self->{xslt_proc}->register_function($NS,'dates-for',
sub{$self->getDatesXML(WebCoso::Common::getDatesFor($self->{fc},@_))});
$self->{xslt_proc}->register_function($NS,'document',
sub{$self->{fc}->get(WebCoso::Common::srcXMLFor(@_))
|| XML::LibXML::Document->new('1.0','utf-8')});
$self->{xslt_proc}->register_function($NS,'message',
sub{DEBUG($_[0],' ',$_[1]->get_node(0)->toString());return ''});
$self->{xslt_proc}->debug_callback(sub{DEBUG(@_)});
$self->{fc}->add_parser(qr{\.xml$} =>
sub { $self->{xml_parser}->parse_string($_[1],$_[0]) });
$self->{fc}->add_parser(qr{\.xslt?$} =>
sub { $self->{xslt_proc}->parse_stylesheet
($self->{xml_parser}->parse_string($_[1],$_[0])) });
$self->{fc}->add_writer(qr{\.xml$} =>
sub { $_[1]->toFile($_[0]) });
bless $self,$class;
}
sub du2html {
my ($self)=@_;
return sub {
my ($maker,$target,$deps,$matches)=@_;
DEBUG("du2html($maker,$target,(@$deps),(@$matches))");
my $du=$self->{fc}->get($deps->[-1]);
my $xslt=file($deps->[-1])->parent->file('du2html.xsl');
$xslt=$self->{fc}->get($xslt);
if (@$deps>1) {
INFO("xml tag source from $deps->[0]");
$self->setXMLTagsSource($self->{fc}->get($deps->[0]));
} else {
$self->setXMLTagsSource(undef);
}
if (@$deps>2) {
INFO("changes from $deps->[1]");
$self->setChangesSource($self->{fc}->get($deps->[1]));
}
else {
$self->setChangesSource(undef);
}
my $out=$xslt->transform($du,
XML::LibXSLT::xpath_to_string(
path => $matches->[0],
language => $matches->[1],
filename => $deps->[-1],
));
$self->{fc}->put($target,$xslt->output_string($out));
};
}
sub fillFeed {
my ($self)=@_;
return sub {
my ($maker,$target,$deps,$matches)=@_;
DEBUG("fillFeed($maker,$target,(@$deps),(@$matches))");
my $du=$self->{fc}->get($deps->[-1]);
my $xslt=file($deps->[-1])->parent->file('fillFeed.xsl');
$xslt=$self->{fc}->get($xslt);
if (@$deps>1) {
INFO("xml tag source from $deps->[0]");
$self->setXMLTagsSource($self->{fc}->get($deps->[0]));
} else {
$self->setXMLTagsSource(undef);
}
my $out=$xslt->transform($du,
XML::LibXSLT::xpath_to_string(
path => $matches->[0],
language => $matches->[1],
filename => $deps->[-1],
));
$self->{fc}->put($target,$out);
};
}
sub setXMLTagsSource {
my ($self,$source)=@_;
$self->{tags_source}=(defined $source) ? {%$source} : undef;
delete $self->{tags_document};
}
sub getTagsXML {
my ($self)=@_;
if (defined $self->{tags_document}) {
DEBUG('returing cached TagsXML');
return $self->{tags_document}
}
DEBUG('building TagsXML');
my $doc=XML::LibXML::Document->new();
my $de=$doc->createElementNS($NS,'wc:tags');
$doc->setDocumentElement($de);
return $doc unless defined $self->{tags_source};
for my $tagname (sort keys %{$self->{tags_source}}) {
my $doclist = $self->{tags_source}{$tagname};
my $te=$doc->createElementNS($NS,'wc:tag');
$te->setAttribute('name',$tagname);
$de->appendChild($te);
my %docs;
push @{$docs{WebCoso::Common::dstUriFor($_)}},WebCoso::Common::langOf($_) for @$doclist;
for my $docurl (sort keys %docs) {
my $langs = $docs{$docurl};
my $dle=$doc->createElementNS($NS,'wc:doc');
$dle->setAttribute('uri',$docurl||'ERRORE');
$te->appendChild($dle);
for my $lang (@$langs) {
my $le=$doc->createElementNS($NS,'wc:lang');
$le->appendTextNode($lang);
$dle->appendChild($le);
}
}
}
return $self->{tags_document}=$doc;
}
{
my %name_map=(creation=>'wc:creation-date',
last_change=>'wc:last-change');
my $format=DateTime::Format::Strptime->new(pattern=>'%F %T',time_zone=>'UTC');
sub setChangesSource {
my ($self,$source)=@_;
$self->{changes_source}=(defined $source) ? {%$source} : undef;
delete $self->{changes_document};
}
sub getChangesXML {
my ($self)=@_;
if (defined $self->{changes_document}) {
DEBUG('returing cached ChangesXML');
return $self->{changes_document}
}
DEBUG('building ChangesXML');
my $doc=XML::LibXML::Document->new();
my $de=$doc->createElementNS($NS,'wc:changes');
$doc->setDocumentElement($de);
return $doc unless defined $self->{changes_source};
for my $docpath (sort keys %{$self->{changes_source}}) {
my $dates = $self->{changes_source}{$docpath};
my $te=$doc->createElementNS($NS,'wc:document');
$te->setAttribute('path',$docpath);
$te->setAttribute('uri',WebCoso::Common::dstUriFor($docpath));
$te->setAttribute('lang',WebCoso::Common::langOf($docpath));
$de->appendChild($te);
for my $type (sort keys %$dates) {
my $value = $dates->{$type};
my $dle=$doc->createElementNS($NS,$name_map{$type});
$dle->appendTextNode($format->format_datetime($value));
$te->appendChild($dle);
}
}
return $self->{changes_document}=$doc;
}
sub getDatesXML {
my ($self,$dates)=@_;
my $doc=XML::LibXML::Document->new();
return $doc unless defined $dates;
my $de=$doc->createElementNS($NS,'wc:dates');
$doc->setDocumentElement($de);
for my $k (sort keys %$dates) {
my $v = $dates->{$k};
my $d=$doc->createElementNS($NS,$name_map{$k});
$d->appendTextNode($format->format_datetime($v));
$de->appendChild($d);
}
return $doc;
}
}
sub getTitleForXML {
my ($self,$lang,$path,$name)=@_;
my $lang_cleaned;
if (ref($lang) && $lang->can('get_nodelist')) {
DEBUG('getTitleForXML with multple languages');
for my $node ($lang->get_nodelist) {
my $val=$node->findvalue('normalize-space(string(.))');
DEBUG(" <$val>");
push @{$lang_cleaned},$val if length($val)>0;
}
}
else {
DEBUG('getTitleForXML with a single language');
$lang_cleaned=$lang;
}
return $self->getTitleXML(WebCoso::Common::getTitleFor(
$self->{fc},
$lang_cleaned,
$path,
$name));
}
sub getTitleXML {
my ($self,$title)=@_;
return $title if ref($title)
&& ($title->isa('XML::LibXML::Node')
|| $title->isa('XML::LibXML::NodeList'));
DEBUG("getTitleXML - creating element");
my $el=XML::LibXML::Element->new('title');
$el->appendTextNode($title);
return $el;
}
1;
