154 lines
4.8 KiB
Perl
Executable File
154 lines
4.8 KiB
Perl
Executable File
#!/usr/bin/perl -w
|
|
|
|
#----------------------------------------------------------------------
|
|
# copyright (C) 1999-2006 Mitel Networks Corporation
|
|
#
|
|
# This program is free software; you can redistribute it and/or modify
|
|
# it under the terms of the GNU General Public License as published by
|
|
# the Free Software Foundation; either version 2 of the License, or
|
|
# (at your option) any later version.
|
|
#
|
|
# This program is distributed in the hope that it will be useful,
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
# GNU General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU General Public License
|
|
# along with this program; if not, write to the Free Software
|
|
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
|
#
|
|
#----------------------------------------------------------------------
|
|
package esmith;
|
|
|
|
use strict;
|
|
|
|
use esmith::NavigationDB;
|
|
use esmith::I18N;
|
|
|
|
use constant WEBFUNCTIONS => '/etc/e-smith/web/functions';
|
|
use constant NAVIGATIONDIR => '/home/e-smith/db/navigation';
|
|
use constant NEW_NAVDIR => '/home/e-smith/db';
|
|
|
|
my $navigation_ignore =
|
|
"(\.\.?|navigation|noframes|online-manual|(internal|pleasewait)(-.*)?)";
|
|
|
|
my $i18n = new esmith::I18N;
|
|
|
|
my %navdbs;
|
|
|
|
opendir FUNCTIONS, WEBFUNCTIONS or
|
|
die "Couldn't open ", WEBFUNCTIONS, "\n";
|
|
|
|
my @files = grep (!/^${navigation_ignore}$/, readdir (FUNCTIONS));
|
|
my @langs = $i18n->availableLanguages();
|
|
|
|
use XML::Parser;
|
|
my $parser = new XML::Parser (Style => 'Tree',
|
|
ProtocolEncoding => 'UTF-8');
|
|
|
|
foreach my $file (@files)
|
|
{
|
|
next if (-d WEBFUNCTIONS . "/$file");
|
|
next unless (-x WEBFUNCTIONS . "/$file");
|
|
|
|
#--------------------------------------------------
|
|
# extract heading, description and weight information
|
|
# from CGI script
|
|
#--------------------------------------------------
|
|
open(SCRIPT, WEBFUNCTIONS . "/$file");
|
|
my $heading = undef;
|
|
my $description = undef;
|
|
my $heading_weight = undef;
|
|
my $description_weight = undef;
|
|
while ( <SCRIPT> )
|
|
{
|
|
$heading = $1 if (/^\s*#\s*heading\s*:\s*(.+?)\s*$/);
|
|
|
|
$description = $1
|
|
if (/^\s*#\s*description\s*:\s*(.+?)\s*$/);
|
|
|
|
($heading_weight, $description_weight) = ($1, $2)
|
|
if (/^\s*#\s*navigation\s*:\s*(\d+?)\s+(\d+?)\s*$/);
|
|
|
|
last if (defined $heading and
|
|
defined $description and
|
|
defined $heading_weight and
|
|
defined $description_weight);
|
|
}
|
|
close SCRIPT;
|
|
foreach my $lang (@langs)
|
|
{
|
|
#warn "updating script $file for lang $lang\n";
|
|
my $navdb = $navdbs{$lang};
|
|
my $navinfo = NAVIGATIONDIR . "/navigation.$lang";
|
|
$navdb ||= esmith::NavigationDB->open($navinfo);
|
|
$navdb ||= esmith::NavigationDB->create($navinfo) or
|
|
die "Couldn't create $navinfo\n";
|
|
$navdbs{$lang} ||= $navdb;
|
|
my $rec = $navdb->get($file) ||
|
|
$navdb->new_record($file, { type => 'panel' } );
|
|
|
|
my $lexicon = {};
|
|
|
|
foreach my $lfile ( "/etc/e-smith/locale/$lang/FormMagick/general",
|
|
"/etc/e-smith/locale/$lang/etc/e-smith/web/functions/$file" )
|
|
{
|
|
if (-f $lfile)
|
|
{
|
|
# Do a quick and dirty parse of the lexicon file
|
|
my $xmlstr = "";
|
|
open(FILE, $lfile) or die "Couldn't open $lfile:\n$!";
|
|
binmode(FILE, ":utf8");
|
|
{
|
|
local $^W = 0;
|
|
while ( my $line = <FILE> ) {
|
|
unless ( utf8::valid($line) ) {
|
|
warn "$lfile not in UTF-8 format\n";
|
|
utf8::encode($line);
|
|
}
|
|
$xmlstr .= $line;
|
|
}
|
|
}
|
|
my $xml = $parser->parsestring($xmlstr);
|
|
my @lexicon = @{$xml->[1]};
|
|
shift @lexicon; # Remove lexicon attributes
|
|
while (@lexicon)
|
|
{
|
|
my ($tag, $data) = splice(@lexicon, 0, 2);
|
|
next unless $tag eq 'entry';
|
|
my %entry_hash = ('attributes', @$data);
|
|
my $base = $entry_hash{base};
|
|
$base = @{$base}[2];
|
|
my $trans = $entry_hash{trans};
|
|
$trans = @{$trans}[2];
|
|
next unless defined $base && defined $trans;
|
|
$lexicon->{$base} = $trans;
|
|
}
|
|
}
|
|
}
|
|
|
|
my $loc_heading = localise($lexicon, $heading);
|
|
$loc_heading =~ s/^\s*(\w.*?)\s*$/$1/;
|
|
my $loc_description = localise($lexicon, $description);
|
|
$loc_description =~ s/^\s*(\w.*?)\s*$/$1/;
|
|
$rec->merge_props(
|
|
Heading => $loc_heading,
|
|
Description => $loc_description,
|
|
HeadingWeight => localise($lexicon, $heading_weight),
|
|
DescriptionWeight => localise($lexicon, $description_weight));
|
|
}
|
|
}
|
|
foreach my $lang (@langs)
|
|
{
|
|
#warn "trying to close for lang $lang\n";
|
|
my $navdb = $navdbs{$lang};
|
|
$navdb->close();
|
|
}
|
|
|
|
sub localise {
|
|
my ($lexicon, $string) = @_;
|
|
$string = "" unless defined $string;
|
|
return $lexicon->{$string} || $string;
|
|
}
|
|
|