* Wed Jan 15 2025 Brian Read <brianr@koozali.org> 11.0.0-40.sme

- Comment out missing prefix message in navigation2-conf action and re-format it with perltidy [SME: 127672]
This commit is contained in:
Brian Read 2025-01-15 11:41:22 +00:00
parent c1915a722b
commit be49419eba
3 changed files with 170 additions and 175 deletions

View File

@ -0,0 +1 @@
-pbp -nst -nse -l=120 -ce -csc -pt=2 -kbl=0 -mbl=1 -lbl=1

View File

@ -1,5 +1,4 @@
#!/usr/bin/perl -w #!/usr/bin/perl -w
#---------------------------------------------------------------------- #----------------------------------------------------------------------
# copyright (C) 1999-2006 Mitel Networks Corporation # copyright (C) 1999-2006 Mitel Networks Corporation
# #
@ -20,56 +19,43 @@
#---------------------------------------------------------------------- #----------------------------------------------------------------------
package esmith; package esmith;
use strict; use strict;
use constant SMNGR_LIB => '/usr/share/smanager/lib'; use constant SMNGR_LIB => '/usr/share/smanager/lib';
use constant I18NMODULES => 'SrvMngr/I18N/Modules'; use constant I18NMODULES => 'SrvMngr/I18N/Modules';
use constant WEBFUNCTIONS => 'SrvMngr/Controller'; use constant WEBFUNCTIONS => 'SrvMngr/Controller';
use constant NAVDIR => '/home/e-smith/db'; use constant NAVDIR => '/home/e-smith/db';
use constant NAVIGATIONDIR => 'navigation2'; use constant NAVIGATIONDIR => 'navigation2';
use constant DEBUG => 0; use constant DEBUG => 0;
use esmith::NavigationDB; use esmith::NavigationDB;
use esmith::I18N; use esmith::I18N;
use Data::Dumper; # activate if DEBUG use Data::Dumper; # activate if DEBUG
binmode(STDOUT, ":encoding(UTF-8)"); binmode(STDOUT, ":encoding(UTF-8)");
my $navigation_ignore = "(\.\.?|Swttheme\.pm|Login\.pm|Request\.pm|Modules\.pm(-.*)?)";
my $navigation_ignore =
"(\.\.?|Swttheme\.pm|Login\.pm|Request\.pm|Modules\.pm(-.*)?)";
my $i18n = new esmith::I18N; my $i18n = new esmith::I18N;
my %navdbs; my %navdbs;
opendir FUNCTIONS, SMNGR_LIB . '/' . WEBFUNCTIONS
opendir FUNCTIONS, SMNGR_LIB.'/'.WEBFUNCTIONS or or die "Couldn't open ", SMNGR_LIB . '/' . WEBFUNCTIONS, "\n";
die "Couldn't open ", SMNGR_LIB.'/'.WEBFUNCTIONS, "\n";
my @files = grep (!/^${navigation_ignore}$/, readdir(FUNCTIONS)); my @files = grep (!/^${navigation_ignore}$/, readdir(FUNCTIONS));
closedir FUNCTIONS; closedir FUNCTIONS;
my @langs = $i18n->availableLanguages(); my @langs = $i18n->availableLanguages();
#my @langs = ('tr'); #Temp override #my @langs = ('tr'); #Temp override
foreach my $lang (@langs) {
foreach my $lang (@langs)
{
my $long_lex = SMNGR_LIB . '/' . I18NMODULES . "/General/general_$lang.lex"; my $long_lex = SMNGR_LIB . '/' . I18NMODULES . "/General/general_$lang.lex";
next unless (-e $long_lex); next unless (-e $long_lex);
open(LEX, '<:encoding(UTF-8)', $long_lex) open(LEX, '<:encoding(UTF-8)', $long_lex)
or die "Couldn't open ", $long_lex, " for reading.\n"; or die "Couldn't open ", $long_lex, " for reading.\n";
my @gen_lex = <LEX>; my @gen_lex = <LEX>;
close LEX; close LEX;
#my @files = ('Portforwarding.pm'); #Temp override #my @files = ('Portforwarding.pm'); #Temp override
foreach my $file (@files) foreach my $file (@files) {
{
next if (-d SMNGR_LIB . '/' . WEBFUNCTIONS . "/$file"); next if (-d SMNGR_LIB . '/' . WEBFUNCTIONS . "/$file");
# next unless ( $file =~ m/D.*\.pm$/ ); # next unless ( $file =~ m/D.*\.pm$/ );
next unless ($file =~ m/[A-Z].*\.pm$/); next unless ($file =~ m/[A-Z].*\.pm$/);
my $file2 = lc($file); my $file2 = lc($file);
$file2 =~ s/\.pm$//; $file2 =~ s/\.pm$//;
#-------------------------------------------------- #--------------------------------------------------
# extract heading, description and weight information # extract heading, description and weight information
# from Mojo controller # from Mojo controller
@ -82,8 +68,7 @@ foreach my $lang (@langs)
my $menucat = undef; my $menucat = undef;
my $routes = undef; my $routes = undef;
while ( <SCRIPT> ) while (<SCRIPT>) {
{
$heading = $1 if (/^\s*#\s*heading\s*:\s*(.+?)\s*$/); $heading = $1 if (/^\s*#\s*heading\s*:\s*(.+?)\s*$/);
$description = $1 $description = $1
if (/^\s*#\s*description\s*:\s*(.+?)\s*$/); if (/^\s*#\s*description\s*:\s*(.+?)\s*$/);
@ -91,40 +76,39 @@ foreach my $lang (@langs)
if (/^\s*#\s*navigation\s*:\s*(\d+?)\s+(\d+?)\s*$/); if (/^\s*#\s*navigation\s*:\s*(\d+?)\s+(\d+?)\s*$/);
$menucat = $1 $menucat = $1
if (/^\s*#\s*menu\s*:\s*(.+?)\s*$/); if (/^\s*#\s*menu\s*:\s*(.+?)\s*$/);
last
last if (defined $heading and if (defined $heading
defined $description and and defined $description
defined $heading_weight and and defined $heading_weight
defined $description_weight and and defined $description_weight
defined $menucat); and defined $menucat);
# routes : end (stop before eof if 'menu' is not here before 'routes'!!! # routes : end (stop before eof if 'menu' is not here before 'routes'!!!
$routes = $1 if (/^\s*#\s*routes\s*:\s*(.+?)\s*$/); $routes = $1 if (/^\s*#\s*routes\s*:\s*(.+?)\s*$/);
last if (defined $routes and $routes eq 'end'); last if (defined $routes and $routes eq 'end');
} } ## end while (<SCRIPT>)
close SCRIPT; close SCRIPT;
print "updating script $file for lang $lang\n" if DEBUG; print "updating script $file for lang $lang\n" if DEBUG;
my $navdb = $navdbs{$lang}; my $navdb = $navdbs{$lang};
my $navinfo = NAVDIR . '/' . NAVIGATIONDIR . "/navigation.$lang"; my $navinfo = NAVDIR . '/' . NAVIGATIONDIR . "/navigation.$lang";
$navdb ||= esmith::NavigationDB->open($navinfo); $navdb ||= esmith::NavigationDB->open($navinfo);
$navdb ||= esmith::NavigationDB->create($navinfo) or $navdb ||= esmith::NavigationDB->create($navinfo)
die "Couldn't create $navinfo\n"; or die "Couldn't create $navinfo\n";
$navdbs{$lang} ||= $navdb; $navdbs{$lang} ||= $navdb;
my $rec = $navdb->get($file2) || my $rec = $navdb->get($file2)
$navdb->new_record($file2, { type => 'panel' } ); || $navdb->new_record($file2, { type => 'panel' });
my @panel_lex = (); my @panel_lex = ();
$long_lex = SMNGR_LIB . '/' . I18NMODULES . '/' . ucfirst($file2) . "/${file2}_$lang.lex"; $long_lex = SMNGR_LIB . '/' . I18NMODULES . '/' . ucfirst($file2) . "/${file2}_$lang.lex";
if (-e $long_lex) { if (-e $long_lex) {
open(LEX, '<:encoding(UTF-8)', $long_lex) open(LEX, '<:encoding(UTF-8)', $long_lex)
or die "Couldn't open ", $long_lex, " for reading.\n"; or die "Couldn't open ", $long_lex, " for reading.\n";
@panel_lex = <LEX>; @panel_lex = <LEX>;
close LEX; close LEX;
} } ## end if (-e $long_lex)
#Extract the prefix for this module #Extract the prefix for this module
my @keys = values @panel_lex; # Get all values from the array my @keys = values @panel_lex; # Get all values from the array
my $i = 0; # Initialize the index my $i = 0; # Initialize the index
my $found = 0; # Flag to check if the prefix was found my $found = 0; # Flag to check if the prefix was found
my $prefix = "xx_"; # Probably never match!! my $prefix = "xx_"; # Probably never match!!
@ -141,27 +125,27 @@ foreach my $lang (@langs)
$found = 1; # Set found flag to true $found = 1; # Set found flag to true
last; # Exit the loop if prefix is found last; # Exit the loop if prefix is found
} else { } else {
#print("Extracted Val: " . $extracted_value . "\n"); #print("Extracted Val: " . $extracted_value . "\n");
} }
$i++; # Increment the index to check the next entry $i++; # Increment the index to check the next entry
} } ## end while ($i < @keys)
if (!$found) { if (!$found) {
print(STDERR "No valid prefix found in any entries: ".$file2." (".$lang.")\n"); # if DEBUG; #print(STDERR "No valid prefix found in any entries: " . $file2 . " (" . $lang . ")\n"); # if DEBUG;
$prefix = "xx_"; # Probably never match!! $prefix = "xx_"; # Probably never match!!
} }
#print("Prefix: ".$prefix." ".$file2." (".$lang.")\n");
#print("Prefix: ".$prefix." ".$file2." (".$lang.")\n");
my %Lexicon = (); my %Lexicon = ();
push(@panel_lex, @gen_lex); push(@panel_lex, @gen_lex);
my $top_error = 0; my $top_error = 0;
chomp @panel_lex; chomp @panel_lex;
for (@panel_lex) { for (@panel_lex) {
next unless $_; # first one empty next unless $_; # first one empty
my ($k, $v) = split / => /, $_; my ($k, $v) = split / => /, $_;
# errors on split to $v (use DEBUG to see) # errors on split to $v (use DEBUG to see)
if ($k and $v) { if ($k and $v) {
$k =~ s/\'//g; $k =~ s/\'//g;
@ -173,46 +157,51 @@ foreach my $lang (@langs)
print STDERR "Error for $lang $file2 on $k \n" if DEBUG; print STDERR "Error for $lang $file2 on $k \n" if DEBUG;
$top_error++; $top_error++;
} }
} } ## end for (@panel_lex)
if ($top_error > 0) { if ($top_error > 0) {
if (DEBUG) { if (DEBUG) {
print STDERR "$top_error errors for $lang $file2\n"; print STDERR "$top_error errors for $lang $file2\n";
# print Dumper(\@panel_lex); # print Dumper(\@panel_lex);
# print Dumper(\%Lexicon); # print Dumper(\%Lexicon);
# exit 1; # exit 1;
} } ## end if (DEBUG)
} } ## end if ($top_error > 0)
$heading = "" unless defined $heading; $heading = "" unless defined $heading;
$description = "" unless defined $description; $description = "" unless defined $description;
# Get the base language code from $lang # Get the base language code from $lang
my $base_lang = (split('-', $lang))[0]; my $base_lang = (split('-', $lang))[0];
my $loc_heading = process_localization(\%Lexicon, $heading, $lang, $prefix); my $loc_heading = process_localization(\%Lexicon, $heading, $lang, $prefix);
my $loc_description = process_localization(\%Lexicon, $description, $lang, $prefix); my $loc_description = process_localization(\%Lexicon, $description, $lang, $prefix);
$loc_heading =~ s/^\s*(\w.*?)\s*$/$1/; $loc_heading =~ s/^\s*(\w.*?)\s*$/$1/;
$loc_description =~ s/^\s*(\w.*?)\s*$/$1/; $loc_description =~ s/^\s*(\w.*?)\s*$/$1/;
$rec->merge_props( $rec->merge_props(
Heading => $loc_heading, Heading => $loc_heading,
Description => $loc_description, Description => $loc_description,
HeadingWeight => localise(\%Lexicon, $heading_weight), HeadingWeight => localise(\%Lexicon, $heading_weight),
DescriptionWeight => localise(\%Lexicon, $description_weight), DescriptionWeight => localise(\%Lexicon, $description_weight),
MenuCat => (defined $menucat ? $menucat : 'A')); MenuCat => (defined $menucat ? $menucat : 'A')
} );
} ## end foreach my $file (@files)
#warn "trying to close for lang $lang\n"; #warn "trying to close for lang $lang\n";
my $navdb = $navdbs{$lang}; my $navdb = $navdbs{$lang};
$navdb->close(); $navdb->close();
} } ## end foreach my $lang (@langs)
sub localise { sub localise {
my ($lexicon, $string) = @_; my ($lexicon, $string) = @_;
#print("Looking up:".$string."\n"); #print("Looking up:".$string."\n");
$string = "" unless defined $string; $string = "" unless defined $string;
my $lc_string = lc($string); my $lc_string = lc($string);
my $res = $lexicon->{$lc_string} || $string; my $res = $lexicon->{$lc_string} || $string;
#print("Returning:".$res."\n"); #print("Returning:".$res."\n");
return $res; return $res;
} } ## end sub localise
# Subroutine to process localization # Subroutine to process localization
sub process_localization { sub process_localization {
@ -226,15 +215,17 @@ sub process_localization {
# Check the condition # Check the condition
if ($loc_heading eq $heading && $base_lang ne 'en') { if ($loc_heading eq $heading && $base_lang ne 'en') {
# Construct the new key by combining the prefix and the original heading # Construct the new key by combining the prefix and the original heading
my $key = $prefix . $heading; my $key = $prefix . $heading;
# Localize using the constructed key # Localize using the constructed key
$loc_heading = localise($lexicon_ref, $key); $loc_heading = localise($lexicon_ref, $key);
# See if it got a hit # See if it got a hit
if ($loc_heading eq $key) { if ($loc_heading eq $key) {
$loc_heading = $heading; $loc_heading = $heading;
} }
} } ## end if ($loc_heading eq $heading...)
return $loc_heading; # Optionally return the localized heading return $loc_heading; # Optionally return the localized heading
} } ## end sub process_localization

View File

@ -2,7 +2,7 @@ Summary: Sme server navigation module : manager 2
%define name smeserver-manager %define name smeserver-manager
Name: %{name} Name: %{name}
%define version 11.0.0 %define version 11.0.0
%define release 39 %define release 40
Version: %{version} Version: %{version}
Release: %{release}%{?dist} Release: %{release}%{?dist}
License: GPL License: GPL
@ -115,6 +115,9 @@ true
%defattr(-,root,root) %defattr(-,root,root)
%changelog %changelog
* Wed Jan 15 2025 Brian Read <brianr@koozali.org> 11.0.0-40.sme
- Comment out missing prefix message in navigation2-conf action and re-format it with perltidy [SME: 127672]
* Tue Jan 14 2025 Brian Read <brianr@koozali.org> 11.0.0-39.sme * Tue Jan 14 2025 Brian Read <brianr@koozali.org> 11.0.0-39.sme
- Apply perltidy to all Controller files, add .perltidy to directory and .gitignore for .tdy files (just incase) [SME: 12485] - Apply perltidy to all Controller files, add .perltidy to directory and .gitignore for .tdy files (just incase) [SME: 12485]