Show pslang.pl syntax highlighted
#!/usr/bin/perl
BEGIN { use FindBin; use lib "$FindBin::Bin"; }
$| = 1; # do not buffer output on STDOUT
our $VERSION = '1.00';
use strict;
use warnings;
use Cwd;
use File::Spec::Functions;
use File::Path;
use util;
use LoadConfig;
use Getopt::Long;
use Data::Dumper;
use DBI;
our ($origdir, $webdir, $args, $conf, $themeconf, $themedir, $theme, @themekeys, $lang, $langmap, $langfile, $origlang);
die usage() unless GetOptions(
'<>' => \&GetOptions_callback,
'config=s' => \$args->{config},
'theme=s' => \$args->{theme},
'language|baselanguage=s' => \$args->{baselang}, # default: 'english'
'skipbase|skiplang' => \$args->{skipbase},
'help' => \$args->{help},
);
die usage() if $args->{help};
$args->{config} = 'stats.cfg' unless $args->{config};
$args->{baselang} = 'english' unless $args->{baselang};
LoadConfig->ADDPATH($FindBin::Bin);
$conf = LoadConfig->load( location => $args->{config} );
$theme = $args->{theme} || $conf->{theme}{source} || die usage('No valid theme specified.');
$themedir = catfile($FindBin::Bin, 'themes', $theme, '');
$webdir = catfile($FindBin::Bin, 'web', '');
# since [global] isn't technically allowed in our configs, we fudge it a little and create it ourselves.
$themeconf = LoadConfig->load( location => catfile($themedir,'theme.cfg') );
$themeconf->{global}{files} = [ @{$themeconf->{files}} ];
$themeconf->{global}{IDX} = 0;
$themeconf->{global}{SECTION} = 'global';
delete $themeconf->{$_} foreach (qw( name version author email notes files )); # cleanup the hash a little
# themekeys is an array of all valid language sections in the config ordered by their appearence in the file
@themekeys = sort { $themeconf->{$a}{IDX} <=> $themeconf->{$b}{IDX} } grep { ref $themeconf->{$_} eq 'HASH' } keys %$themeconf;
$origdir = cwd();
# convert all 'files' and 'php' variables into an array of real filenames (expand wildwards)
foreach my $key (@themekeys) {
my @realfiles = ();
my @realphp = ();
$themeconf->{$key}{php} = "$key.php" unless exists $themeconf->{$key}{php}; # make sure there's a 'php' var ...
if (ref $themeconf->{$key}{files} ne 'ARRAY') { # force it into an array first...
my $str = $themeconf->{$key}{files};
$themeconf->{$key}{files} = [ $str ];
}
if (ref $themeconf->{$key}{php} ne 'ARRAY') { # force it into an array first...
my $str = $themeconf->{$key}{php};
$themeconf->{$key}{php} = [ $str ];
}
chdir($themedir);
my $files = $themeconf->{$key}{files};
foreach my $wildcard (@$files) {
push(@realfiles, glob($wildcard));
}
chdir($webdir);
my $php = $themeconf->{$key}{php};
foreach my $wildcard (@$php) {
push(@realphp, glob($wildcard));
}
my %uniq = ();
$themeconf->{$key}{files} = [ sort grep { !$uniq{$_}++ } @realfiles ]; # removes duplicate filenames
%uniq = ();
$themeconf->{$key}{php} = [ sort grep { !$uniq{$_}++ } @realphp ]; # removes duplicate filenames
}
chdir($origdir);
# Gather language strings from each file ....
foreach my $key (@themekeys) {
foreach my $file (@{$themeconf->{$key}{files}}) {
if (!exists $lang->{$file}) { # ignore files that were loaded already
my $source = join('', slurpfile(catfile($themedir, $file)));
while ($source =~ /<#(.+?)#>/g) { # extract all language tokens from the file
$lang->{$file}{$1}++; # record how many times it's used in the file
$langmap->{$1}{$file}++; # reverse map it for tracking purposes
}
}
}
# ... search the PHP files for built-in language translations
foreach my $file (@{$themeconf->{$key}{php}}) {
if (!exists $lang->{$file}) { # ignore files that were loaded already
my $source = join('', slurpfile(catfile($webdir, $file)));
while ($source =~ /\$lang->trans\((["'])(.+?)\1\)/g) { # extract all language translations
$lang->{$file}{$2}++; # record how many times it's used in the file
$langmap->{$2}{$file}++; # reverse map it for tracking purposes
}
}
}
}
# Load language strings from the current {baselang} language files. These will override any automatically loaded already ...
foreach my $key (@themekeys) {
$origlang->{$key} = {};
next if $args->{skipbase}; # do not actually load the previous values if -skip is specified on commandline
$origlang->{$key} = load_lang_config(catfile($themedir, 'languages', $args->{baselang}, "$key.lng"));
}
my $langdir = catfile($themedir, 'languages', $args->{baselang} .'-new');
eval { mkpath($langdir) } unless -d $langdir; # create the dir if it doesn't exist
die("Unable to create new language directory: $langdir: $@\n") if !-d $langdir; # die if the dir still doesn't exist
# combine the language strings from the sub-files into the main config files and save them
warn "Creating new language definitions in:\n>> $langdir\n";
foreach my $key (@themekeys) {
$langfile->{$key} = {};
foreach my $file (@{$themeconf->{$key}{files}}, @{$themeconf->{$key}{php}}) {
$langfile->{$key} = {
map { $_ => $_ } keys %{$lang->{$file}},
%{$langfile->{$key}}
};
}
my $filename = catfile($langdir, "$key.lng");
if (open(F,">$filename")) {
my @strings = sort { lc $a cmp lc $b } keys %{$langfile->{$key}};
print F "// Language file for $key.php automatically created on " . scalar localtime() . "\n\n";
foreach my $s (@strings) {
my $value = defined $origlang->{$key}{$s} ? $origlang->{$key}{$s} : $s;
if ($value =~ /\n/) {
print F "\n==$s\n$value==\n\n"; # write long values as a 'multi-line' block
} else {
print F "$s = $value\n"; # write simple values as a single line
}
}
close(F);
warn sprintf("File created: (%3d entries) $key.lng\n", scalar @strings);
} else {
warn "Error creating language file: $key.lng: $!\n";
}
}
#print Dumper($langfile);
# ------------------------------------------------------
sub load_lang_config {
my ($filename, $curlng) = @_;
my @lines = slurpfile($filename);
my ($token, $value);
my $lastkey = '';
my $table = $curlng ? $curlng : {};
foreach my $line (@lines) {
$line =~ s/^\s+//;
$line =~ s/\s+$//;
if ($lastkey eq '') { # only if we're NOT in a multi-line block ...
next if (substr($line,0,2) eq '//'); # ignore comments
next if ($line eq ''); # ignore blank lines
}
$token = substr($line,0,2); # get current token (==)
$value = substr($line,2) if $line; # get remainder of the line
if ($lastkey ne '') { # ALREADY INSIDE MULTI LINE KEY
if ($token ne '==') { # The key hasn't ended yet
$table->{$lastkey} .= $line . "\n";
} else { # the key ENDED
$value =~ s/^\s+//;
$value =~ s/\s+$//;
$lastkey = $value; # might be empty
}
} else { # SINGLE LINE KEY
if ($token ne '==') {
my ($key,$def) = split(/=/, $line, 2);
$key =~ s/^\s+//;
$key =~ s/\s+$//;
$def =~ s/^\s+//;
$def =~ s/\s+$//;
$table->{$key} = $def;
} else {
$value =~ s/^\s+//;
$value =~ s/\s+$//;
$lastkey = $value;
}
}
}
return $table;
}
# ------------------------------------------------------
sub usage {
my $me = 'pslang.pl';
print STDERR $_[0] if scalar @_;
print STDERR "USAGE:\n";
print STDERR "When no parameters are given the stats.cfg is loaded and the 'english' langage\nis used as the base language.\n\n";
print STDERR " -theme <theme> Defaults to theme.source in main config.\n";
print STDERR " -config <config> Specify a different config other than stats.cfg\n";
print STDERR " -skiplang Skip lanugage strings already defined\n";
print STDERR " -language Specify an alternate base language (default: english)\n";
return "\n";
}
# ------------------------------------------------------
sub GetOptions_callback {
$args->{args} = [] unless ref $args->{args} eq 'ARRAY';
push(@{$args->{args}}, shift);
}
See more files for this project here