step di split lingue per ReST

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

2 files changed, 80 insertions, 1 deletions

diff --git a/lib/WebCoso/Step/Base.pm b/lib/WebCoso/Step/Base.pm
index 6a21932..8e73705 100644
--- a/lib/WebCoso/Step/Base.pm
+++ b/lib/WebCoso/Step/Base.pm
@@ -3,6 +3,5 @@ use strict;
 use warnings;
 use Class::Std;
 use WebCoso::X;
-use WebCoso::Step;
 
 1;
diff --git a/lib/WebCoso/Step/ReST/SplitLang.pm b/lib/WebCoso/Step/ReST/SplitLang.pm
new file mode 100644
index 0000000..a24e55e
--- /dev/null
+++ b/lib/WebCoso/Step/ReST/SplitLang.pm
@@ -0,0 +1,80 @@
+package WebCoso::Step::ReST::SplitLang;
+use strict;
+use warnings;
+use base 'WebCoso::Step';
+use Class::Std;
+
+{
+
+=head2 Che fa
+
+Prende il sorgente da {filename=>'sperosiaunosolo'}->datastream, cerca
+righe della forma
+
+  ^\s*.. lang:: (\w*)
+
+raccoglie tutti i C<$1>, e quelle sono le lingue (C<''> sta per 'tutte
+le lingue')
+
+Splitta poi in {language=>'$1'}->rstdoc (stringhe)
+
+Fa tutto alla prima passata
+
+=cut
+
+my $lang_re=qr{^\s*\.\.\s+lang::(?:\s+(\w+))?\s*$};
+
+sub process {
+    my ($self,$resource,$stage)=@_;
+
+    return unless $stage eq 'meta';
+
+    my $fh=$resource->get_property('datastream');
+    if (!defined $fh) {
+        my ($filename)=$resource->get_axis_values('filename');
+        $fh=$resource->get_property({filename=>$filename},'datastream');
+    }
+
+    # raccolgo le lingue usate
+    my %langs=(''=>undef);
+    seek $fh,0,0;
+    while (my $line=<$fh>) {
+        if ($line =~ m{$lang_re}) {
+            $langs{$1||''}=undef;
+        }
+    }
+    delete $langs{''};
+    seek $fh,0,0;
+
+    if (%langs) { # multilingua: split!
+        my $curlang='';my %docs=();
+        while (my $line=<$fh>) {
+            if ($line =~ m{$lang_re}) {
+                $curlang=$1||'';
+                next;
+            }
+            if ($curlang) {
+                $docs{$curlang}.=$line;
+            }
+            else { # 'any', per cui scrivo su tutti
+                $docs{$_}.=$line for keys %langs;
+            }
+        }
+        # salvo
+        $resource->set_property({language=>$_},rstdoc=>$docs{$_})
+            for keys %langs;
+    }
+    else { # monolingua: cat
+        local $/;
+        $resource->set_property(rstdoc=> scalar <$fh>);
+    }
+
+    # rimetto a posto il filehandle
+    seek $fh,0,0;
+
+    return;
+}
+
+}
+
+1;