git.sur5r.net Git - bacula/bacula/blob - gui/bweb/script/tpl_extract_msg.pl

   1 #!/usr/bin/perl -w
   2 use strict;
   3
   4 =head1 LICENSE
   5
   6    Bweb - A Bacula web interface
   7    Bacula\81Â\81® - The Network Backup Solution
   8
   9    Copyright (C) 2000-2006 Free Software Foundation Europe e.V.
  10
  11    The main author of Bweb is Eric Bollengier.
  12    The main author of Bacula is Kern Sibbald, with contributions from
  13    many others, a complete list can be found in the file AUTHORS.
  14
  15    This program is Free Software; you can redistribute it and/or
  16    modify it under the terms of version two of the GNU General Public
  17    License as published by the Free Software Foundation plus additions
  18    that are listed in the file LICENSE.
  19
  20    This program is distributed in the hope that it will be useful, but
  21    WITHOUT ANY WARRANTY; without even the implied warranty of
  22    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  23    Affero General Public License for more details.
  24
  25    You should have received a copy of the GNU General Public License
  26    along with this program; if not, write to the Free Software
  27    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  28    02110-1301, USA.
  29
  30    Bacula\81Â\81® is a registered trademark of Kern Sibbald.
  31    The licensor of Bacula is the Free Software Foundation Europe
  32    (FSFE), Fiduciary Program, Sumatrastrasse 25, 8006 Zurich,
  33    Switzerland, email:ftf@fsfeurope.org.
  34
  35 =head1 INFORMATIONS
  36
  37     This script is used to extract strings from tpl files
  38
  39 =head1 VERSION
  40
  41     $Id$
  42
  43 =cut
  44
  45 package TmplParser;
  46 use base "HTML::Parser";
  47 use HTML::Parser;
  48 use Locale::PO;
  49 my $in_script;
  50
  51 my %dict;
  52 my $l=0;
  53 my $file;
  54
  55 sub init_fp
  56 {
  57     open(FP, "|sort -n") ;
  58 }
  59
  60 sub print_it
  61 {
  62     foreach my $w (@_) {
  63 #       print "<$w\n";
  64         next if ($w eq '&nbsp;');
  65         next if ($w !~ /\w/);
  66         next if ($w =~ />/);
  67         next if ($w eq 'checked');
  68 #       print "$w>\n";
  69         next if (exists $dict{$w});
  70         $dict{$w}=1;
  71
  72         # we add " at the begining and the end of the string
  73         #$w =~ s/'/\\'/gm; # "
  74         #print "s\@(?!value='|_)$w\@\$1_${w}_\@g;\n";
  75         #print "s!(${w})([^a-zA-Z0-9]|\$)!__\$1__\$2!g;\n";
  76         print "$w\n";
  77     }
  78 }
  79
  80 sub text {
  81     my ($self, $text) = @_;
  82
  83     # between <script>..</script> we take only "words"
  84     if ($in_script) {
  85         my @words = ($text =~ /"([\w\s\81é\81è\81à\81ç\81û\81ô\81ö\81ü\81ï\81î\81ù!?]+)"/gs);
  86         print_it(@words);
  87         return;
  88     }
  89
  90     # just print out the original text
  91 #    $text =~ s/<\/?TMPL[^>]+>//gs;
  92
  93     # strip extra spaces
  94     $text =~ s/(^\s+)|(\s+$)//gs;
  95
  96     # skip some special cases
  97     return if ($text eq 'selected');
  98     print_it($text);
  99 }
 100
 101 sub start {
 102     my ($self, $tag, $attr, $attrseq, $origtext) = @_;
 103
 104     # On note qu'on se trouve dans un script
 105     # pour prendre que les chaines entre ""
 106     if ($tag eq 'script') {
 107         $in_script = 1;
 108     }
 109
 110     #return unless ($tag =~ /^(a|input|img)$/);
 111
 112     # liste des attributs a traduire
 113     if (defined $attr->{'title'}) {
 114         print_it($attr->{'title'});
 115     }
 116
 117     if (defined $attr->{'alt'}) {
 118         print_it($attr->{'alt'});
 119     }
 120 }
 121
 122 sub end {
 123     if ($in_script) {
 124         $in_script=0;
 125     }
 126 }
 127
 128 sub finish_fp
 129 {
 130     close(FP);
 131 }
 132 1;
 133
 134 package main;
 135
 136 my $p = new TmplParser;
 137 $p->init_fp();
 138 for (my $f = shift ; $f and -f $f ; $f = shift) {
 139     #$TmplParser::nb=0;
 140 #    print "#============ $f ==========\n";
 141     $file = $f;
 142     $file =~ s!.*?/([\w\d]+).tpl$!$1!;
 143     $p->parse_file($f); $l=0;
 144 }
 145 $p->finish_fp();
 146 #print "s/value='__([^']+)__'/value='\$1'/g;\n";