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