From 2cd6e7f426e4fa6d65f387d56f83226d4e399d12 Mon Sep 17 00:00:00 2001 From: dakkar Date: Thu, 3 Jan 2008 19:16:32 +0000 Subject: MakeMaker! git-svn-id: svn://luxion/repos/WebCoso/trunk@325 fcb26f47-9200-0410-b104-b98ab5b095f3 --- Makefile.PL | 9 + script/webcoso.pl | 488 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ t/whole-01.t | 8 +- webcoso.pl | 488 ------------------------------------------------------ 4 files changed, 502 insertions(+), 491 deletions(-) create mode 100644 Makefile.PL create mode 100644 script/webcoso.pl delete mode 100644 webcoso.pl diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..3ecfbbc --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,9 @@ +use ExtUtils::MakeMaker; + +WriteMakefile( + NAME => 'WebCoso', + VERSION_FROM => 'script/webcoso.pl', + ABSTRACT_FROM => 'script/webcoso.pl', + AUTHOR => 'dakkar@thenautilus.net', + EXE_FILES => ['script/webcoso.pl'], +); diff --git a/script/webcoso.pl b/script/webcoso.pl new file mode 100644 index 0000000..3552974 --- /dev/null +++ b/script/webcoso.pl @@ -0,0 +1,488 @@ +#!/usr/bin/perl +use strict; +use warnings; +use Slay::Maker; +use File::Next; +use Path::Class; +use Template; +use File::Cache::Parsed; +use Cwd 'abs_path'; +use Text::Restructured; +use Text::Restructured::Writer::LibXML; +use XML::LibXML; +use XML::LibXSLT; +use YAML::Syck; +use Getopt::Long; + +my $SRCPATH='src'; +my $DSTPATH='dst'; +my $DSTBASEURL='/'; +my @TMPLPATH=('common/'); +my $CLEAN=0; + +{ +my $res=GetOptions('src|s=s'=>\$SRCPATH, + 'dst|d=s'=>\$DSTPATH, + 'url|u=s'=>\$DSTBASEURL, + 'include|I=s'=>\@TMPLPATH, + 'clean'=>\$CLEAN, + ); +exit 1 unless $res; +$SRCPATH=~s{/+$}{}; +$DSTPATH=~s{/+$}{}; +$DSTBASEURL=~s{/*$}{/}; +} + +my $stash={}; +my $template_provider=Template::Provider->new({ + INCLUDE_PATH=> \@TMPLPATH, + ABSOLUTE=>1, + RELATIVE=>1, +}); +my $template=Template->new({ + LOAD_TEMPLATES=>[$template_provider], +}); + +my $rest=Text::Restructured->new( + { + D=>{ + 'file-insertion-enabled'=>0, # we use TT + generator=>0, + date=>0, + 'time'=>0, + 'source-link'=>0, + 'section-subtitles'=>1, + }, + }, + 'WebCoso'); + +my $xml_parser=XML::LibXML->new(); +my $xslt_proc=XML::LibXSLT->new(); +my $xpath=XML::LibXML::XPathContext->new(); +$xpath->registerNs('x', 'http://www.w3.org/1999/xhtml'); + +my $fc=File::Cache::Parsed->new(follow=>1); +$fc->add_parser(qr{\.tt2?$} => + sub { + $template->context->template($_[0]); + }); +$fc->add_parser(qr{\.rest\.txt$} => + sub { + my $dudom=$rest->Parse($_[1],$_[0]); + return Text::Restructured::Writer::LibXML + ->new->ProcessDOM($dudom); + }); +$fc->add_parser(qr{\.xml$} => + sub { $xml_parser->parse_string($_[1],$_[0]) }); +$fc->add_parser(qr{\.xslt?$} => + sub { $xslt_proc->parse_stylesheet + ($xml_parser->parse_string($_[1],$_[0])) }); +$fc->add_writer(qr{\.xml$} => + sub { $_[1]->toFile($_[0]) }); +$fc->add_parser(qr{\.ya?ml$} => + sub { Load($_[1]) }); +$fc->add_writer(qr{\.ya?ml$} => + sub { DumpFile($_[0],$_[1]) }); + +sub getTitleFor { + my ($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); # absolutize it + $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 $NS='http://webcoso.thenautilus.net/'; + +$xslt_proc->register_function($NS,'title-for',\&getTitleFor); + +{my $tags_source; +sub setXMLTagsSource {$tags_source=shift} +sub getTagsXML { + my $doc=XML::LibXML::Document->new(); + return $doc unless defined $tags_source; + + warn "getTagsXML()\n"; + + my $de=$doc->createElementNS($NS,'wc:tags'); + $doc->setDocumentElement($de); + my ($tagname,$doclist); + while (($tagname,$doclist)=each %$tags_source) { + my $te=$doc->createElementNS($NS,'wc:tag'); + $te->setAttribute('name',$tagname); + $de->appendChild($te); + my %docs; + push @{$docs{dstUriFor($_)}},langOf($_) for @$doclist; + my ($docurl,$langs); + while (($docurl,$langs)=each %docs) { + my $dle=$doc->createElementNS($NS,'wc:doc'); + $dle->setAttribute('uri',$docurl); + $te->appendChild($dle); + for my $lang (@$langs) { + my $le=$doc->createElementNS($NS,'wc:lang'); + $le->appendTextNode($lang); + $dle->appendChild($le); + } + } + } + return $doc; +} +} +$xslt_proc->register_function($NS,'tagged',\&getTagsXML); + +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{/$}; # assume that MultiViews on the server will work + return 1 if langOf($name) eq $lang; + return; +} + +$stash->{dstUriFor}=\&dstUriFor; +$stash->{isLang}=\&isLang; + +sub expandTT { + my ($maker,$target,$deps,$matches)=@_; + + warn "expandTT($target,@$deps,@$matches)\n"; + + my $tmpl=$fc->get($deps->[-1]); + my $vars={ path=> $matches->[0], + language => $matches->[1], + %$stash, + }; + if (@$deps>1) { + warn "tagging as $deps->[0]\n"; + $vars->{tagged}=$fc->get($deps->[0]); + } + push @{$template_provider->include_path}, + file($deps->[-1])->parent; + $fc->put($target, + $template->context->process($tmpl, + $vars)); + pop @{$template_provider->include_path}; +} + +sub parseRST { + my ($maker,$target,$deps,$matches)=@_; + + $fc->put($target,$fc->get($deps->[-1])); +} + +sub du2html { + my ($maker,$target,$deps,$matches)=@_; + + my $du=$fc->get($deps->[-1]); + my $xslt=file($deps->[-1])->parent->file('du2html.xsl'); + $xslt=$fc->get($xslt); + if (@$deps>1) { + warn "xml tagging as $deps->[0]\n"; + setXMLTagsSource($fc->get($deps->[0])); + } + else { + setXMLTagsSource(undef); + } + my $out=$xslt->transform($du, + XML::LibXSLT::xpath_to_string( + path => $matches->[0], + language => $matches->[1], + filename => $deps->[-1], + )); + $fc->put($target,$xslt->output_string($out)); +} + +sub getTags { + my ($maker,$target,$deps,$matches)=@_; + + my %tagged; + for my $doc_name (@$deps) { + my $doc=$fc->get($doc_name); + my @tags=map {$_->textContent} + $xpath->findnodes( + q{/document/docinfo/field[field_name='tags']/field_body/*/list_item}, + $doc); + chomp for @tags; + push @{$tagged{$_}},$doc_name for @tags; + } + $fc->put($target,\%tagged); +} + +sub getChanges { + my ($maker,$target,$deps,$matches)=@_; + + warn "changes: $target <- @$deps, @$matches\n"; + open my $fh,'>',$target; +} + +sub ifExists { + my ($src)=@_; + return sub { + my ($maker,$target,$matches)=@_; + my $dep=Slay::MakerRule::var_expand_dep($src,$target,$matches); + return if -e $target and ! -e $dep; + return $dep; + } +} + +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; +} +} + +my %docfiles=( + files=>sub{m{^document\.}}, + dirs=>sub{!m{^(tags|_webcoso|\.svn)$}}); + +if ($CLEAN) { + my %to_keep; + @to_keep{keepEarliest(fromTo($SRCPATH,{%docfiles,dirs=>sub{!m{^(_webcoso|\.svn)$}}}))}=(); + @to_keep{fromTo($SRCPATH,{files=>sub{!m{^document\.}},dirs=>sub{!m{^(_webcoso|\.svn)$}}})}=(); + + my $iter=File::Next::files({descend_filter=>sub{!m{^\.svn$}}},$SRCPATH,$DSTPATH); + while (defined (my $file=$iter->())) { + next if exists $to_keep{$file}; + unlink $file; + } + dir($DSTPATH)->rmtree; + dir($SRCPATH,'_webcoso')->rmtree; + exit 0; +} + +my %maker_opts=( + options => { + auto_create_dirs => 1, + #debug => 1, + }, +); + +my @passes=( + {maker=>Slay::Maker->new({ + rules => [ + + # tags : must come first, otherwise tha "tags" directory will + # be taken as a normal document directory + + ["$SRCPATH/tags/(**)/document.(*).rest.txt", + ':', + "$SRCPATH/_webcoso/tags.yml", + ifExists("$SRCPATH/tags/\$1/document.\$2.rest.tt"), + '=', + \&expandTT], + ["$SRCPATH/tags/(**)/document.(*).du.xml", + ':', + "$SRCPATH/_webcoso/tags.yml", + ifExists("$SRCPATH/tags/\$1/document.\$2.rest.txt"), + '=', + \&parseRST], + + # normal documents, in subdirs + + ["$SRCPATH/(**)/document.(*).rest.txt", + ':', + ifExists("$SRCPATH/\$1/document.\$2.rest.tt"), + '=', + \&expandTT], + ["$SRCPATH/(**)/document.(*).du.xml", + ':', + ifExists("$SRCPATH/\$1/document.\$2.rest.txt"), + '=', + \&parseRST], + + # normal documents, in top dir + + ["$SRCPATH/()document.(*).rest.txt", + ':', + ifExists("$SRCPATH/document.\$2.rest.tt"), + '=', + \&expandTT], + ["$SRCPATH/()document.(*).du.xml", + ':', + ifExists("$SRCPATH/document.\$2.rest.txt"), + '=', + \&parseRST], + + # tags from normal documents (tag documents can't be tagged!) + + ["$SRCPATH/_webcoso/tags.yml", + ':', + fromTo($SRCPATH, + { + %docfiles, + transform=>sub{typedAs($_[0],'du.xml')} + }), + '=', + \&getTags], + + # changes (currently unimplemented) + + ["$SRCPATH/_webcoso/changes.xml", + ':', + keepEarliest(fromTo($SRCPATH,{%docfiles})), + '=', + \&getChanges], + ], + %maker_opts, + }), + targets=>[ + fromTo("$SRCPATH/", + { + %docfiles, + transform=>sub{typedAs($_[0],'du.xml')}, + }), + fromTo("$SRCPATH/tags/", + { + %docfiles, + transform=>sub{typedAs($_[0],'du.xml')}, + })]}, + {maker=>Slay::Maker->new({ + rules => [ + + # tags : must come first, otherwise tha "tags" directory will + # be taken as a normal document directory + + ["$DSTPATH/tags/(**)/document.(*).html", + ':', + "$SRCPATH/_webcoso/tags.yml", + "$SRCPATH/tags/\$1/document.\$2.du.xml", + '=', + \&du2html], + + # normal documents, in subdirs + + ["$DSTPATH/(**)/document.(*).html", + ':', + "$SRCPATH/_webcoso/tags.yml", + "$SRCPATH/\$1/document.\$2.du.xml", + '=', + \&du2html], + + # normal documents, in top dir + + ["$DSTPATH/()document.(*).html", + ':', + "$SRCPATH/_webcoso/tags.yml", + "$SRCPATH/document.\$2.du.xml", + '=', + \&du2html], + ], + %maker_opts, + }), + targets=>[fromTo("$SRCPATH/", + { + %docfiles, + transform=>sub{ + (my $file=typedAs($_[0],'html')) + =~s{^\Q$SRCPATH\E/}{$DSTPATH/}; + return $file; + }, + }), + fromTo("$SRCPATH/tags/", + { + %docfiles, + transform=>sub{ + (my $file=typedAs($_[0],'html')) + =~s{^\Q$SRCPATH\E/tags/}{$DSTPATH/tags/}; + return $file; + }, + })]}, +); + +$_->{maker}->make(@{$_->{targets}}) for @passes; + diff --git a/t/whole-01.t b/t/whole-01.t index 10c9204..054d2ee 100644 --- a/t/whole-01.t +++ b/t/whole-01.t @@ -6,13 +6,15 @@ use Path::Class; chdir file(__FILE__)->parent->parent->stringify; -system($^X,qw(-Ilib webcoso.pl -s t/test-site/src/ -d t/test-site/output/ -I t/test-site/common/ --clean)) +$ENV{PERL5LIB}=join ':',@INC; + +system($^X,qw(blib/script/webcoso.pl -s t/test-site/src/ -d t/test-site/output/ -I t/test-site/common/ --clean)) and die "Problems running webcoso.pl (clean): $?\n"; -system($^X,qw(-Ilib webcoso.pl -s t/test-site/src/ -d t/test-site/output/ -I t/test-site/common/)) +system($^X,qw(blib/script/webcoso.pl -s t/test-site/src/ -d t/test-site/output/ -I t/test-site/common/)) and die "Problems running webcoso.pl: $?\n"; is(system(qw(diff -r -x .svn t/test-site/output/ t/test-site-output/)),0,'output as expected'); -system($^X,qw(-Ilib webcoso.pl -s t/test-site/src/ -d t/test-site/output/ -I t/test-site/common/ --clean)) +system($^X,qw(blib/script/webcoso.pl -s t/test-site/src/ -d t/test-site/output/ -I t/test-site/common/ --clean)) and die "Problems running webcoso.pl (clean): $?\n"; diff --git a/webcoso.pl b/webcoso.pl deleted file mode 100644 index 3552974..0000000 --- a/webcoso.pl +++ /dev/null @@ -1,488 +0,0 @@ -#!/usr/bin/perl -use strict; -use warnings; -use Slay::Maker; -use File::Next; -use Path::Class; -use Template; -use File::Cache::Parsed; -use Cwd 'abs_path'; -use Text::Restructured; -use Text::Restructured::Writer::LibXML; -use XML::LibXML; -use XML::LibXSLT; -use YAML::Syck; -use Getopt::Long; - -my $SRCPATH='src'; -my $DSTPATH='dst'; -my $DSTBASEURL='/'; -my @TMPLPATH=('common/'); -my $CLEAN=0; - -{ -my $res=GetOptions('src|s=s'=>\$SRCPATH, - 'dst|d=s'=>\$DSTPATH, - 'url|u=s'=>\$DSTBASEURL, - 'include|I=s'=>\@TMPLPATH, - 'clean'=>\$CLEAN, - ); -exit 1 unless $res; -$SRCPATH=~s{/+$}{}; -$DSTPATH=~s{/+$}{}; -$DSTBASEURL=~s{/*$}{/}; -} - -my $stash={}; -my $template_provider=Template::Provider->new({ - INCLUDE_PATH=> \@TMPLPATH, - ABSOLUTE=>1, - RELATIVE=>1, -}); -my $template=Template->new({ - LOAD_TEMPLATES=>[$template_provider], -}); - -my $rest=Text::Restructured->new( - { - D=>{ - 'file-insertion-enabled'=>0, # we use TT - generator=>0, - date=>0, - 'time'=>0, - 'source-link'=>0, - 'section-subtitles'=>1, - }, - }, - 'WebCoso'); - -my $xml_parser=XML::LibXML->new(); -my $xslt_proc=XML::LibXSLT->new(); -my $xpath=XML::LibXML::XPathContext->new(); -$xpath->registerNs('x', 'http://www.w3.org/1999/xhtml'); - -my $fc=File::Cache::Parsed->new(follow=>1); -$fc->add_parser(qr{\.tt2?$} => - sub { - $template->context->template($_[0]); - }); -$fc->add_parser(qr{\.rest\.txt$} => - sub { - my $dudom=$rest->Parse($_[1],$_[0]); - return Text::Restructured::Writer::LibXML - ->new->ProcessDOM($dudom); - }); -$fc->add_parser(qr{\.xml$} => - sub { $xml_parser->parse_string($_[1],$_[0]) }); -$fc->add_parser(qr{\.xslt?$} => - sub { $xslt_proc->parse_stylesheet - ($xml_parser->parse_string($_[1],$_[0])) }); -$fc->add_writer(qr{\.xml$} => - sub { $_[1]->toFile($_[0]) }); -$fc->add_parser(qr{\.ya?ml$} => - sub { Load($_[1]) }); -$fc->add_writer(qr{\.ya?ml$} => - sub { DumpFile($_[0],$_[1]) }); - -sub getTitleFor { - my ($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); # absolutize it - $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 $NS='http://webcoso.thenautilus.net/'; - -$xslt_proc->register_function($NS,'title-for',\&getTitleFor); - -{my $tags_source; -sub setXMLTagsSource {$tags_source=shift} -sub getTagsXML { - my $doc=XML::LibXML::Document->new(); - return $doc unless defined $tags_source; - - warn "getTagsXML()\n"; - - my $de=$doc->createElementNS($NS,'wc:tags'); - $doc->setDocumentElement($de); - my ($tagname,$doclist); - while (($tagname,$doclist)=each %$tags_source) { - my $te=$doc->createElementNS($NS,'wc:tag'); - $te->setAttribute('name',$tagname); - $de->appendChild($te); - my %docs; - push @{$docs{dstUriFor($_)}},langOf($_) for @$doclist; - my ($docurl,$langs); - while (($docurl,$langs)=each %docs) { - my $dle=$doc->createElementNS($NS,'wc:doc'); - $dle->setAttribute('uri',$docurl); - $te->appendChild($dle); - for my $lang (@$langs) { - my $le=$doc->createElementNS($NS,'wc:lang'); - $le->appendTextNode($lang); - $dle->appendChild($le); - } - } - } - return $doc; -} -} -$xslt_proc->register_function($NS,'tagged',\&getTagsXML); - -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{/$}; # assume that MultiViews on the server will work - return 1 if langOf($name) eq $lang; - return; -} - -$stash->{dstUriFor}=\&dstUriFor; -$stash->{isLang}=\&isLang; - -sub expandTT { - my ($maker,$target,$deps,$matches)=@_; - - warn "expandTT($target,@$deps,@$matches)\n"; - - my $tmpl=$fc->get($deps->[-1]); - my $vars={ path=> $matches->[0], - language => $matches->[1], - %$stash, - }; - if (@$deps>1) { - warn "tagging as $deps->[0]\n"; - $vars->{tagged}=$fc->get($deps->[0]); - } - push @{$template_provider->include_path}, - file($deps->[-1])->parent; - $fc->put($target, - $template->context->process($tmpl, - $vars)); - pop @{$template_provider->include_path}; -} - -sub parseRST { - my ($maker,$target,$deps,$matches)=@_; - - $fc->put($target,$fc->get($deps->[-1])); -} - -sub du2html { - my ($maker,$target,$deps,$matches)=@_; - - my $du=$fc->get($deps->[-1]); - my $xslt=file($deps->[-1])->parent->file('du2html.xsl'); - $xslt=$fc->get($xslt); - if (@$deps>1) { - warn "xml tagging as $deps->[0]\n"; - setXMLTagsSource($fc->get($deps->[0])); - } - else { - setXMLTagsSource(undef); - } - my $out=$xslt->transform($du, - XML::LibXSLT::xpath_to_string( - path => $matches->[0], - language => $matches->[1], - filename => $deps->[-1], - )); - $fc->put($target,$xslt->output_string($out)); -} - -sub getTags { - my ($maker,$target,$deps,$matches)=@_; - - my %tagged; - for my $doc_name (@$deps) { - my $doc=$fc->get($doc_name); - my @tags=map {$_->textContent} - $xpath->findnodes( - q{/document/docinfo/field[field_name='tags']/field_body/*/list_item}, - $doc); - chomp for @tags; - push @{$tagged{$_}},$doc_name for @tags; - } - $fc->put($target,\%tagged); -} - -sub getChanges { - my ($maker,$target,$deps,$matches)=@_; - - warn "changes: $target <- @$deps, @$matches\n"; - open my $fh,'>',$target; -} - -sub ifExists { - my ($src)=@_; - return sub { - my ($maker,$target,$matches)=@_; - my $dep=Slay::MakerRule::var_expand_dep($src,$target,$matches); - return if -e $target and ! -e $dep; - return $dep; - } -} - -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; -} -} - -my %docfiles=( - files=>sub{m{^document\.}}, - dirs=>sub{!m{^(tags|_webcoso|\.svn)$}}); - -if ($CLEAN) { - my %to_keep; - @to_keep{keepEarliest(fromTo($SRCPATH,{%docfiles,dirs=>sub{!m{^(_webcoso|\.svn)$}}}))}=(); - @to_keep{fromTo($SRCPATH,{files=>sub{!m{^document\.}},dirs=>sub{!m{^(_webcoso|\.svn)$}}})}=(); - - my $iter=File::Next::files({descend_filter=>sub{!m{^\.svn$}}},$SRCPATH,$DSTPATH); - while (defined (my $file=$iter->())) { - next if exists $to_keep{$file}; - unlink $file; - } - dir($DSTPATH)->rmtree; - dir($SRCPATH,'_webcoso')->rmtree; - exit 0; -} - -my %maker_opts=( - options => { - auto_create_dirs => 1, - #debug => 1, - }, -); - -my @passes=( - {maker=>Slay::Maker->new({ - rules => [ - - # tags : must come first, otherwise tha "tags" directory will - # be taken as a normal document directory - - ["$SRCPATH/tags/(**)/document.(*).rest.txt", - ':', - "$SRCPATH/_webcoso/tags.yml", - ifExists("$SRCPATH/tags/\$1/document.\$2.rest.tt"), - '=', - \&expandTT], - ["$SRCPATH/tags/(**)/document.(*).du.xml", - ':', - "$SRCPATH/_webcoso/tags.yml", - ifExists("$SRCPATH/tags/\$1/document.\$2.rest.txt"), - '=', - \&parseRST], - - # normal documents, in subdirs - - ["$SRCPATH/(**)/document.(*).rest.txt", - ':', - ifExists("$SRCPATH/\$1/document.\$2.rest.tt"), - '=', - \&expandTT], - ["$SRCPATH/(**)/document.(*).du.xml", - ':', - ifExists("$SRCPATH/\$1/document.\$2.rest.txt"), - '=', - \&parseRST], - - # normal documents, in top dir - - ["$SRCPATH/()document.(*).rest.txt", - ':', - ifExists("$SRCPATH/document.\$2.rest.tt"), - '=', - \&expandTT], - ["$SRCPATH/()document.(*).du.xml", - ':', - ifExists("$SRCPATH/document.\$2.rest.txt"), - '=', - \&parseRST], - - # tags from normal documents (tag documents can't be tagged!) - - ["$SRCPATH/_webcoso/tags.yml", - ':', - fromTo($SRCPATH, - { - %docfiles, - transform=>sub{typedAs($_[0],'du.xml')} - }), - '=', - \&getTags], - - # changes (currently unimplemented) - - ["$SRCPATH/_webcoso/changes.xml", - ':', - keepEarliest(fromTo($SRCPATH,{%docfiles})), - '=', - \&getChanges], - ], - %maker_opts, - }), - targets=>[ - fromTo("$SRCPATH/", - { - %docfiles, - transform=>sub{typedAs($_[0],'du.xml')}, - }), - fromTo("$SRCPATH/tags/", - { - %docfiles, - transform=>sub{typedAs($_[0],'du.xml')}, - })]}, - {maker=>Slay::Maker->new({ - rules => [ - - # tags : must come first, otherwise tha "tags" directory will - # be taken as a normal document directory - - ["$DSTPATH/tags/(**)/document.(*).html", - ':', - "$SRCPATH/_webcoso/tags.yml", - "$SRCPATH/tags/\$1/document.\$2.du.xml", - '=', - \&du2html], - - # normal documents, in subdirs - - ["$DSTPATH/(**)/document.(*).html", - ':', - "$SRCPATH/_webcoso/tags.yml", - "$SRCPATH/\$1/document.\$2.du.xml", - '=', - \&du2html], - - # normal documents, in top dir - - ["$DSTPATH/()document.(*).html", - ':', - "$SRCPATH/_webcoso/tags.yml", - "$SRCPATH/document.\$2.du.xml", - '=', - \&du2html], - ], - %maker_opts, - }), - targets=>[fromTo("$SRCPATH/", - { - %docfiles, - transform=>sub{ - (my $file=typedAs($_[0],'html')) - =~s{^\Q$SRCPATH\E/}{$DSTPATH/}; - return $file; - }, - }), - fromTo("$SRCPATH/tags/", - { - %docfiles, - transform=>sub{ - (my $file=typedAs($_[0],'html')) - =~s{^\Q$SRCPATH\E/tags/}{$DSTPATH/tags/}; - return $file; - }, - })]}, -); - -$_->{maker}->make(@{$_->{targets}}) for @passes; - -- cgit v1.2.3