Remove outdated webapp example

This commit is contained in:
Chris 2020-02-14 15:09:29 +00:00
parent 042c8628c4
commit 105840a1d2
14 changed files with 0 additions and 651 deletions

View File

@ -1,36 +0,0 @@
# Example .htaccess for apache webservers.
# Uncomment the following three lines if you want your webapp to force HTTPS
# RewriteEngine On
# RewriteCond %{HTTPS} off
# RewriteRule (.*) https://%{HTTP_HOST}%{REQUEST_URI}
# Compress text, html, javascript, css, xml:
AddOutputFilterByType DEFLATE text/plain
AddOutputFilterByType DEFLATE text/html
AddOutputFilterByType DEFLATE text/xml
AddOutputFilterByType DEFLATE text/css
AddOutputFilterByType DEFLATE application/xml
AddOutputFilterByType DEFLATE application/xhtml+xml
AddOutputFilterByType DEFLATE application/rss+xml
AddOutputFilterByType DEFLATE application/javascript
AddOutputFilterByType DEFLATE application/x-javascript
# For extra efficiency, make sure cache expiration times are set for content.
# For example, add the following to the webapp's <VirtualHost>:
#
# ExpiresActive On
# ExpiresDefault "access plus 300 seconds"
#
# And the followin on its <Directory>:
#
# ExpiresByType text/html "access plus 30 minutes"
# ExpiresByType text/css "access plus 1 day"
# ExpiresByType text/javascript "access plus 1 day"
# ExpiresByType image/gif "access plus 1 month"
# ExpiresByType image/jpeg "access plus 1 month"
# ExpiresByType image/jpg "access plus 1 month"
# ExpiresByType image/png "access plus 1 month"
# ExpiresByType application/x-shockwave-flash "access plus 1 day"
# ExpiresByType application/x-javascript "access plus 1 day"
# ExpiresByType application/x-icon "access plus 1 day"

View File

@ -1 +0,0 @@
Deny from all

View File

@ -1 +0,0 @@
Deny from all

View File

