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® - 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    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® is a registered trademark of John Walker.
  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 sub print_it
  53 {
  54     foreach my $w (@_) {
  55         next if ($w eq '&nbsp;');
  56         next if ($w !~ /\w/);
  57         next if ($w =~ />/);
  58
  59         next if (exists $dict{$w});
  60         $dict{$w}=1;
  61
  62         # we add " at the begining and the end of the string
  63         $w =~ s/(^|$)/"/gm; # "
  64         print "msgid ", $w, "\n";
  65         print 'msgstr ""', "\n\n";
  66     }
  67 }
  68
  69 sub text {
  70     my ($self, $text) = @_;
  71
  72     # between <script>..</script> we take only "words"
  73     if ($in_script) {
  74         my @words = ($text =~ /"([\w\s]+)"/gs);
  75         print_it(@words);
  76         return;
  77     }
  78
  79     # just print out the original text
  80 #    $text =~ s/<\/?TMPL[^>]+>//gs;
  81
  82     # strip extra spaces
  83     $text =~ s/(^\s+)|(\s+$)//gs;
  84
  85     # skip some special cases
  86     return if ($text eq 'selected');
  87     print_it($text);
  88 }
  89
  90 sub start {
  91     my ($self, $tag, $attr, $attrseq, $origtext) = @_;
  92
  93     # On note qu'on se trouve dans un script
  94     # pour prendre que les chaines entre ""
  95     if ($tag eq 'script') {
  96         $in_script = 1;
  97     }
  98
  99     #return unless ($tag =~ /^(a|input|img)$/);
 100
 101     # liste des attributs a traduire
 102     if (defined $attr->{'title'}) {
 103         print_it($attr->{'title'});
 104     }
 105
 106     if (defined $attr->{'alt'}) {
 107         print_it($attr->{'alt'});
 108     }
 109 }
 110
 111 sub end {
 112     if ($in_script) {
 113         $in_script=0;
 114     }
 115 }
 116
 117 package main;
 118
 119 my $p = new TmplParser;
 120 for (my $f = shift ; $f and -f $f ; $f = shift) {
 121     #$TmplParser::nb=0;
 122     print "#============ $f ==========\n";
 123     $p->parse_file($f);
 124 }
 125