MakeMaker!

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

1 files changed, 0 insertions, 488 deletions

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