smeserver-manager/root/etc/e-smith/events/actions/navigation2-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 constant SMNGR_LIB => '/usr/share/smanager/lib';
use constant I18NMODULES => 'SrvMngr/I18N/Modules';
use constant WEBFUNCTIONS => 'SrvMngr/Controller';
use constant NAVDIR => '/home/e-smith/db';
use constant NAVIGATIONDIR => 'navigation2';
use constant DEBUG => 0;

use esmith::NavigationDB;
use esmith::I18N;

use Data::Dumper;	# activate if DEBUG

binmode(STDOUT, ":encoding(UTF-8)");

my $navigation_ignore = 
	"(\.\.?|Swttheme\.pm|Login\.pm|Request\.pm|Modules\.pm(-.*)?)";

my $i18n = new esmith::I18N;

my %navdbs;

opendir FUNCTIONS, SMNGR_LIB.'/'.WEBFUNCTIONS or 
    die "Couldn't open ", SMNGR_LIB.'/'.WEBFUNCTIONS, "\n";
my @files = grep (!/^${navigation_ignore}$/, readdir (FUNCTIONS));
closedir FUNCTIONS;

my @langs = $i18n->availableLanguages(); 
#my @langs = ('tr');  #Temp override


foreach my $lang (@langs)
{
	my $long_lex = SMNGR_LIB.'/'.I18NMODULES."/General/general_$lang.lex";
	next unless ( -e $long_lex );

	open(LEX, '<:encoding(UTF-8)', $long_lex)
		 or die "Couldn't open ", $long_lex, " for reading.\n";
	my @gen_lex = <LEX>;
	close LEX;

	#my @files = ('Portforwarding.pm');  #Temp override
	foreach my $file (@files)
	{
		next if (-d SMNGR_LIB.'/'.WEBFUNCTIONS . "/$file");
		#        next unless ( $file =~ m/D.*\.pm$/ );
			next unless ( $file =~ m/[A-Z].*\.pm$/ );

		my $file2 = lc($file);
		$file2 =~ s/\.pm$//;
		#-------------------------------------------------- 
		# extract heading, description and weight information
		# from Mojo controller
		#-------------------------------------------------- 
		open(SCRIPT, SMNGR_LIB.'/'.WEBFUNCTIONS . "/$file");
		my $heading            	= undef;
		my $description        	= undef;
		my $heading_weight     	= undef;
		my $description_weight 	= undef;
		my $menucat		= undef;
		my $routes		= 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*$/);
			$menucat = $1 
			if (/^\s*#\s*menu\s*:\s*(.+?)\s*$/);

			last if (defined $heading and 
			defined $description and
			defined $heading_weight and
			defined $description_weight and
			defined $menucat);

			# routes : end  (stop before eof if 'menu' is not here before 'routes'!!!
			$routes = $1 if (/^\s*#\s*routes\s*:\s*(.+?)\s*$/);
			last if (defined $routes and $routes eq 'end');
		}
		close SCRIPT;

		print "updating script $file for lang $lang\n"if DEBUG;
		my $navdb = $navdbs{$lang};
		my $navinfo = NAVDIR.'/'.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($file2) || 
			$navdb->new_record($file2, { type => 'panel' } );
		
		my @panel_lex = ();
		$long_lex = SMNGR_LIB.'/'.I18NMODULES.'/'.ucfirst($file2)."/${file2}_$lang.lex";
		if ( -e $long_lex ) {
			open(LEX, '<:encoding(UTF-8)', $long_lex)
				 or die "Couldn't open ", $long_lex, " for reading.\n";
			@panel_lex = <LEX>;
			close LEX;
		}
		#Extract the prefix for this module
		my @keys = values @panel_lex;  # Get all values from the array
		
		my $i = 0;                    # Initialize the index
		my $found = 0;                # Flag to check if the prefix was found
		my $prefix = "xx_";			  # Probably never match!!

		while ($i < @keys) {          # Loop until we run out of entries
			my $extracted_value = $keys[$i] || "";  # The current entry
			#print("Extracted val: ".$extracted_value."\n");

			# Extract prefix from the second value (up to and including the first underscore)
			#my ($prefix) = $second_value =~ /^'(.*?_)/;  # Match everything up to and including the first underscore
			($prefix) = $extracted_value =~ /^'(.*?_)/;  # Match everything up to and including the first underscore
			
			if (defined $prefix) {
				$found = 1;           # Set found flag to true
				last;                 # Exit the loop if prefix is found
			} else {
				#print("Extracted Val: " . $extracted_value . "\n");
			}

			$i++;                     # Increment the index to check the next entry
		}

		if (!$found) {
			print(STDERR "No valid prefix found in any entries: ".$file2." (".$lang.")\n"); # if DEBUG;
			$prefix = "xx_";			  # Probably never match!!
			
		}
		#print("Prefix: ".$prefix." ".$file2." (".$lang.")\n");
		
		my %Lexicon = ();
		push(@panel_lex, @gen_lex);
		my $top_error = 0;

		chomp @panel_lex;
		for (@panel_lex) {
			next unless $_;	# first one empty
			my ($k, $v) = split / => /, $_;
		#	errors on split to $v (use DEBUG to see)
			if ( $k and $v ) {
				$k =~ s/\'//g;
				$v =~ s/\'//g;
				$v =~ s/,$//g;
				$Lexicon{ lc($k) } = $v;
			} else {
				$k = "?" unless ($k);
				print STDERR "Error for $lang $file2 on $k \n" if DEBUG;
				$top_error++;
			}
		}
		if ( $top_error > 0) {
			if ( DEBUG ) {
				print STDERR "$top_error errors for $lang $file2\n";
				#		print Dumper(\@panel_lex);
				#		print Dumper(\%Lexicon);
				#		exit 1;
			}
		}
		$heading = "" unless defined $heading;
		$description = "" unless defined $description;
		# Get the base language code from $lang
		my $base_lang = (split('-', $lang))[0];
		my $loc_heading =  process_localization( \%Lexicon, $heading, $lang, $prefix );
		my $loc_description =  process_localization( \%Lexicon, $description, $lang, $prefix );
		$loc_heading =~ s/^\s*(\w.*?)\s*$/$1/;
		$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 ),
			MenuCat => (defined $menucat ? $menucat : 'A'));
	}
	#warn "trying to close for lang $lang\n";
	my $navdb = $navdbs{$lang};
	$navdb->close();
}


sub localise {
    my ($lexicon, $string) = @_;
    #print("Looking up:".$string."\n");
    $string  = "" unless defined $string;
    my $lc_string = lc($string);
    my $res = $lexicon->{$lc_string} || $string;
    #print("Returning:".$res."\n");
    return $res;
}

# Subroutine to process localization
sub process_localization {
    my ($lexicon_ref, $heading, $lang, $prefix) = @_;

    # Localized heading based on original heading
    my $loc_heading = localise($lexicon_ref, $heading);

    # Get the base language code from $lang
    my $base_lang = (split('-', $lang))[0];

    # Check the condition
    if ($loc_heading eq $heading && $base_lang ne 'en') {
        # Construct the new key by combining the prefix and the original heading
        my $key = $prefix . $heading;
        # Localize using the constructed key
        $loc_heading = localise($lexicon_ref, $key);
        # See if it got a hit
        if ($loc_heading eq $key){
			$loc_heading = $heading;
		}
    }
    
    return $loc_heading; # Optionally return the localized heading
}