lib/WebCoso/Step/ReST/SplitLang.pm


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87

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 %srckey_of :ATTR(:init_arg<from> :get<srckey> :default<datastream>);
my %dstkey_of :ATTR(:init_arg<to> :get<dstkey> :default<rstdoc>);
 
my $lang_re=qr{^\s*\.\.\s+lang::(?:\s+(\w+))?\s*$};
 
sub process {
    my ($self,$resource,$stage)=@_;
 
    return unless $stage eq 'meta';
 
    my $srckey=$self->get_srckey();
    my $dstkey=$self->get_dstkey();
 
    my $fh=$resource->get_property_fh($srckey);
    if (!defined $fh) {
        my ($filename)=$resource->get_axis_values('filename');
        $fh=$resource->get_property_fh({filename=>$filename},$srckey);
    }
 
    binmode $fh,':utf8';
 
    # 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=>$_},$dstkey=>$docs{$_})
            for keys %langs;
    }
    else { # monolingua: passa il filehandle 
        $resource->set_property($dstkey=>$fh);
    }
 
    # rimetto a posto il filehandle 
    seek $fh,0,0;
 
    return;
}
 
}
 
1;