e-smith-manager/root/etc/e-smith/events/actions/navigation-conf

#!/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;
}