package WebCoso::Common;
use strict;
use warnings;
use File::Next;
use Path::Class;
use XML::LibXML::XPathContext;
use DateTime;
use DateTime::Format::DateParse;
use Log::Log4perl ':easy';
use List::MoreUtils 'uniq';
our $SRCPATH='src';
our $DSTPATH='dst';
our $DSTBASEURL='/';
our @TMPLPATH=('common/');
our $VERBOSITY=0;
my $xpath=XML::LibXML::XPathContext->new();
$xpath->registerNs('x', 'http://www.w3.org/1999/xhtml');
sub langOf {
my ($name)=@_;
$name=~m{(^|/)(?:document|feed)\.([^.]+)(\.|$)} and return $2;
return;
}
sub typeOf {
my ($name)=@_;
$name=~m{(^|/)(?:document|feed)\.[^.]+\.((?:[^.]+\.)*[^.]+)$} and return $2;
return;
}
sub typedAs {
my ($name,$newtype)=@_;
$name=~s{(^|/)((?:document|feed)\.[^.]+\.)((?:[^.]+\.)*[^.]+)$}{$1$2$newtype};
return $name;
}
sub dstUriFor {
my ($name,$short)=(@_,1);
DEBUG("dstUriFor($name,$short)");
if ($short) {
$name=~s{/[^/]+$}{/};
}
else {
$name=typedAs($name,'html');
}
$name=~s{^\Q$SRCPATH\E/}{$DSTBASEURL};
DEBUG("dstUriFor -> $name");
return $name;
}
sub srcXMLFor {
my ($lang,$path,$name)=@_;
$name="$name";
my $doc_name=$name;
$doc_name=~s{\.html$}{.du.xml};
$doc_name=~s{/$}{/document.$lang.du.xml};
if ($doc_name=~m{^\Q$DSTBASEURL\E}) {
$doc_name=~s{^\Q$DSTBASEURL\E}{$SRCPATH/};
}
else {
$doc_name=file($doc_name)->absolute(file($path)->parent)->relative($SRCPATH);
$doc_name="$SRCPATH/$doc_name";
}
return $doc_name;
}
sub isLang {
my ($lang,$name)=@_;
DEBUG("isLang($lang,$name)");
return 1 if $name=~m{/$};
return 1 if langOf($name) eq $lang;
return;
}
sub getTitleFor {
my ($fc,$lang,$path,$name)=@_;
DEBUG("getTitleFor($lang,$path,$name)");
my $doc_name=srcXMLFor($lang,$path,$name);
DEBUG("getTitleFor -> $doc_name");
my $doc=$fc->get($doc_name);
unless ($doc) {
LOGWARN("No document for <$doc_name>, returning <$name>");
return $name;
}
my $title=$xpath->findnodes(
q{/document/title},
$doc);
return $title;
}
{
my $zero=DateTime->from_epoch(epoch=>0);
sub getDatesFor {
my ($fc,$lang,$path,$name)=@_;
DEBUG("getDatesFor($lang,$path,$name)");
my $doc_name=srcXMLFor($lang,$path,$name);
my $doc=$fc->get($doc_name);
unless ($doc) {
LOGWARN("No document for <$doc_name>, returning <0>");
return {creation=>$zero,last_change=>$zero};
}
my ($creation_date)=map {$_->textContent}
$xpath->findnodes(
q{/document/docinfo/field[field_name='CreationDate']/field_body},
$doc);
$creation_date=DateTime::Format::DateParse->parse_datetime($creation_date)||$zero;
my $last_change=DateTime->from_epoch(epoch=>$fc->stat($doc_name)->mtime);
return {creation=>$creation_date,
last_change=>$last_change};
}
}
sub getDates {
my ($fc,@docs)=@_;
my %dates;
for my $doc_name (uniq(@docs)) {
my $xml_name=typedAs($doc_name,'du.xml');
my $doc=$fc->get($xml_name);
my ($creation_date)=map {$_->textContent}
$xpath->findnodes(
q{/document/docinfo/field[field_name='CreationDate']/field_body},
$doc);
$creation_date=DateTime::Format::DateParse->parse_datetime($creation_date);
my $last_change=DateTime->from_epoch(epoch=>
$fc->stat($doc_name)->mtime);
$dates{$doc_name}={creation=>$creation_date,
last_change=>$last_change};
}
return \%dates;
}
sub getTags {
my ($fc,@docs)=@_;
my %tagged;
for my $doc_name (uniq(@docs)) {
my $doc=$fc->get($doc_name);
my @tags=map {$_->textContent}
$xpath->findnodes(
q{/document/docinfo/field[field_name='tags']/field_body/*/list_item|/document/docinfo/field[field_name='tags']/field_body/paragraph},
$doc);
chomp for @tags;
push @{$tagged{$_}},$doc_name for @tags;
}
return \%tagged;
}
sub fromTo {
my ($base,$opts)=@_;
DEBUG("fromTo: $base,{@{[ %$opts ]}}");
my $iter=File::Next::files(
{
file_filter=>$opts->{files},
descend_filter=>$opts->{dirs},
},
$base);
my (@ret,$file);
if (defined $opts->{transform}) {
push @ret,$opts->{transform}->($file) while $file=$iter->();
}
else {
push @ret,$file while $file=$iter->();
}
DEBUG("fromTo: @ret");
return uniq(@ret);
}
{
my %order=(
'tt'=>0,
'rest.tt'=>0,
'rest.txt'=>1,
'xml'=>2,
'du.xml'=>2,
);
sub earliest {
my ($a,$b)=@_;
return $a unless $b;
return $order{$a} < $order{$b}
? $a
: $b;
}
sub keepEarliest {
my %dirs;
for my $f (@_) {
my $c=file($f);
my $lang=langOf($c->basename);
my $type=typeOf($c->basename);
if (!defined $lang or !defined $type) {
die "Weird document name <$f>";
}
$dirs{$c->parent}->{$lang}=earliest($type,$dirs{$c->parent}->{$lang});
}
my @ret;
while (my ($d,$langs)=each %dirs) {
while (my ($lang,$type)=each %$langs) {
push @ret,file($d,"document.$lang.$type")->stringify;
}
}
return uniq(@ret);
}
}
our %docfiles=(
files=>sub{m{^document\.}},
dirs=>sub{!m{^(tags$|_|\.)}});
our %feedfiles=(
files=>sub{m{^feed\.(?:[^.]+\.)+tt$}},
dirs=>sub{!m{^[_.]}});
1;