@ -1,305 +0,0 @@
-- phpMyAdmin SQL Dump
-- version 3.4.9
-- http://www.phpmyadmin.net
--
-- Host: localhost
-- Generation Time: Dec 06, 2012 at 12:11 AM
-- Server version: 5.1.66
-- PHP Version: 5.4.6--pl0-gentoo
SET SQL_MODE="NO_AUTO_VALUE_ON_ZERO";
SET time_zone = "+00:00";
/*!40101 SET @OLD_CHARACTER_SET_CLIENT=@@CHARACTER_SET_CLIENT */;
/*!40101 SET @OLD_CHARACTER_SET_RESULTS=@@CHARACTER_SET_RESULTS */;
/*!40101 SET @OLD_COLLATION_CONNECTION=@@COLLATION_CONNECTION */;
/*!40101 SET NAMES utf8 */;
-- --------------------------------------------------------
--
-- Table structure for table `auth_methods`
--
CREATE TABLE IF NOT EXISTS `auth_methods` (
`id` tinyint(3) unsigned NOT NULL AUTO_INCREMENT,
`perl_module` varchar(100) NOT NULL COMMENT 'The name of the AuthMethod (no .pm extension)',
`priority` tinyint(4) NOT NULL COMMENT 'The authentication method''s priority. -128 = max, 127 = min',
`enabled` tinyint(1) NOT NULL COMMENT 'Is this auth method usable?',
PRIMARY KEY (`id`)
) ENGINE=MyISAM DEFAULT CHARSET=utf8 COMMENT='Stores the authentication methods supported by the system' AUTO_INCREMENT=2 ;
-- --------------------------------------------------------
--
-- Table structure for table `auth_methods_params`
--
CREATE TABLE IF NOT EXISTS `auth_methods_params` (
`method_id` tinyint(4) NOT NULL COMMENT 'The id of the auth method',
`name` varchar(40) NOT NULL COMMENT 'The parameter mame',
`value` text NOT NULL COMMENT 'The value for the parameter',
KEY `method_id` (`method_id`)
) ENGINE=MyISAM DEFAULT CHARSET=utf8 COMMENT='Stores the settings for each auth method';
-- --------------------------------------------------------
--
-- Table structure for table `blocks`
--
CREATE TABLE IF NOT EXISTS `blocks` (
`id` smallint(5) unsigned NOT NULL AUTO_INCREMENT COMMENT 'Unique ID for this block entry',
`name` varchar(32) NOT NULL,
`module_id` smallint(5) unsigned NOT NULL COMMENT 'ID of the module implementing this block',
`args` varchar(128) NOT NULL COMMENT 'Arguments passed verbatim to the block module',
PRIMARY KEY (`id`),
UNIQUE KEY `name` (`name`)
) ENGINE=MyISAM DEFAULT CHARSET=utf8 COMMENT='web-accessible page modules' AUTO_INCREMENT=5 ;
-- --------------------------------------------------------
--
-- Table structure for table `log`
--
CREATE TABLE IF NOT EXISTS `log` (
`id` int(10) unsigned NOT NULL AUTO_INCREMENT,
`logtime` int(10) unsigned NOT NULL COMMENT 'The time the logged event happened at',
`user_id` int(10) unsigned DEFAULT NULL COMMENT 'The id of the user who triggered the event, if any',
`ipaddr` varchar(16) DEFAULT NULL COMMENT 'The IP address the event was triggered from',
`logtype` varchar(64) NOT NULL COMMENT 'The event type',
`logdata` text COMMENT 'Any data that might be appropriate to log for this event',
PRIMARY KEY (`id`)
) ENGINE=MyISAM DEFAULT CHARSET=utf8 COMMENT='Stores a log of events in the system.' AUTO_INCREMENT=1362 ;
-- --------------------------------------------------------
--
-- Table structure for table `messages_queue`
--
CREATE TABLE IF NOT EXISTS `messages_queue` (
`id` int(10) unsigned NOT NULL AUTO_INCREMENT,
`previous_id` int(10) unsigned DEFAULT NULL COMMENT 'Link to a previous message (for replies/followups/etc)',
`created` int(10) unsigned NOT NULL COMMENT 'The unix timestamp of when this message was created',
`creator_id` int(10) unsigned DEFAULT NULL COMMENT 'Who created this message (NULL = system)',
`deleted` int(10) unsigned DEFAULT NULL COMMENT 'Timestamp of message deletion, marks deletion of /sending/ message.',
`deleted_id` int(10) unsigned DEFAULT NULL COMMENT 'Who deleted the message?',
`message_ident` varchar(128) COLLATE utf8_unicode_ci DEFAULT NULL COMMENT 'Generic identifier, may be used for message lookup after addition',
`subject` varchar(255) COLLATE utf8_unicode_ci NOT NULL COMMENT 'The message subject',
`body` text COLLATE utf8_unicode_ci NOT NULL COMMENT 'The message body',
`format` enum('text','html') COLLATE utf8_unicode_ci NOT NULL DEFAULT 'text' COMMENT 'Message format, for possible extension',
`send_after` int(10) unsigned DEFAULT NULL COMMENT 'Send message after this time (NULL = as soon as possible)',
PRIMARY KEY (`id`),
KEY `created` (`created`),
KEY `deleted` (`deleted`),
KEY `message_ident` (`message_ident`),
KEY `previous_id` (`previous_id`)
) ENGINE=MyISAM DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci COMMENT='Stores messages to be sent through Message:: modules' AUTO_INCREMENT=8 ;
-- --------------------------------------------------------
--
-- Table structure for table `messages_recipients`
--
CREATE TABLE IF NOT EXISTS `messages_recipients` (
`message_id` int(10) unsigned NOT NULL COMMENT 'ID of the message this is a recipient entry for',
`recipient_id` int(10) unsigned NOT NULL COMMENT 'ID of the user sho should get the email',
`viewed` int(10) unsigned DEFAULT NULL COMMENT 'When did the recipient view this message (if at all)',
`deleted` int(10) unsigned DEFAULT NULL COMMENT 'When did the recipient mark their view as deleted (if at all)',
KEY `email_id` (`message_id`),
KEY `recipient_id` (`recipient_id`)
) ENGINE=MyISAM DEFAULT CHARSET=utf8 COMMENT='Stores the recipients of messages';
-- --------------------------------------------------------
--
-- Table structure for table `messages_sender`
--
CREATE TABLE IF NOT EXISTS `messages_sender` (
`message_id` int(10) unsigned NOT NULL COMMENT 'ID of the message this is a sender record for',
`sender_id` int(10) unsigned NOT NULL COMMENT 'ID of the user who sent the message',
`deleted` int(10) unsigned NOT NULL COMMENT 'Has the sender deleted this message from their list (DOES NOT DELETE THE MESSAGE!)',
KEY `message_id` (`message_id`),
KEY `sender_id` (`sender_id`)
) ENGINE=MyISAM DEFAULT CHARSET=utf8 COMMENT='Stores the sender of each message, and sender-specific infor';
-- --------------------------------------------------------
--
-- Table structure for table `messages_transports`
--
CREATE TABLE IF NOT EXISTS `messages_transports` (
`id` int(10) unsigned NOT NULL AUTO_INCREMENT,
`name` varchar(24) CHARACTER SET utf8 COLLATE utf8_unicode_ci NOT NULL COMMENT 'The transport name',
`description` varchar(255) CHARACTER SET utf8 COLLATE utf8_unicode_ci DEFAULT NULL COMMENT 'Human readable description (or langvar name)',
`perl_module` varchar(255) CHARACTER SET utf8 COLLATE utf8_unicode_ci NOT NULL COMMENT 'The perl module implementing the message transport.',
`enabled` tinyint(1) NOT NULL COMMENT 'Is the transport enabled?',
PRIMARY KEY (`id`)
) ENGINE=MyISAM DEFAULT CHARSET=utf8 COMMENT='Stores the list of modules that provide message delivery' AUTO_INCREMENT=3 ;
-- --------------------------------------------------------
--
-- Table structure for table `messages_transports_status`
--
CREATE TABLE IF NOT EXISTS `messages_transports_status` (
`id` int(10) unsigned NOT NULL AUTO_INCREMENT,
`message_id` int(10) unsigned NOT NULL COMMENT 'The ID of the message this is a transport entry for',
`transport_id` int(10) unsigned NOT NULL COMMENT 'The ID of the transport',
`status_time` int(10) unsigned NOT NULL COMMENT 'The time the status was changed',
`status` enum('pending','sent','failed') CHARACTER SET utf8 COLLATE utf8_unicode_ci NOT NULL DEFAULT 'pending' COMMENT 'The transport status',
`status_message` text COMMENT 'human-readable status message (usually error messages)',
PRIMARY KEY (`id`),
KEY `message_id` (`message_id`),
KEY `transport_id` (`transport_id`),
KEY `status` (`status`)
) ENGINE=MyISAM DEFAULT CHARSET=utf8 COMMENT='Stores transport status information for messages' AUTO_INCREMENT=15 ;
-- --------------------------------------------------------
--
-- Table structure for table `messages_transports_userctrl`
--
CREATE TABLE IF NOT EXISTS `messages_transports_userctrl` (
`transport_id` int(10) unsigned NOT NULL COMMENT 'ID of the transport the user has set a control on',
`user_id` int(10) unsigned NOT NULL COMMENT 'User setting the control',
`enabled` tinyint(1) unsigned NOT NULL DEFAULT '1' COMMENT 'contact the user through this transport?',
KEY `transport_id` (`transport_id`),
KEY `user_id` (`user_id`),
KEY `transport_user` (`transport_id`,`user_id`)
) ENGINE=MyISAM DEFAULT CHARSET=utf8 COMMENT='Allows users to explicitly enable, or disable, specific mess';
-- --------------------------------------------------------
--
-- Table structure for table `modules`
--
CREATE TABLE IF NOT EXISTS `modules` (
`module_id` smallint(5) unsigned NOT NULL AUTO_INCREMENT COMMENT 'Unique module id',
`name` varchar(80) NOT NULL COMMENT 'Short name for the module',
`perl_module` varchar(128) NOT NULL COMMENT 'Name of the perl module in blocks/ (no .pm extension!)',
`active` tinyint(1) unsigned NOT NULL COMMENT 'Is this module enabled?',
PRIMARY KEY (`module_id`)
) ENGINE=MyISAM DEFAULT CHARSET=utf8 COMMENT='Available site modules, perl module names, and status' AUTO_INCREMENT=5 ;
-- --------------------------------------------------------
--
-- Table structure for table `sessions`
--
CREATE TABLE IF NOT EXISTS `sessions` (
`session_id` char(32) NOT NULL,
`session_user_id` int(10) unsigned NOT NULL,
`session_start` int(11) unsigned NOT NULL,
`session_time` int(11) unsigned NOT NULL,
`session_ip` varchar(40) NOT NULL,
`session_autologin` tinyint(1) unsigned NOT NULL,
PRIMARY KEY (`session_id`),
KEY `session_time` (`session_time`),
KEY `session_user_id` (`session_user_id`)
) ENGINE=MyISAM DEFAULT CHARSET=utf8 COMMENT='Website sessions';
-- --------------------------------------------------------
--
-- Table structure for table `session_keys`
--
CREATE TABLE IF NOT EXISTS `session_keys` (
`key_id` char(32) COLLATE utf8_bin NOT NULL DEFAULT '',
`user_id` int(10) unsigned NOT NULL DEFAULT '0',
`last_ip` varchar(40) COLLATE utf8_bin NOT NULL DEFAULT '',
`last_login` int(11) unsigned NOT NULL DEFAULT '0',
PRIMARY KEY (`key_id`,`user_id`),
KEY `last_login` (`last_login`)
) ENGINE=MyISAM DEFAULT CHARSET=utf8 COLLATE=utf8_bin COMMENT='Autologin keys';
-- --------------------------------------------------------
--
-- Table structure for table `session_variables`
--
CREATE TABLE IF NOT EXISTS `session_variables` (
`session_id` char(32) NOT NULL,
`var_name` varchar(80) NOT NULL,
`var_value` text NOT NULL,
KEY `session_id` (`session_id`),
KEY `sess_name_map` (`session_id`,`var_name`)
) ENGINE=MyISAM DEFAULT CHARSET=utf8 COMMENT='Session-related variables';
-- --------------------------------------------------------
--
-- Table structure for table `settings`
--
CREATE TABLE IF NOT EXISTS `settings` (
`name` varchar(255) COLLATE utf8_unicode_ci NOT NULL,
`value` text COLLATE utf8_unicode_ci NOT NULL,
PRIMARY KEY (`name`)
) ENGINE=MyISAM DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci COMMENT='Site settings';
INSERT INTO `settings` (`name`, `value`) VALUES
('base', '/path/to/your/webapp'),
('scriptpath', '/'),
('cookie_name', 'webappname'),
('cookie_path', '/'),
('cookie_domain', ''),
('cookie_secure', '0'),
('default_style', 'default'),
('logfile', ''),
('default_block', '1'),
('Auth:allow_autologin', '1'),
('Auth:max_autologin_time', '30'),
('Auth:ip_check', '4'),
('Auth:session_length', '3600'),
('Auth:session_gc', '0'),
('Auth:unique_id', '1'),
('Session:lastgc', '0'),
('Core:envelope_address', 'your@email.addy'),
('Log:all_the_things', '1'),
('timefmt', '%d %b %Y %H:%M:%S %Z'),
('datefmt', '%d %b %Y'),
('Core:admin_email', 'admin@email.addy'),
('Message::Transport::Email::smtp_host', 'localhost'),
('Message::Transport::Email::smtp_port', '25');
-- --------------------------------------------------------
--
-- Table structure for table `users`
--
CREATE TABLE IF NOT EXISTS `users` (
`user_id` int(10) unsigned NOT NULL AUTO_INCREMENT,
`user_auth` tinyint(3) unsigned DEFAULT NULL COMMENT 'Id of the user''s auth method',
`user_type` tinyint(3) unsigned DEFAULT '0' COMMENT 'The user type, 0 = normal, 3 = admin',
`username` varchar(32) NOT NULL,
`firstname` varchar(32) DEFAULT NULL,
`surname` varchar(32) DEFAULT NULL,
`password` char(59) DEFAULT NULL,
`email` varchar(255) CHARACTER SET utf8 COLLATE utf8_unicode_ci DEFAULT NULL COMMENT 'User''s email address',
`created` int(10) unsigned NOT NULL COMMENT 'The unix time at which this user was created',
`activated` int(10) unsigned DEFAULT NULL COMMENT 'Is the user account active, and if so when was it activated?',
`act_code` varchar(64) DEFAULT NULL COMMENT 'Activation code the user must provide when activating their account',
`last_login` int(10) unsigned NOT NULL COMMENT 'The unix time of th euser''s last login',
PRIMARY KEY (`user_id`),
UNIQUE KEY `username` (`username`),
KEY `email` (`email`)
) ENGINE=MyISAM DEFAULT CHARSET=utf8 COMMENT='Stores the local user data for each user in the system' AUTO_INCREMENT=19 ;
/*!40101 SET CHARACTER_SET_CLIENT=@OLD_CHARACTER_SET_CLIENT */;
/*!40101 SET CHARACTER_SET_RESULTS=@OLD_CHARACTER_SET_RESULTS */;
/*!40101 SET COLLATION_CONNECTION=@OLD_COLLATION_CONNECTION */;

