r2490@narval: dakkar | 2007-07-07 11:44:04 +0200

 roba buttata qua


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

1 files changed, 131 insertions, 0 deletions

diff --git a/stest.pl b/stest.pl
new file mode 100644
index 0000000..c468c87
--- /dev/null
+++ b/stest.pl
@@ -0,0 +1,131 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use Slay::Maker;
+use File::Next;
+use Path::Class;
+
+sub expandTT {
+    my ($maker,$target,$deps,$matches)=@_;
+
+    print "TT: $target <- @$deps, @$matches\n";
+    open my $fh,'>',$target;
+}
+
+sub parseRST {
+    my ($maker,$target,$deps,$matches)=@_;
+
+    print "RST: $target <- @$deps, @$matches\n";
+    open my $fh,'>',$target;
+}
+
+sub du2html {
+    my ($maker,$target,$deps,$matches)=@_;
+
+    print "HTML: $target <- @$deps, @$matches\n";
+    open my $fh,'>',$target;
+}
+
+sub getTags {
+    my ($maker,$target,$deps,$matches)=@_;
+
+    print "tags: $target <- @$deps, @$matches\n";
+    open my $fh,'>',$target;
+}
+
+
+sub getChanges {
+    my ($maker,$target,$deps,$matches)=@_;
+
+    print "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=(
+    'document.rest.tt'=>0,
+    'document.rest.txt'=>1,
+    'document.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);
+        $dirs{$c->parent}=earliest($c->basename,$dirs{$c->parent});
+    }
+    my @ret;
+    while (my ($d,$f)=each %dirs) {
+        push @ret,file($d,$f)->stringify;
+    }
+    return @ret;
+}
+
+my %files=(files=>sub{m{^document\.}});
+
+my $maker=Slay::Maker->new({
+    rules => [
+        ['src/(**)/document.rest.txt',':',ifExists('src/$1/document.rest.tt'),'=',\&expandTT],
+        ['src/(**)/document.du.xml',':',ifExists('src/$1/document.rest.txt'),'=',\&parseRST],
+        ['deps/tags.xml',':',fromTo('src/',{%files,transform=>sub{my $s=shift;$s=~s{\..*$}{.du.xml};$s}}),'=',\&getTags],
+        ['deps/changes.xml',':',keepEarliest(fromTo('src/',{%files})),'=',\&getChanges],
+        ['dst/(**)/document.xhtml',':','deps/tags.xml','deps/changes.xml',ifExists('src/$1/document.du.xml'),'=',\&du2html],
+    ],
+    options => {
+        auto_create_dirs => 1,
+        #detect_no_diffs => 1,
+        #detect_no_size_change => 1,
+        #debug => 1,
+    },
+});
+
+my @targets=fromTo('src/',
+                   {
+                       %files,
+                       transform=>sub{
+                           my $src=shift;
+                           $src=~s{\..*$}{.xhtml};
+                           $src=~s{^src/}{dst/};
+                           return $src;
+                       },
+                   });
+
+print "targets: @targets\n";
+$maker->make(@targets);
+