#!/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;
my %lexicon_cache = ();  # Cache for lexicons to avoid reprocessing
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) {
    # Process lexicons only once per language and cache them
    my $lexicon = get_lexicon_for_language($lang);
    next unless defined $lexicon;

    #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');
        } ## end while (<SCRIPT>)
        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' });
        
        # Get the lexicon for this specific file
        my $file_lexicon = get_file_lexicon($lexicon, $file2, $lang);
        
        # Extract prefix for this module
        my $prefix = extract_prefix($file_lexicon);
        
        $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($file_lexicon, $heading,     $lang, $prefix);
        my $loc_description = process_localization($file_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($file_lexicon, $heading_weight),
            DescriptionWeight => localise($file_lexicon, $description_weight),
            MenuCat           => (defined $menucat ? $menucat : 'A')
        );
    } ## end foreach my $file (@files)

    #warn "trying to close for lang $lang\n";
    my $navdb = $navdbs{$lang};
    $navdb->close();
} ## end foreach my $lang (@langs)

# Subroutine to get lexicon for a specific language
sub get_lexicon_for_language {
    my ($lang) = @_;
    
    # Check if we've already processed this language's lexicons
    return $lexicon_cache{$lang} if exists $lexicon_cache{$lang};
    
    my $long_lex = SMNGR_LIB . '/' . I18NMODULES . "/General/general_$lang.lex";
    return undef 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;
    
    # Process the lexicon data and store in cache
    my %lexicon = ();
    chomp @gen_lex;
    for (@gen_lex) {
        next unless $_;     # first one empty
        
        # Remove comments and trailing whitespace first
        $_ =~ s/\s*#.*$//;
        $_ =~ s/\s+$//;

        # Split on => but be careful about quoted strings
        my ($k, $v);
        my @parts = split / => /, $_, 2;  # Limit to 2 parts
        if (@parts == 2) {
            ($k, $v) = @parts;
            
            # Parse key and value with comprehensive quote handling
            ($k) = parse_advanced_quoted_string($k);
            ($v) = parse_advanced_quoted_string($v);
            
            $v =~ s/,$//;  # Remove trailing comma
            
            # Additional safety check for empty values
            if ($k && $v) {
                $lexicon{ lc($k) } = $v;
            } else {
                print STDERR "Error for $lang on key='$k', value='$v' \n" if DEBUG;
            }
        } else {
            # If we don't have exactly 2 parts, it's a malformed line
            print STDERR "Error for $lang on malformed line: $_ \n" if DEBUG;
        }
    }
    
    # Cache the lexicon for this language
    $lexicon_cache{$lang} = \%lexicon;
    return \%lexicon;
}

# Subroutine to get lexicon for a specific file
sub get_file_lexicon {
    my ($base_lexicon, $file2, $lang) = @_;
    
    # Get the panel-specific lexicon
    my $long_lex = SMNGR_LIB . '/' . I18NMODULES . '/' . ucfirst($file2) . "/${file2}_$lang.lex";
    my @panel_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;
    }
    
    # Merge base lexicon with panel lexicon
    my %file_lexicon = %$base_lexicon;
    chomp @panel_lex;
    for (@panel_lex) {
        next unless $_;     # first one empty
        
        # Remove comments and trailing whitespace first
        $_ =~ s/\s*#.*$//;
        $_ =~ s/\s+$//;

        # Split on => but be careful about quoted strings
        my ($k, $v);
        my @parts = split / => /, $_, 2;  # Limit to 2 parts
        if (@parts == 2) {
            ($k, $v) = @parts;
            
            # Parse key and value with comprehensive quote handling
            ($k) = parse_advanced_quoted_string($k);
            ($v) = parse_advanced_quoted_string($v);
            
            $v =~ s/,$//;  # Remove trailing comma
            
            # Additional safety check for empty values
            if ($k && $v) {
                $file_lexicon{ lc($k) } = $v;
            } else {
                print STDERR "Error for $lang $file2 on key='$k', value='$v' \n" if DEBUG;
            }
        } else {
            # If we don't have exactly 2 parts, it's a malformed line
            print STDERR "Error for $lang $file2 on malformed line: $_ \n" if DEBUG;
        }
    }
    
    return \%file_lexicon;
}

# Subroutine to extract prefix from lexicon
sub extract_prefix {
    my ($lexicon) = @_;
    
    # Get all values from the lexicon
    my @keys = values %$lexicon;    # 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

        # Extract prefix from the value (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
        }
        $i++;                                          # Increment the index to check the next entry
    }

    if (!$found) {
        #print(STDERR "No valid prefix found in any entries\n");    # if DEBUG;
        $prefix = "xx_";    # Probably never match!!
    }

    return $prefix;
}

# Enhanced helper function for advanced quote handling
sub parse_advanced_quoted_string {
    my ($str) = @_;
    
    # Remove leading/trailing whitespace
    $str =~ s/^\s+|\s+$//g;
    
    # Handle empty string case
    return "" if !$str || $str eq "";
    
    # Check what type of quotes are used (single or double)
    my $quote_char = substr($str, 0, 1);
    
    # If first character is not a quote, return as-is
    return $str unless ($quote_char eq "'" || $quote_char eq '"');
    
    # Check if string starts and ends with the same quote type
    my $last_quote_pos = rindex($str, $quote_char);
    return $str if $last_quote_pos <= 0;  # No closing quote
    
    # Extract content between quotes
    my $content = substr($str, 1, $last_quote_pos - 1);
    
    # Handle escaped quotes within the string (more sophisticated approach)
    # This handles cases like: 'He said \'Hello\' to me'
    if ($quote_char eq "'") {
        # Remove backslash-escaped quotes
        $content =~ s/\\(['"])/$1/g;
    } elsif ($quote_char eq '"') {
        # Remove backslash-escaped quotes  
        $content =~ s/\\(['"])/$1/g;
    }
    
    return $content;
}

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;
} ## end sub localise

# Subroutine to process localization
# Tries the raw heading first, and if no hit, then adds the prefix and tries again.
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;
        }
    } ## end if ($loc_heading eq $heading...)
    return $loc_heading;    # Optionally return the localized heading
} ## end sub process_localization
