Chris/webperl
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

New support script to store language variables in the database.

Browse Source
This commit is contained in:
Chris 2013-01-12 17:27:33 +00:00
parent a88f675023
commit 1eb472353f
1 changed files with 157 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

157
supportfiles/lang_to_db.pl Executable file
View File

@ -0,0 +1,157 @@
#!/usr/bin/perl -w
use strict;
use lib "/var/www/webperl";
use DBI;
use Webperl::ConfigMicro;
use Webperl::Utils qw(path_join superchomp);
## @fn $ clear_language_table($dbh, $tablename)
# Clear the contents of the specified language table. This truncates the table,
# erasing all its contents, and resetting the autoincrement for the ID.
#
# @param dbh The database handle to issue queries through.
# @param tablename The name of the database table containing the language variables.
# @return undef on success, otherwise an error message.
sub clear_language_table {
my $dbh = shift;
my $tablename = shift;
my $nukeh = $dbh -> prepare("TRUNCATE `$tablename`");
$nukeh -> execute()
or return "Unable to clear language table: ".$dbh -> errstr;
return undef;
}
## @fn $ set_language_variable($dbh, $tablename, $name, $lang, $message)
# Set the langauge variable with the specified name and lang to contain
# the specified message. This will determine whether the name has already
# been set in the specified language, and if so the message will not be
# updated, and an error will be returned.
#
# @param dbh The database handle to issue queries through.
# @param tablename The name of the database table containing the language variables.
# @param name The name of the language variable.
# @param lang The language the variable is being defined in.
# @param message The message to set for the language variable.
# @return undef on success, otherwise an error message.
sub set_language_variable {
my ($dbh, $tablename, $name, $lang, $message) = @_;
# First check that the variable hasn't already been defined
my $checkh = $dbh -> prepare("SELECT message FROM `$tablename` WHERE `name` LIKE ? AND `lang` LIKE ?");
$checkh -> execute($name, $lang)
or return "Unable to perform language variable check: ".$dbh -> errstr;
my $row = $checkh -> fetchrow_arrayref();
return "Redefinition of language variable $name in language $lang (old: '".$row -> [0]."', new: '$message')"
if($row);
# Doesn't exist, make it...
my $newh = $dbh -> prepare("INSERT INTO `$tablename` (`name`, `lang`, `message`)
VALUES(?, ?, ?)");
my $rows = $newh -> execute($name, $lang, $message);
return "Unable to perform language variable insert: ". $dbh -> errstr if(!$rows);
return "User insert failed, no rows added." if($rows eq "0E0");
return undef;
}
## @fn $ load_language($dbh, $tablename, $langdir)
# Load all of the language files in the appropriate language directory into the
# database. This will attempt to load all .lang files inside the langdir/lang/
# directory, and store the language variables defined therein in the database.
# The database language table is cleared before adding new entries.
#
# @return true if the language files loaded correctly, undef otherwise.
sub load_language {
my $dbh = shift;
my $tablename = shift;
my $langdir = shift;
my $res = clear_language_table($dbh, $tablename);
return $res if($res);
print "Processing language directories in '$langdir'...\n";
opendir(LANGDIR, $langdir)
or return "Unable to open languages directory '$langdir' for reading: $!";
my @langs = readdir(LANGDIR);
closedir(LANGDIR);
foreach my $lang (@langs) {
next if($lang =~ /^\.+$/);
my $langsubdir = path_join($langdir, $lang);
next unless(-d $langsubdir);
print "Checking for lang files in '$lang'...\n";
# open it, so we can process files therein
opendir(LANG, $langsubdir)
or return "Unable to open language directory '$langsubdir' for reading: $!";
my @files = readdir(LANG);
closedir(LANG);
foreach my $name (@files) {
# Skip anything that doesn't identify itself as a .lang file
next unless($name =~ /\.lang$/);
print "Processing language file '$name'...\n";
my $filename = path_join($langsubdir, $name);
# Attempt to open and parse the lang file
if(open(WORDFILE, "<:utf8", $filename)) {
my @lines = <WORDFILE>;
close(WORDFILE);
foreach my $line (@lines) {
superchomp($line);
# skip comments
next if($line =~ /^\s*#/);
# Pull out the key and value, and
my ($key, $value) = $line =~ /^\s*(\w+)\s*=\s*(.*)$/;
next unless(defined($key) && defined($value));
# Unslash any \"s
$value =~ s/\\\"/\"/go;
print "Storing language variable '$key'\n";
$res = set_language_variable($dbh, $tablename, $key, $lang, $value);
return $res if($res);
}
} else {
return "Unable to open language file $filename: $!";
}
} # foreach $name (@files) {
} # foreach my $lang (@langs) {
return undef;
}
my $settings = Webperl::ConfigMicro -> new("../config/site.cfg")
or die "Unable to open configuration file: ".$Webperl::SystemModule::errstr."\n";
die "No 'language' table defined in configuration, unable to proceed.\n"
unless($settings -> {"database"} -> {"language"});
my $dbh = DBI->connect($settings -> {"database"} -> {"database"},
$settings -> {"database"} -> {"username"},
$settings -> {"database"} -> {"password"},
{ RaiseError => 0, AutoCommit => 1, mysql_enable_utf8 => 1 })
or die "Unable to connect to database: ".$DBI::errstr."\n";
my $error = load_language($dbh, $settings -> {"database"} -> {"language"}, "../lang")
or print "Finished successfully.\n";
print "Failed: $error\n" if($error);