translator/translator.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4
   5 use locale;
   6 use POSIX;
   7 use Locale::gettext;
   8
   9 my $tofile;
  10 if (exists $ENV{"HTTP_ACCEPT"}) {
  11   $tofile=0;
  12 } else {
  13   $tofile=1;
  14 }
  15
  16
  17 print "Content-Type: text/html\r\n\n" unless($tofile);
  18
  19 my $path=$ENV{"PATH_TRANSLATED"};
  20
  21 textdomain("koha");
  22
  23 my @locale=`locale -a`;
  24 my %lang;
  25 foreach(@locale){
  26   next unless (/_/);
  27   push @{$lang{$`}}, $';
  28 }
  29
  30 my $str_env=$ENV{"HTTP_ACCEPT_LANGUAGE"};
  31 $str_env=~s/\s*//g;
  32 my @lang=split/,/,$str_env;
  33 my $lang="us_US";
  34
  35 foreach my $locale(@lang){
  36   goto find_locale if ($locale eq 'en');
  37   foreach my $lg(@{$lang{$locale}}){
  38     setlocale(LC_MESSAGES,$locale."_".$lg);
  39     my $tmp = gettext($locale);
  40     if ($tmp ne $locale)
  41     {
  42       $lang=$tmp;
  43       goto find_locale;
  44     }
  45   }
  46 }
  47
  48 find_locale:
  49 setlocale(LC_MESSAGES,$lang);
  50
  51 my @katalog;
  52 my $plik;
  53
  54 if ($tofile){
  55
  56   @katalog=`ls -R`;
  57
  58   $plik=$ARGV[0];
  59   if ($plik eq ''){
  60     $plik="koha.gettext.c";
  61   }
  62
  63 } else {
  64   @katalog=("cos");
  65 }
  66
  67 my $kat;
  68 my (%dgettxt, %dane, %dane2, @dane2);
  69 my $i;
  70
  71 $dgettxt{'iso-8859-1'}=1;
  72 $dgettxt{'us_US'}=1;
  73
  74 my $txt =<<TXT;
  75 <HTML>
  76 <META http-equiv=Content-Type content="text/thml;
  77     charset=${\(gettext('iso-8859-1'))}">
  78 TXT
  79
  80 foreach(@katalog){
  81
  82   if (/:$/){
  83     $kat="$`/";
  84     next;
  85   }
  86
  87   if ($tofile){
  88     unless ($_=~/(\.html|\.inc)$/i) {
  89       next;
  90     }
  91   }
  92
  93   print "$kat$_" if ($tofile);
  94
  95   my $dane;
  96   {
  97     local $/;
  98     if ($tofile){
  99       open PL, "$kat$_";
 100     } else {
 101       open PL, "$path";
 102     }
 103     $dane=<PL>;
 104     close PL;
 105   }
 106
 107
 108   $dane=~s/<html>/$txt/i;
 109
 110   $dane=~s/%/&zamien/ges;               # change %      (specjal symbol)
 111   $dane=~s/\\\'/&zamien/ges;            # change \'
 112   $dane=~s/\\\"/&zamien/ges;            # change \"
 113
 114   # take out graphics
 115   $dane=~s/[\"\']\/?([\w-\/\.]*?\.gif)[\"\']/&zamien($1)/ges;
 116
 117 #  $dane=~s/messenger\s*\((.*?)\)\s*[\}\{;]/&zamien($1)/ges;
 118 #  $dane=~s/\.write(ln)?\s*\((.*?)\)\s*[\};]/&zamien($2)/ges;
 119
 120   # take out string in field alt
 121   $dane=~s/alt\s*=\s*[\"]([^\"]*)[\"]/&zamien($1)/iges;
 122   $dane=~s/alt\s*=\s*[\']([^\']*)[\']/&zamien($1)/iges;
 123
 124   $dane=~s/<!--.*?-->/&zamien/ges;
 125   $dane=~s/<script.*?<\/script>/&zamien/iges;
 126
 127   $dane=~s/<[\w\/]\w*\s*((\w*\s*=\s*(\'[^\']*\'|\"[^\"]*\"|[\w-\/?&,\.=%#]*)|[%\d*%]|\w)\s*)*>/&zamien/ges;
 128   $dane=~s/<!\[.*?\]>/&zamien/ges;
 129   $dane=~s/<![^>]*>/&zamien/ges;
 130   $dane=~s/<#.*?#>/&zamien/ges;
 131
 132   my $dane2=$dane;
 133   $dane2=~s/(\s*%\d+%\s*)+/%/gs;
 134   $dane2=~s/^%//g;
 135   $dane2=~s/%$//g;
 136   foreach my $tmp(split/%/,$dane2){
 137     my $tmp_ok = $tmp;
 138     $tmp_ok=~s/\s+/ /gs;
 139     next unless ($tmp_ok=~/\w+/);
 140     $dgettxt{$tmp_ok}++ unless $dgettxt{$tmp_ok};
 141     $tmp=~s/([\)\(])/\\$1/g;
 142     $dane=~s/$tmp/gettext($tmp_ok)/es;
 143   }
 144   unless ($tofile){
 145     while($dane=~/%\d+%/){
 146       $dane=~s/%(\d+)%/$dane2{$1}/g;
 147     }
 148     print $dane;
 149   }
 150 }
 151
 152 if ($tofile) {
 153
 154   open PK, ">$plik";
 155   foreach my $tmp(sort keys %dgettxt){
 156      $tmp=~s/\"/\\\"/gs;
 157      print PK "gettext(\"$tmp\");\n";
 158   }
 159   close PK;
 160 }
 161
 162 exit;
 163
 164 ###########################################################
 165
 166 sub zamien {
 167     my $tmp = $&;
 168     unless ($dgettxt{$_[0]}) {
 169         $dgettxt{$_[0]}++;
 170     }
 171     $tmp=~s/$_[0]/gettext($&)/es;
 172     unless ($dane{$tmp}) {
 173         push @dane2, $tmp;
 174         $dane2{$i}=$tmp;
 175         $dane{$tmp}=$i++;
 176     }
 177     return "%${\($dane{$tmp})}%";
 178 }