#!/usr/bin/perl use strict; use locale; use POSIX; use Locale::gettext; my $tofile; if (exists $ENV{"HTTP_ACCEPT"}) { $tofile=0; } else { $tofile=1; } print "Content-Type: text/html \n\n" unless($tofile); my $path=$ENV{"PATH_TRANSLATED"}; textdomain("koha"); my @locale=`locale -a`; my %lang; foreach(@locale){ next unless (/_/); push @{$lang{$`}}, $'; } my $str_env=$ENV{"HTTP_ACCEPT_LANGUAGE"}; $str_env=~s/\s*//g; my @lang=split/,/,$str_env; my $lang="us_US"; foreach my $locale(@lang){ goto find_locale if ($locale eq 'en'); foreach my $lg(@{$lang{$locale}}){ setlocale(LC_MESSAGES,$locale."_".$lg); my $tmp = gettext($locale); if ($tmp ne $locale) { $lang=$tmp; goto find_locale; } } } find_locale: setlocale(LC_MESSAGES,$lang); my @katalog; my $plik; if ($tofile){ @katalog=`ls -R`; $plik=$ARGV[0]; if ($plik eq ''){ $plik="koha.gettext.c"; } } else { @katalog=("cos"); } my $kat; my (%dgettxt, %dane, %dane2, @dane2); my $i; $dgettxt{'iso-8859-1'}=1; $dgettxt{'us_US'}=1; my $txt =< TXT foreach(@katalog){ if (/:$/){ $kat="$`/"; next; } if ($tofile){ unless ($_=~/(\.html|\.inc)$/i) { next; } } print "$kat$_" if ($tofile); my $dane; { local $/; if ($tofile){ open PL, "$kat$_"; } else { open PL, "$path"; } $dane=; close PL; } $dane=~s//$txt/i; $dane=~s/%/&zamien/ges; # change % (specjal symbol) $dane=~s/\\\'/&zamien/ges; # change \' $dane=~s/\\\"/&zamien/ges; # change \" # take out graphics $dane=~s/[\"\']\/?([\w-\/\.]*?\.gif)[\"\']/&zamien($1)/ges; # $dane=~s/messenger\s*$(.*?)$\s*[\}\{;]/&zamien($1)/ges; # $dane=~s/\.write(ln)?\s*$(.*?)$\s*[\};]/&zamien($2)/ges; # take out string in field alt $dane=~s/alt\s*=\s*[\"]([^\"]*)[\"]/&zamien($1)/iges; $dane=~s/alt\s*=\s*[\']([^\']*)[\']/&zamien($1)/iges; $dane=~s//&zamien/ges; $dane=~s//&zamien/iges; $dane=~s/<[\w\/]\w*\s*((\w*\s*=\s*(\'[^\']*\'|\"[^\"]*\"|[\w-\/?&,\.=%#]*)|[%\d*%]|\w)\s*)*>/&zamien/ges; $dane=~s//&zamien/ges; $dane=~s/]*>/&zamien/ges; $dane=~s/<#.*?#>/&zamien/ges; my $dane2=$dane; $dane2=~s/(\s*%\d+%\s*)+/%/gs; $dane2=~s/^%//g; $dane2=~s/%$//g; foreach my $tmp(split/%/,$dane2){ my $tmp_ok = $tmp; $tmp_ok=~s/\s+/ /gs; next unless ($tmp_ok=~/\w+/); $dgettxt{$tmp_ok}++ unless $dgettxt{$tmp_ok}; $tmp=~s/([\)\(])/\\$1/g; $dane=~s/$tmp/gettext($tmp_ok)/es; } unless ($tofile){ while($dane=~/%\d+%/){ $dane=~s/%(\d+)%/$dane2{$1}/g; } print $dane; } } if ($tofile) { open PK, ">$plik"; foreach my $tmp(sort keys %dgettxt){ $tmp=~s/\"/\\\"/gs; print PK "gettext(\"$tmp\");\n"; } close PK; } exit; ########################################################### sub zamien { my $tmp = $&; unless ($dgettxt{$_[0]}) { $dgettxt{$_[0]}++; } $tmp=~s/$_[0]/gettext($&)/es; unless ($dane{$tmp}) { push @dane2, $tmp; $dane2{$i}=$tmp; $dane{$tmp}=$i++; } return "%${\($dane{$tmp})}%"; }