translator/translator.pl

   1 #!/usr/bin/perl
   2
   3
   4 # Copyright 2000-2002 Katipo Communications
   5 #
   6 # This file is part of Koha.
   7 #
   8 # Koha is free software; you can redistribute it and/or modify it under the
   9 # terms of the GNU General Public License as published by the Free Software
  10 # Foundation; either version 2 of the License, or (at your option) any later
  11 # version.
  12 #
  13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  15 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License along with
  18 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  19 # Suite 330, Boston, MA  02111-1307 USA
  20
  21 use strict;
  22
  23 use locale;
  24 use POSIX;
  25 use Locale::gettext;
  26
  27 my $tofile;
  28 if (exists $ENV{"HTTP_ACCEPT"}) {
  29   $tofile=0;
  30 } else {
  31   $tofile=1;
  32 }
  33
  34
  35 print "Content-Type: text/html\r\n\n" unless($tofile);
  36
  37 my $path=$ENV{"PATH_TRANSLATED"};
  38
  39 textdomain("koha");
  40
  41 my @locale=`locale -a`;
  42 my %lang;
  43 foreach(@locale){
  44   next unless (/_/);
  45   push @{$lang{$`}}, $';
  46 }
  47
  48 my $str_env=$ENV{"HTTP_ACCEPT_LANGUAGE"};
  49 $str_env=~s/\s*//g;
  50 my @lang=split/,/,$str_env;
  51 my $lang="us_US";
  52
  53 foreach my $locale(@lang){
  54   goto find_locale if ($locale eq 'en');
  55   foreach my $lg(@{$lang{$locale}}){
  56     setlocale(LC_MESSAGES,$locale."_".$lg);
  57     my $tmp = gettext($locale);
  58     if ($tmp ne $locale)
  59     {
  60       $lang=$tmp;
  61       goto find_locale;
  62     }
  63   }
  64 }
  65
  66 find_locale:
  67 setlocale(LC_MESSAGES,$lang);
  68
  69 my @katalog;
  70 my $plik;
  71
  72 if ($tofile){
  73
  74   @katalog=`ls -R`;
  75
  76   $plik=$ARGV[0];
  77   if ($plik eq ''){
  78     $plik="koha.gettext.c";
  79   }
  80
  81 } else {
  82   @katalog=("cos");
  83 }
  84
  85 my $kat;
  86 my (%dgettxt, %dane, %dane2, @dane2);
  87 my $i;
  88
  89 $dgettxt{'iso-8859-1'}=1;
  90 $dgettxt{'us_US'}=1;
  91
  92 my $txt =<<TXT;
  93 <HTML>
  94 <META http-equiv=Content-Type content="text/thml;
  95     charset=${\(gettext('iso-8859-1'))}">
  96 TXT
  97
  98 foreach(@katalog){
  99
 100   if (/:$/){
 101     $kat="$`/";
 102     next;
 103   }
 104
 105   if ($tofile){
 106     unless ($_=~/(\.html|\.inc)$/i) {
 107       next;
 108     }
 109   }
 110
 111   print "$kat$_" if ($tofile);
 112
 113   my $dane;
 114   {
 115     local $/;
 116     if ($tofile){
 117       open PL, "$kat$_";
 118     } else {
 119       open PL, "$path";
 120     }
 121     $dane=<PL>;
 122     close PL;
 123   }
 124
 125
 126   $dane=~s/<html>/$txt/i;
 127
 128   $dane=~s/%/&zamien/ges;               # change %      (specjal symbol)
 129   $dane=~s/\\\'/&zamien/ges;            # change \'
 130   $dane=~s/\\\"/&zamien/ges;            # change \"
 131
 132   # take out graphics
 133   $dane=~s/[\"\']\/?([\w-\/\.]*?\.gif)[\"\']/&zamien($1)/ges;
 134
 135 #  $dane=~s/messenger\s*\((.*?)\)\s*[\}\{;]/&zamien($1)/ges;
 136 #  $dane=~s/\.write(ln)?\s*\((.*?)\)\s*[\};]/&zamien($2)/ges;
 137
 138   # take out string in field alt
 139   $dane=~s/alt\s*=\s*[\"]([^\"]*)[\"]/&zamien($1)/iges;
 140   $dane=~s/alt\s*=\s*[\']([^\']*)[\']/&zamien($1)/iges;
 141
 142   $dane=~s/<!--.*?-->/&zamien/ges;
 143   $dane=~s/<script.*?<\/script>/&zamien/iges;
 144
 145   $dane=~s/<[\w\/]\w*\s*((\w*\s*=\s*(\'[^\']*\'|\"[^\"]*\"|[\w-\/?&,\.=%#]*)|[%\d*%]|\w)\s*)*>/&zamien/ges;
 146   $dane=~s/<!\[.*?\]>/&zamien/ges;
 147   $dane=~s/<![^>]*>/&zamien/ges;
 148   $dane=~s/<#.*?#>/&zamien/ges;
 149
 150   my $dane2=$dane;
 151   $dane2=~s/(\s*%\d+%\s*)+/%/gs;
 152   $dane2=~s/^%//g;
 153   $dane2=~s/%$//g;
 154   foreach my $tmp(split/%/,$dane2){
 155     my $tmp_ok = $tmp;
 156     $tmp_ok=~s/\s+/ /gs;
 157     next unless ($tmp_ok=~/\w+/);
 158     $dgettxt{$tmp_ok}++ unless $dgettxt{$tmp_ok};
 159     $tmp=~s/([\)\(])/\\$1/g;
 160     $dane=~s/$tmp/gettext($tmp_ok)/es;
 161   }
 162   unless ($tofile){
 163     while($dane=~/%\d+%/){
 164       $dane=~s/%(\d+)%/$dane2{$1}/g;
 165     }
 166     print $dane;
 167   }
 168 }
 169
 170 if ($tofile) {
 171
 172   open PK, ">$plik";
 173   foreach my $tmp(sort keys %dgettxt){
 174      $tmp=~s/\"/\\\"/gs;
 175      print PK "gettext(\"$tmp\");\n";
 176   }
 177   close PK;
 178 }
 179
 180 exit;
 181
 182 ###########################################################
 183
 184 sub zamien {
 185     my $tmp = $&;
 186     unless ($dgettxt{$_[0]}) {
 187         $dgettxt{$_[0]}++;
 188     }
 189     $tmp=~s/$_[0]/gettext($&)/es;
 190     unless ($dane{$tmp}) {
 191         push @dane2, $tmp;
 192         $dane2{$i}=$tmp;
 193         $dane{$tmp}=$i++;
 194     }
 195     return "%${\($dane{$tmp})}%";
 196 }