View File

@ -1,25 +0,0 @@
[database]
# Basic database connection information. Drivers other than mysql may not work!
database = DBI:mysql:DATABASE
username = USERNAME
password = PASSWORD
# Core webperl tables.
auth_methods = auth_methods
auth_params = auth_methods_params
blocks = blocks
logging = log
message_queue = messages_queue
message_sender = messages_sender
message_recipients = messages_recipients
message_transports = messages_transports
message_status = messages_transports_status
message_userctrl = messages_transports_userctrl
modules = modules
sessions = sessions
session_variables = session_variables
keys = session_keys
settings = settings
users = users
# Add any other table mappings you need here

View File

@ -1,47 +0,0 @@
#!/usr/bin/perl -wT
# Note: above -w flag should be removed in production, as it will cause warnings in
# 3rd party modules to appear in the server error log
use utf8;
use v5.12;
use lib qw(/var/www/webperl);
# Work out where the script is, so module and config loading can work.
our $scriptpath;
BEGIN {
$scriptpath = "/path/to/your/webapp";
}
use CGI::Carp qw(fatalsToBrowser set_message); # Catch as many fatals as possible and send them to the user as well as stderr
use lib "$scriptpath/modules";
our $contact = 'contact@email.address'; # global contact address, for error messages
# System modules
use CGI::Carp qw(fatalsToBrowser set_message); # Catch as many fatals as possible and send them to the user as well as stderr
# Webperl modules
use Webperl::Application;
# Webapp modules
use YourApp::AppUser;
use YourApp::BlockSelector;
use YourApp::System;
delete @ENV{qw(PATH IFS CDPATH ENV BASH_ENV)}; # Clean up ENV
# install more useful error handling
sub handle_errors {
my $msg = shift;
print "<h1>Software error</h1>\n";
print '<p>Server time: ',scalar(localtime()),'<br/>Error was:</p><pre>',$msg,'</pre>';
print '<p>Please report this error to ',$contact,' giving the text of this error and the time and date at which it occured</p>';
}
set_message(\&handle_errors);
my $app = Webperl::Application -> new(config => "$scriptpath/config/site.cfg",
appuser => YourApp::AppUser -> new(),
system => YourApp::System -> new(),
block_selector => YourApp::BlockSelector -> new())
or die "Unable to create application";
$app -> run();

