MakeMaker!

git-svn-id: svn://luxion/repos/WebCoso/trunk@325 fcb26f47-9200-0410-b104-b98ab5b095f3

1 files changed, 488 insertions, 0 deletions

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;
+