lib/WebCoso/Common.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
88
89
90
91
92
93
94
95

package WebCoso::Common; 
use strict;
use warnings;
use Path::Class;
use XML::LibXML::XPathContext;
 
our $SRCPATH='src';
our $DSTPATH='dst';
our $DSTBASEURL='/';
 
my $xpath=XML::LibXML::XPathContext->new();
$xpath->registerNs('x', 'http://www.w3.org/1999/xhtml');
 
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;
}
 
sub getTitleFor {
    my ($fc,$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;
}
 
sub getTags {
    my ($fc,@docs)=@_;
 
    my %tagged;
    for my $doc_name (@docs) {
        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;
    }
    return \%tagged;
}
 
1;