View File

@ -1 +0,0 @@
Deny from all

View File

@ -1,5 +0,0 @@
DEBUG_TIMEUSED = Execution time
DEBUG_SECONDS = seconds
DEBUG_USER = User time
DEBUG_SYSTEM = System time
DEBUG_MEMORY = Memory used

View File

@ -1,14 +0,0 @@
BLOCK_VALIDATE_NOTSET = No value provided for '***field***', this field is required.
BLOCK_VALIDATE_TOOLONG = The value provided for '***field***' is too long. No more than ***maxlen*** characters can be provided for this field.
BLOCK_VALIDATE_BADCHARS = The value provided for '***field***' contains illegal characters. ***desc***
BLOCK_VALIDATE_BADFORMAT = The value provided for '***field***' is not valid. ***desc***
BLOCK_VALIDATE_DBERR = Unable to look up the value for '***field***' in the database. Error was: ***dberr***.
BLOCK_VALIDATE_BADOPT = The value selected for '***field***' is not a valid option.
BLOCK_VALIDATE_SCRUBFAIL = No content was left after cleaning the contents of html field '***field***'.
BLOCK_VALIDATE_TIDYFAIL = htmltidy failed for field '***field***'.
BLOCK_VALIDATE_CHKERRS = ***error*** html errors where encountered while validating '***field***'. Clean up the html and try again.
BLOCK_VALIDATE_CHKFAIL = Validation of '***field***' failed. Error from the W3C validator was: ***error***.
BLOCK_ERROR_TITLE = Fatal System Error
BLOCK_ERROR_SUMMARY = The system has encountered an unrecoverable error.
BLOCK_ERROR_TEXT = A serious error has been encountered while processing your request. The following information was generated by the system, please contact moodlesupport@cs.man.ac.uk about this, including this error and a description of what you were doing when it happened!<br /><br /><span class="error">***error***</span>

