package WebCoso::Common;
use strict;
use warnings;
use File::Next;
use Path::Class;
use XML::LibXML::XPathContext;
use DateTime;
use DateTime::Format::DateParse;
our $SRCPATH='src';
our $DSTPATH='dst';
our $DSTBASEURL='/';
our @TMPLPATH=('common/');
my $xpath=XML::LibXML::XPathContext->new();
$xpath->registerNs('x', 'http://www.w3.org/1999/xhtml');
sub langOf {
my ($name)=@_;
$name=~m{(^|/)document\.([^.]+)(\.|$)} and return $2;
return;
}
sub typeOf {
my ($name)=@_;
$name=~m{(^|/)document\.[^.]+\.([^.]+\.[^.]+)$} and return $2;
return;
}
sub typedAs {
my ($name,$newtype)=@_;
$name=~s{(^|/)(document\.[^.]+\.)([^.]+\.[^.]+)$}{$1$2$newtype};
return $name;
}
sub dstUriFor {
my ($name,$short)=(@_,1);
warn "dstUriFor($name,$short)\n";
if ($short) {
$name=~s{/[^/]+$}{/};
}
else {
$name=typedAs($name,'html');
}
$name=~s{^\Q$SRCPATH\E/}{$DSTBASEURL};
return $name;
}
sub isLang {
my ($lang,$name)=@_;
warn "isLang($lang,$name)\n";
return 1 if $name=~m{/$};
return 1 if langOf($name) eq $lang;
return;
}
sub getTitleFor {
my ($fc,$lang,$path,$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";
}
warn "getTitleFor($lang,$path,$name)->$doc_name\n";
my $doc=$fc->get($doc_name);
unless ($doc) {
warn "No document for <$doc_name>, returning <$name>\n";
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)=@_;
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";
}
warn "getDatesFor($lang,$path,$name)->$doc_name\n";
my $doc=$fc->get($doc_name);
unless ($doc) {
warn "No document for <$doc_name>, returning <0>\n";
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 (@docs) {
my $doc=$fc->get($doc_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($doc->stat->mtime);
$dates{$doc_name}={creation=>$creation_date,
last_change=>$last_change};
}
return \%dates;
}
sub getTags {
my ($fc,@docs)=@_;
my %tagged;
for my $doc_name (@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)=@_;
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->();
}
return @ret;
}
{
my %order=(
'rest.tt'=>0,
'rest.txt'=>1,
'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 @ret;
}
}
our %docfiles=(
files=>sub{m{^document\.}},
dirs=>sub{!m{^(tags|_webcoso|\.svn)$}});
1;