View File

@ -1 +0,0 @@
Deny from all

View File

@ -1 +0,0 @@
Deny from all

View File

@ -1,51 +0,0 @@
#!/usr/bin/perl -wT
use strict;
use lib qw(/var/www/webperl);
use lib qw(../modules);
use utf8;
# System modules
use DBI;
use Modules;
use ConfigMicro;
use Logger;
use Message::Queue;
my $logger = Logger -> new()
or die "FATAL: Unable to create logger object";
# Load the system config
my $settings = ConfigMicro -> new("../config/site.cfg")
or $logger -> die_log("Not avilable", "SendMessages.pl: Unable to obtain configuration file: ".$ConfigMicro::errstr);
# Database initialisation. Errors in this will kill program.
my $dbh = DBI->connect($settings -> {"database"} -> {"database"},
$settings -> {"database"} -> {"username"},
$settings -> {"database"} -> {"password"},
{ RaiseError => 0, AutoCommit => 1, mysql_enable_utf8 => 1 })
or $logger -> die_log("None", "SendMessages.pl: Unable to connect to database: ".$DBI::errstr);
# Pull configuration data out of the database into the settings hash
$settings -> load_db_config($dbh, $settings -> {"database"} -> {"settings"});
# Start database logging if available
$logger -> init_database_log($dbh, $settings -> {"database"} -> {"logging"})
if($settings -> {"database"} -> {"logging"});
# Start doing logging if needed
$logger -> start_log($settings -> {"config"} -> {"logfile"}) if($settings -> {"config"} -> {"logfile"});
my $messages = Message::Queue -> new(logger => $logger,
dbh => $dbh,
settings => $settings)
or $logger -> die_log("none", "SendMessages.pl: Unable to create message handler: ".$SystemModule::errstr);
my $module = Modules -> new(logger => $logger,
dbh => $dbh,
settings => $settings)
or $logger -> die_log("none", "SendMessages.pl: Unable to create module loader: ".$SystemModule::errstr);
$messages -> set_module_obj($module);
$messages -> deliver_queue($ARGV[0]);

View File

@ -1,163 +0,0 @@
#!/usr/bin/perl -w
## @file
# A support script to import a directory tree of language files into a webapp's
# 'language' database table. This allows the webapp author to write .lang files
# containing the language variables for the application, and then run this
# script to import the files into the database for faster access.
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);