![[staff profile]](https://www.dreamwidth.org/img/silk/identity/user_staff.png){kind=small}
![[site community profile]](https://www.dreamwidth.org/img/comm_staff.png){kind=small}
[dw-free] Code Refactoring
[commit: http://hg.dwscoalition.org/dw-free/rev/e8d5bfb23489]
http://bugs.dwscoalition.org/show_bug.cgi?id=1726
Refactor ljlang.pl to LJ::Lang module.
Patch by![[personal profile]](https://www.dreamwidth.org/img/silk/identity/user.png)
szabgab.
Files modified:
http://bugs.dwscoalition.org/show_bug.cgi?id=1726
Refactor ljlang.pl to LJ::Lang module.
Patch by
szabgab.Files modified:
- bin/upgrading/texttool.pl
- bin/worker/esn-cluster-subs
- bin/worker/esn-cluster-subs-mass
- bin/worker/esn-filter-subs
- bin/worker/esn-filter-subs-mass
- bin/worker/esn-fired-event
- bin/worker/esn-fired-event-mass
- bin/worker/esn-process-sub
- bin/worker/esn-process-sub-mass
- bin/worker/paidstatus
- bin/worker/process-esn
- bin/worker/process-esn-mass
- cgi-bin/DW/BusinessRules/InviteCodes.pm
- cgi-bin/DW/Worker/DistributeInvites.pm
- cgi-bin/DW/Worker/XPostWorker.pm
- cgi-bin/LJ/Lang.pm
- cgi-bin/ljlang.pl
- cgi-bin/modperl_subs.pl
- t/commafy.t
- t/console-faqcat.t
- t/faq.t
- t/settings.t
--------------------------------------------------------------------------------
diff -r 0b01e0370322 -r e8d5bfb23489 bin/upgrading/texttool.pl
--- a/bin/upgrading/texttool.pl Sat Sep 12 12:14:17 2009 +0800
+++ b/bin/upgrading/texttool.pl Sat Sep 12 05:33:57 2009 +0000
@@ -59,7 +59,7 @@ unless (-d $ENV{'LJHOME'}) {
"You must fix this before you can run this database update script.";
}
require "$ENV{'LJHOME'}/cgi-bin/ljlib.pl";
-require "$ENV{'LJHOME'}/cgi-bin/ljlang.pl";
+use LJ::Lang;
require "$ENV{'LJHOME'}/cgi-bin/weblib.pl";
my %dom_id; # number -> {}
diff -r 0b01e0370322 -r e8d5bfb23489 bin/worker/esn-cluster-subs
--- a/bin/worker/esn-cluster-subs Sat Sep 12 12:14:17 2009 +0800
+++ b/bin/worker/esn-cluster-subs Sat Sep 12 05:33:57 2009 +0000
@@ -3,7 +3,7 @@ use lib "$ENV{LJHOME}/cgi-bin";
use lib "$ENV{LJHOME}/cgi-bin";
require 'ljlib.pl';
require 'ljprotocol.pl';
-require 'ljlang.pl';
+use LJ::Lang;
use LJ::Worker::TheSchwartz;
use LJ::ESN;
diff -r 0b01e0370322 -r e8d5bfb23489 bin/worker/esn-cluster-subs-mass
--- a/bin/worker/esn-cluster-subs-mass Sat Sep 12 12:14:17 2009 +0800
+++ b/bin/worker/esn-cluster-subs-mass Sat Sep 12 05:33:57 2009 +0000
@@ -3,7 +3,7 @@ use lib "$ENV{LJHOME}/cgi-bin";
use lib "$ENV{LJHOME}/cgi-bin";
require 'ljlib.pl';
require 'ljprotocol.pl';
-require 'ljlang.pl';
+use LJ::Lang;
use LJ::Worker::TheSchwartz;
use LJ::ESN;
diff -r 0b01e0370322 -r e8d5bfb23489 bin/worker/esn-filter-subs
--- a/bin/worker/esn-filter-subs Sat Sep 12 12:14:17 2009 +0800
+++ b/bin/worker/esn-filter-subs Sat Sep 12 05:33:57 2009 +0000
@@ -3,7 +3,7 @@ use lib "$ENV{LJHOME}/cgi-bin";
use lib "$ENV{LJHOME}/cgi-bin";
require 'ljlib.pl';
require 'ljprotocol.pl';
-require 'ljlang.pl';
+use LJ::Lang;
use LJ::Worker::TheSchwartz;
use LJ::ESN;
diff -r 0b01e0370322 -r e8d5bfb23489 bin/worker/esn-filter-subs-mass
--- a/bin/worker/esn-filter-subs-mass Sat Sep 12 12:14:17 2009 +0800
+++ b/bin/worker/esn-filter-subs-mass Sat Sep 12 05:33:57 2009 +0000
@@ -3,7 +3,7 @@ use lib "$ENV{LJHOME}/cgi-bin";
use lib "$ENV{LJHOME}/cgi-bin";
require 'ljlib.pl';
require 'ljprotocol.pl';
-require 'ljlang.pl';
+use LJ::Lang;
use LJ::Worker::TheSchwartz;
use LJ::ESN;
diff -r 0b01e0370322 -r e8d5bfb23489 bin/worker/esn-fired-event
--- a/bin/worker/esn-fired-event Sat Sep 12 12:14:17 2009 +0800
+++ b/bin/worker/esn-fired-event Sat Sep 12 05:33:57 2009 +0000
@@ -3,7 +3,7 @@ use lib "$ENV{LJHOME}/cgi-bin";
use lib "$ENV{LJHOME}/cgi-bin";
require 'ljlib.pl';
require 'ljprotocol.pl';
-require 'ljlang.pl';
+use LJ::Lang;
use LJ::Worker::TheSchwartz;
use LJ::ESN;
diff -r 0b01e0370322 -r e8d5bfb23489 bin/worker/esn-fired-event-mass
--- a/bin/worker/esn-fired-event-mass Sat Sep 12 12:14:17 2009 +0800
+++ b/bin/worker/esn-fired-event-mass Sat Sep 12 05:33:57 2009 +0000
@@ -3,7 +3,7 @@ use lib "$ENV{LJHOME}/cgi-bin";
use lib "$ENV{LJHOME}/cgi-bin";
require 'ljlib.pl';
require 'ljprotocol.pl';
-require 'ljlang.pl';
+use LJ::Lang;
use LJ::Worker::TheSchwartz;
use LJ::ESN;
diff -r 0b01e0370322 -r e8d5bfb23489 bin/worker/esn-process-sub
--- a/bin/worker/esn-process-sub Sat Sep 12 12:14:17 2009 +0800
+++ b/bin/worker/esn-process-sub Sat Sep 12 05:33:57 2009 +0000
@@ -3,7 +3,7 @@ use lib "$ENV{LJHOME}/cgi-bin";
use lib "$ENV{LJHOME}/cgi-bin";
require 'ljlib.pl';
require 'ljprotocol.pl';
-require 'ljlang.pl';
+use LJ::Lang;
use LJ::Worker::TheSchwartz;
use LJ::ESN;
diff -r 0b01e0370322 -r e8d5bfb23489 bin/worker/esn-process-sub-mass
--- a/bin/worker/esn-process-sub-mass Sat Sep 12 12:14:17 2009 +0800
+++ b/bin/worker/esn-process-sub-mass Sat Sep 12 05:33:57 2009 +0000
@@ -3,7 +3,7 @@ use lib "$ENV{LJHOME}/cgi-bin";
use lib "$ENV{LJHOME}/cgi-bin";
require 'ljlib.pl';
require 'ljprotocol.pl';
-require 'ljlang.pl';
+use LJ::Lang;
use LJ::Worker::TheSchwartz;
use LJ::ESN;
diff -r 0b01e0370322 -r e8d5bfb23489 bin/worker/paidstatus
--- a/bin/worker/paidstatus Sat Sep 12 12:14:17 2009 +0800
+++ b/bin/worker/paidstatus Sat Sep 12 05:33:57 2009 +0000
@@ -22,7 +22,7 @@ use Time::HiRes qw/ gettimeofday tv_inte
require 'ljlib.pl';
require 'ljmail.pl';
-require 'ljlang.pl';
+use LJ::Lang;
use DW::Shop;
use DW::Shop::Cart;
diff -r 0b01e0370322 -r e8d5bfb23489 bin/worker/process-esn
--- a/bin/worker/process-esn Sat Sep 12 12:14:17 2009 +0800
+++ b/bin/worker/process-esn Sat Sep 12 05:33:57 2009 +0000
@@ -3,7 +3,7 @@ use lib "$ENV{LJHOME}/cgi-bin";
use lib "$ENV{LJHOME}/cgi-bin";
require 'ljlib.pl';
require 'ljprotocol.pl';
-require 'ljlang.pl';
+use LJ::Lang;
use LJ::Worker::TheSchwartz;
use LJ::ESN;
diff -r 0b01e0370322 -r e8d5bfb23489 bin/worker/process-esn-mass
--- a/bin/worker/process-esn-mass Sat Sep 12 12:14:17 2009 +0800
+++ b/bin/worker/process-esn-mass Sat Sep 12 05:33:57 2009 +0000
@@ -3,7 +3,7 @@ use lib "$ENV{LJHOME}/cgi-bin";
use lib "$ENV{LJHOME}/cgi-bin";
require 'ljlib.pl';
require 'ljprotocol.pl';
-require 'ljlang.pl';
+use LJ::Lang;
use LJ::Worker::TheSchwartz;
use LJ::ESN;
diff -r 0b01e0370322 -r e8d5bfb23489 cgi-bin/DW/BusinessRules/InviteCodes.pm
--- a/cgi-bin/DW/BusinessRules/InviteCodes.pm Sat Sep 12 12:14:17 2009 +0800
+++ b/cgi-bin/DW/BusinessRules/InviteCodes.pm Sat Sep 12 05:33:57 2009 +0000
@@ -22,7 +22,7 @@ use List::Util ();
use List::Util ();
use lib "$LJ::HOME/cgi-bin";
use base 'DW::BusinessRules';
-BEGIN { require "ljlang.pl"; }
+use LJ::Lang;
=head1 NAME
diff -r 0b01e0370322 -r e8d5bfb23489 cgi-bin/DW/Worker/DistributeInvites.pm
--- a/cgi-bin/DW/Worker/DistributeInvites.pm Sat Sep 12 12:14:17 2009 +0800
+++ b/cgi-bin/DW/Worker/DistributeInvites.pm Sat Sep 12 05:33:57 2009 +0000
@@ -26,8 +26,9 @@ use DW::InviteCodeRequests;
use DW::InviteCodeRequests;
use DW::BusinessRules::InviteCodes;
use LJ::User;
+use LJ::Lang;
-BEGIN { require "ljlang.pl"; require "ljmail.pl"; require "sysban.pl"; }
+BEGIN { require "ljmail.pl"; require "sysban.pl"; }
sub schwartz_capabilities { return ('DW::Worker::DistributeInvites'); }
diff -r 0b01e0370322 -r e8d5bfb23489 cgi-bin/DW/Worker/XPostWorker.pm
--- a/cgi-bin/DW/Worker/XPostWorker.pm Sat Sep 12 12:14:17 2009 +0800
+++ b/cgi-bin/DW/Worker/XPostWorker.pm Sat Sep 12 05:33:57 2009 +0000
@@ -27,8 +27,9 @@ use DW::External::Account;
use DW::External::Account;
use LJ::Event::XPostSuccess;
use LJ::User;
+use LJ::Lang;
-BEGIN { require "ljlang.pl"; require "ljprotocol.pl" }
+BEGIN { require "ljprotocol.pl" }
sub schwartz_capabilities { return ('DW::Worker::XPostWorker'); }
diff -r 0b01e0370322 -r e8d5bfb23489 cgi-bin/LJ/Lang.pm
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/cgi-bin/LJ/Lang.pm Sat Sep 12 05:33:57 2009 +0000
@@ -0,0 +1,837 @@
+package LJ::Lang;
+use strict;
+
+use Class::Autouse qw(
+
+ LJ::LangDatFile
+ );
+
+
+use constant MAXIMUM_ITCODE_LENGTH => 80;
+
+my @day_short = (qw[Sun Mon Tue Wed Thu Fri Sat]);
+my @day_long = (qw[Sunday Monday Tuesday Wednesday Thursday Friday Saturday]);
+my @month_short = (qw[Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec]);
+my @month_long = (qw[January February March April May June July August September October November December]);
+
+# For init_cvsprefixes(), langdat_file_of_lang_itcode(), and stuff.
+my @shared_cvsprefixes = qw(cvs/livejournal cvs/dw-free);
+my @local_cvsprefixes = qw(cvs/local cvs/dw-nonfree);
+my ($cvspfx_shared, $cvspfx_local);
+
+# get entire array of days and months
+sub day_list_short { return @LJ::Lang::day_short; }
+sub day_list_long { return @LJ::Lang::day_long; }
+sub month_list_short { return @LJ::Lang::month_short; }
+sub month_list_long { return @LJ::Lang::month_long; }
+
+# access individual day or month given integer
+sub day_short { return $day_short[$_[0] - 1]; }
+sub day_long { return $day_long[$_[0] - 1]; }
+sub month_short { return $month_short[$_[0] - 1]; }
+sub month_long { return $month_long[$_[0] - 1]; }
+
+# lang codes for individual day or month given integer
+sub day_short_langcode { return "date.day." . lc(LJ::Lang::day_long(@_)) . ".short"; }
+sub day_long_langcode { return "date.day." . lc(LJ::Lang::day_long(@_)) . ".long"; }
+sub month_short_langcode { return "date.month." . lc(LJ::Lang::month_long(@_)) . ".short"; }
+sub month_long_langcode { return "date.month." . lc(LJ::Lang::month_long(@_)) . ".long"; }
+
+# Translated names for individual day or month given integer. You probably want
+# these, not the ones above.
+sub day_short_ml { return LJ::Lang::ml( LJ::Lang::day_short_langcode( @_ ) ); }
+sub day_long_ml { return LJ::Lang::ml( LJ::Lang::day_long_langcode( @_ ) ); }
+sub month_short_ml { return LJ::Lang::ml( LJ::Lang::month_short_langcode( @_ ) ); }
+sub month_long_ml { return LJ::Lang::ml( LJ::Lang::month_long_langcode( @_ ) ); }
+
+## ordinal suffix
+sub day_ord {
+ my $day = shift;
+
+ # teens all end in 'th'
+ if ($day =~ /1\d$/) { return "th"; }
+
+ # otherwise endings in 1, 2, 3 are special
+ if ($day % 10 == 1) { return "st"; }
+ if ($day % 10 == 2) { return "nd"; }
+ if ($day % 10 == 3) { return "rd"; }
+
+ # everything else (0,4-9) end in "th"
+ return "th";
+}
+
+sub time_format
+{
+ my ($hours, $h, $m, $formatstring) = @_;
+
+ if ($formatstring eq "short") {
+ if ($hours == 12) {
+ my $ret;
+ my $ap = "a";
+ if ($h == 0) { $ret .= "12"; }
+ elsif ($h < 12) { $ret .= ($h+0); }
+ elsif ($h == 12) { $ret .= ($h+0); $ap = "p"; }
+ else { $ret .= ($h-12); $ap = "p"; }
+ $ret .= sprintf(":%02d$ap", $m);
+ return $ret;
+ } elsif ($hours == 24) {
+ return sprintf("%02d:%02d", $h, $m);
+ }
+ }
+ return "";
+}
+
+#### ml_ stuff:
+my $LS_CACHED = 0;
+my %DM_ID = (); # id -> { type, args, dmid, langs => { => 1, => 0, => 1 } }
+my %DM_UNIQ = (); # "$type/$args" => ^^^
+my %LN_ID = (); # id -> { ..., ..., 'children' => [ $ids, .. ] }
+my %LN_CODE = (); # $code -> ^^^^
+my $LAST_ERROR;
+my %TXT_CACHE;
+
+sub last_error
+{
+ return $LAST_ERROR;
+}
+
+sub set_error
+{
+ $LAST_ERROR = $_[0];
+ return 0;
+}
+
+sub get_lang
+{
+ my $code = shift;
+ load_lang_struct() unless $LS_CACHED;
+ return $LN_CODE{$code};
+}
+
+sub get_lang_id
+{
+ my $id = shift;
+ load_lang_struct() unless $LS_CACHED;
+ return $LN_ID{$id};
+}
+
+sub get_dom
+{
+ my $dmcode = shift;
+ load_lang_struct() unless $LS_CACHED;
+ return $DM_UNIQ{$dmcode};
+}
+
+sub get_dom_id
+{
+ my $dmid = shift;
+ load_lang_struct() unless $LS_CACHED;
+ return $DM_ID{$dmid};
+}
+
+sub get_domains
+{
+ load_lang_struct() unless $LS_CACHED;
+ return values %DM_ID;
+}
+
+sub get_root_lang
+{
+ my $dom = shift; # from, say, get_dom
+ return undef unless ref $dom eq "HASH";
+
+ my $lang_override = LJ::run_hook("root_lang_override", $dom);
+ return get_lang($lang_override) if $lang_override;
+
+ foreach (keys %{$dom->{'langs'}}) {
+ if ($dom->{'langs'}->{$_}) {
+ return get_lang_id($_);
+ }
+ }
+ return undef;
+}
+
+sub load_lang_struct
+{
+ return 1 if $LS_CACHED;
+ my $dbr = LJ::get_db_reader();
+ return set_error("No database available") unless $dbr;
+ my $sth;
+
+ $sth = $dbr->prepare("SELECT dmid, type, args FROM ml_domains");
+ $sth->execute;
+ while (my ($dmid, $type, $args) = $sth->fetchrow_array) {
+ my $uniq = $args ? "$type/$args" : $type;
+ $DM_UNIQ{$uniq} = $DM_ID{$dmid} = {
+ 'type' => $type, 'args' => $args, 'dmid' => $dmid,
+ 'uniq' => $uniq,
+ };
+ }
+
+ $sth = $dbr->prepare("SELECT lnid, lncode, lnname, parenttype, parentlnid FROM ml_langs");
+ $sth->execute;
+ while (my ($id, $code, $name, $ptype, $pid) = $sth->fetchrow_array) {
+ $LN_ID{$id} = $LN_CODE{$code} = {
+ 'lnid' => $id,
+ 'lncode' => $code,
+ 'lnname' => $name,
+ 'parenttype' => $ptype,
+ 'parentlnid' => $pid,
+ };
+ }
+ foreach (values %LN_CODE) {
+ next unless $_->{'parentlnid'};
+ push @{$LN_ID{$_->{'parentlnid'}}->{'children'}}, $_->{'lnid'};
+ }
+
+ $sth = $dbr->prepare("SELECT lnid, dmid, dmmaster FROM ml_langdomains");
+ $sth->execute;
+ while (my ($lnid, $dmid, $dmmaster) = $sth->fetchrow_array) {
+ $DM_ID{$dmid}->{'langs'}->{$lnid} = $dmmaster;
+ }
+
+ $LS_CACHED = 1;
+}
+
+sub init_cvsprefixes {
+ return if defined($cvspfx_shared);
+
+ foreach my $p (@shared_cvsprefixes) {
+ if (-d "$LJ::HOME/$p") {
+ $cvspfx_shared = $p;
+ last;
+ }
+ }
+ $cvspfx_shared ||= "";
+
+ foreach my $p (@local_cvsprefixes) {
+ if (-d "$LJ::HOME/$p") {
+ $cvspfx_local = $p;
+ last;
+ }
+ }
+ $cvspfx_local ||= "";
+}
+
+sub langdat_file_of_lang_itcode
+{
+ my ($lang, $itcode, $want_cvs) = @_;
+
+ my $langdat_file = LJ::Lang::relative_langdat_file_of_lang_itcode($lang, $itcode);
+ my $cvs_extra = "";
+ if ($want_cvs) {
+ init_cvsprefixes();
+ if ($lang eq "en") {
+ $cvs_extra = "/$cvspfx_shared";
+ } else {
+ $cvs_extra = "/$cvspfx_local";
+ }
+ }
+ return "$LJ::HOME$cvs_extra/$langdat_file";
+}
+
+sub relative_langdat_file_of_lang_itcode
+{
+ my ($lang, $itcode) = @_;
+
+ my $root_lang = "en";
+ my $root_lang_local = $LJ::DEFAULT_LANG;
+
+ my $base_file = "bin/upgrading/$lang\.dat";
+
+ # not a root or root_local lang, just return base file location
+ unless ($lang eq $root_lang || $lang eq $root_lang_local) {
+ return $base_file;
+ }
+
+ my $is_local = $lang eq $root_lang_local;
+
+ # is this a filename-based itcode?
+ if ($itcode =~ m!^(/.+\.bml)!) {
+ my $file = $1;
+
+ # given the filename of this itcode and the current
+ # source, what langdat file should we use?
+ my $langdat_file = "htdocs$file\.text";
+ $langdat_file .= $is_local ? ".local" : "";
+ return $langdat_file;
+ }
+
+ # not a bml file, goes into base .dat file
+ return $base_file;
+}
+
+sub itcode_for_langdat_file {
+ my ($langdat_file, $itcode) = @_;
+
+ # non-bml itcode, return full itcode path
+ unless ($langdat_file =~ m!^/.+\.bml\.text(?:\.local)?$!) {
+ return $itcode;
+ }
+
+ # bml itcode, strip filename and return
+ if ($itcode =~ m!^/.+\.bml(\..+)!) {
+ return $1;
+ }
+
+ # fallback -- full $itcode
+ return $itcode;
+}
+
+sub get_chgtime_unix
+{
+ my ($lncode, $dmid, $itcode) = @_;
+ load_lang_struct() unless $LS_CACHED;
+
+ $dmid = int($dmid || 1);
+
+ my $l = get_lang($lncode) or return "No lang info for lang $lncode";
+ my $lnid = $l->{'lnid'}
+ or die "Could not get lang_id for lang $lncode";
+
+ my $itid = LJ::Lang::get_itemid($dmid, $itcode)
+ or return 0;
+
+ my $dbr = LJ::get_db_reader();
+ $dmid += 0;
+ my $chgtime = $dbr->selectrow_array("SELECT chgtime FROM ml_latest WHERE dmid=? AND itid=? AND lnid=?",
+ undef, $dmid, $itid, $lnid);
+ die $dbr->errstr if $dbr->err;
+ return $chgtime ? LJ::mysqldate_to_time($chgtime) : 0;
+}
+
+sub get_itemid
+{
+ &LJ::nodb;
+ my ($dmid, $itcode, $opts) = @_;
+ load_lang_struct() unless $LS_CACHED;
+
+ if (length $itcode > MAXIMUM_ITCODE_LENGTH) {
+ warn "'$itcode' exceeds maximum code length, truncating to " . MAXIMUM_ITCODE_LENGTH . " symbols";
+ $itcode = substr($itcode, 0, MAXIMUM_ITCODE_LENGTH);
+ }
+
+ my $dbr = LJ::get_db_reader();
+ $dmid += 0;
+ my $itid = $dbr->selectrow_array("SELECT itid FROM ml_items WHERE dmid=$dmid AND itcode=?", undef, $itcode);
+ return $itid if defined $itid;
+
+ my $dbh = LJ::get_db_writer();
+ return 0 unless $dbh;
+
+ # allocate a new id
+ LJ::get_lock($dbh, 'global', 'mlitem_dmid') || return 0;
+ $itid = $dbh->selectrow_array("SELECT MAX(itid)+1 FROM ml_items WHERE dmid=?", undef, $dmid);
+ $itid ||= 1; # if the table is empty, NULL+1 == NULL
+ $dbh->do("INSERT INTO ml_items (dmid, itid, itcode, notes) ".
+ "VALUES (?, ?, ?, ?)", undef, $dmid, $itid, $itcode, $opts->{'notes'});
+ LJ::release_lock($dbh, 'global', 'mlitem_dmid');
+
+ if ($dbh->err) {
+ return $dbh->selectrow_array("SELECT itid FROM ml_items WHERE dmid=$dmid AND itcode=?",
+ undef, $itcode);
+ }
+ return $itid;
+}
+
+# this is called when editing text from a web UI.
+# first try and run a local hook to save the text,
+# if that fails then just call set_text
+
+# returns ($success, $responsemsg) where responsemsg can be output
+# from whatever saves the text
+sub web_set_text {
+ my ($dmid, $lncode, $itcode, $text, $opts) = @_;
+
+ my $resp = '';
+ my $hook_ran = 0;
+
+ if (LJ::are_hooks('web_set_text')) {
+ $hook_ran = LJ::run_hook('web_set_text', $dmid, $lncode, $itcode, $text, $opts);
+ }
+
+ # save in the db
+ my $save_success = LJ::Lang::set_text($dmid, $lncode, $itcode, $text, $opts);
+ $resp = LJ::Lang::last_error() unless $save_success;
+ warn $resp if ! $save_success && $LJ::IS_DEV_SERVER;
+
+ return ($save_success, $resp);
+}
+
+sub set_text
+{
+ &LJ::nodb;
+ my ($dmid, $lncode, $itcode, $text, $opts) = @_;
+ load_lang_struct() unless $LS_CACHED;
+
+ my $l = $LN_CODE{$lncode} or return set_error("Language not defined.");
+ my $lnid = $l->{'lnid'};
+ $dmid += 0;
+
+ # is this domain/language request even possible?
+ return set_error("Bogus domain")
+ unless exists $DM_ID{$dmid};
+ return set_error("Bogus lang for that domain")
+ unless exists $DM_ID{$dmid}->{'langs'}->{$lnid};
+
+ my $itid = get_itemid($dmid, $itcode, { 'notes' => $opts->{'notes'}});
+ return set_error("Couldn't allocate itid.") unless $itid;
+
+ my $dbh = LJ::get_db_writer();
+ my $txtid = 0;
+
+ my $oldtextid = $dbh->selectrow_array("SELECT txtid FROM ml_text WHERE lnid=? AND dmid=? AND itid=?", undef, $lnid, $dmid, $itid);
+
+ if (defined $text) {
+ my $userid = $opts->{'userid'} + 0;
+ # Strip bad characters
+ $text =~ s/\r//;
+ my $qtext = $dbh->quote($text);
+ LJ::get_lock( $dbh, 'global', 'ml_text_txtid' ) || return 0;
+ $txtid = $dbh->selectrow_array("SELECT MAX(txtid)+1 FROM ml_text WHERE dmid=?", undef, $dmid);
+ $txtid ||= 1;
+ $dbh->do("INSERT INTO ml_text (dmid, txtid, lnid, itid, text, userid) ".
+ "VALUES ($dmid, $txtid, $lnid, $itid, $qtext, $userid)");
+ LJ::release_lock( $dbh, 'global', 'ml_text_txtid' );
+ return set_error("Error inserting ml_text: ".$dbh->errstr) if $dbh->err;
+ }
+ if ($opts->{'txtid'}) {
+ $txtid = $opts->{'txtid'}+0;
+ }
+
+ my $staleness = $opts->{'staleness'}+0;
+ $dbh->do("REPLACE INTO ml_latest (lnid, dmid, itid, txtid, chgtime, staleness) ".
+ "VALUES ($lnid, $dmid, $itid, $txtid, NOW(), $staleness)");
+ return set_error("Error inserting ml_latest: ".$dbh->errstr) if $dbh->err;
+ LJ::MemCache::set("ml.${lncode}.${dmid}.${itcode}", $text) if defined $text;
+
+ my $langids;
+ {
+ my $vals;
+ my $rec = sub {
+ my $l = shift;
+ my $rec = shift;
+ foreach my $cid (@{$l->{'children'}}) {
+ my $clid = $LN_ID{$cid};
+ if ($opts->{'childrenlatest'}) {
+ my $stale = $clid->{'parenttype'} eq "diff" ? 3 : 0;
+ $vals .= "," if $vals;
+ $vals .= "($cid, $dmid, $itid, $txtid, NOW(), $stale)";
+ }
+ $langids .= "," if $langids;
+ $langids .= $cid+0;
+ LJ::MemCache::delete("ml.$clid->{'lncode'}.${dmid}.${itcode}");
+ $rec->($clid, $rec);
+ }
+ };
+ $rec->($l, $rec);
+
+ # set descendants to use this mapping
+ $dbh->do("INSERT IGNORE INTO ml_latest (lnid, dmid, itid, txtid, chgtime, staleness) ".
+ "VALUES $vals") if $vals;
+
+ # update languages that have no translation yet
+ if ($oldtextid) {
+ $dbh->do("UPDATE ml_latest SET txtid=$txtid WHERE dmid=$dmid ".
+ "AND lnid IN ($langids) AND itid=$itid AND txtid=$oldtextid") if $langids;
+ } else {
+ $dbh->do("UPDATE ml_latest SET txtid=$txtid WHERE dmid=$dmid ".
+ "AND lnid IN ($langids) AND itid=$itid AND staleness >= 3") if $langids;
+ }
+ }
+
+ if ($opts->{'changeseverity'} && $langids) {
+ my $newstale = $opts->{'changeseverity'} == 2 ? 2 : 1;
+ $dbh->do("UPDATE ml_latest SET staleness=$newstale WHERE lnid IN ($langids) AND ".
+ "dmid=$dmid AND itid=$itid AND txtid<>$txtid AND staleness < $newstale");
+ }
+
+ return 1;
+}
+
+sub remove_text {
+ my ($dmid, $itcode, $lncode) = @_;
+
+ my $dbh = LJ::get_db_writer();
+
+ my $itid = $dbh->selectrow_array("SELECT itid FROM ml_items WHERE dmid=? AND itcode=?",
+ undef, $dmid, $itcode);
+ die "Unknown item code $itcode." unless $itid;
+
+ # need to delete everything from: ml_items ml_latest ml_text
+
+ $dbh->do("DELETE FROM ml_items WHERE dmid=? AND itid=?",
+ undef, $dmid, $itid);
+
+ my @txtids = ();
+ my $sth = $dbh->prepare("SELECT txtid FROM ml_latest WHERE dmid=? AND itid=?");
+ $sth->execute($dmid, $itid);
+ while (my $txtid = $sth->fetchrow_array) {
+ push @txtids, $txtid;
+ }
+
+ $dbh->do("DELETE FROM ml_latest WHERE dmid=? AND itid=?",
+ undef, $dmid, $itid);
+
+ my $txtid_bind = join(",", map { "?" } @txtids);
+ $dbh->do("DELETE FROM ml_text WHERE dmid=? AND txtid IN ($txtid_bind)",
+ undef, $dmid, @txtids);
+
+ # delete from memcache if lncode is defined
+ LJ::MemCache::delete("ml.${lncode}.${dmid}.${itcode}") if $lncode;
+
+ return 1;
+}
+
+sub get_effective_lang {
+
+ my $lang;
+ if (LJ::is_web_context()) {
+ $lang = BML::get_language();
+ }
+ if (my $remote = LJ::get_remote()) {
+ # we have a user; try their browse language
+ $lang ||= $remote->prop("browselang");
+ }
+
+ # did we get a valid language code?
+ if ($lang && $LN_CODE{$lang}) {
+ return $lang;
+ }
+
+ # had no language code, or invalid. return default
+ return $LJ::DEFAULT_LANG;
+}
+
+sub ml {
+ my ($code, $vars) = @_;
+
+ if (LJ::is_web_context()) {
+ # this means we should use BML::ml and not do our own handling
+ my $text = BML::ml($code, $vars);
+ $LJ::_ML_USED_STRINGS{$code} = $text if $LJ::IS_DEV_SERVER;
+ return $text;
+ }
+
+ my $lang = LJ::Lang::get_effective_lang();
+ return get_text($lang, $code, undef, $vars);
+}
+
+sub string_exists {
+ my ($code, $vars) = @_;
+
+ my $string = LJ::Lang::ml($code, $vars);
+ return LJ::Lang::is_missing_string($string) ? 0 : 1;
+}
+
+# LJ::Lang::ml will return a number of values for "invalid string"
+# -- this function will tell you if the value is one of
+# those values. gross.
+sub is_missing_string {
+ my $string = shift;
+
+ return ( $string eq "" ||
+ $string =~ /^\[missing string/ ||
+ $string =~ /^\[uhhh:/ ) ? 1 : 0;
+}
+
+sub get_text
+{
+ my ($lang, $code, $dmid, $vars) = @_;
+ $lang ||= $LJ::DEFAULT_LANG;
+
+ my $from_db = sub {
+ my $text = get_text_multi($lang, $dmid, [ $code ]);
+ return $text->{$code};
+ };
+
+ my $from_files = sub {
+ my ($localcode, @files);
+ if ($code =~ m!^(/.+\.bml)(\..+)!) {
+ my $file;
+ ($file, $localcode) = ("$LJ::HTDOCS$1", $2);
+ @files = ("$file.text.local", "$file.text");
+ } else {
+ $localcode = $code;
+ @files = ("$LJ::HOME/bin/upgrading/$LJ::DEFAULT_LANG.dat",
+ "$LJ::HOME/bin/upgrading/en.dat");
+ }
+
+ foreach my $tf (@files) {
+ next unless -e $tf;
+
+ # compare file modtime to when the string was updated in the DB.
+ # whichever is newer is authoritative
+ my $fmodtime = (stat $tf)[9];
+ my $dbmodtime = LJ::Lang::get_chgtime_unix($lang, $dmid, $code);
+ return $from_db->() if ! $fmodtime || $dbmodtime > $fmodtime;
+
+ my $ldf = $LJ::REQ_LANGDATFILE{$tf} ||= LJ::LangDatFile->new($tf);
+ my $val = $ldf->value($localcode);
+ return $val if $val;
+ }
+ return "[missing string $code]";
+ };
+
+ my $gen_mld = LJ::Lang::get_dom('general');
+ my $is_gen_dmid = defined $dmid ? $dmid == $gen_mld->{dmid} : 1;
+ my $text = ($LJ::IS_DEV_SERVER && $is_gen_dmid &&
+ ($lang eq "en" ||
+ $lang eq $LJ::DEFAULT_LANG)) ?
+ $from_files->() :
+ $from_db->();
+
+ if ($vars) {
+ $text =~ s/\[\[\?([\w\-]+)\|(.+?)\]\]/resolve_plural($lang, $vars, $1, $2)/eg;
+ $text =~ s/\[\[([^\[]+?)\]\]/$vars->{$1}/g;
+ }
+
+ $LJ::_ML_USED_STRINGS{$code} = $text if $LJ::IS_DEV_SERVER;
+
+ return $text || ($LJ::IS_DEV_SERVER ? "[uhhh: $code]" : "");
+}
+
+# Loads multiple language strings at once. These strings
+# cannot however contain variables, if you have variables
+# you wouldn't be calling this anyway!
+# args: $lang, $dmid, array ref of lang codes
+sub get_text_multi
+{
+ my ($lang, $dmid, $codes) = @_;
+
+ return {} unless $codes;
+
+ $dmid = int($dmid || 1);
+ $lang ||= $LJ::DEFAULT_LANG;
+ load_lang_struct() unless $LS_CACHED;
+ ## %strings: code --> text
+ my %strings;
+
+ ## normalize the codes: all chars must be in lower case
+ ## MySQL string comparison isn't case-sensitive, but memcaches keys are.
+ ## Caller will get %strings with keys in original case.
+ ##
+ ## Final note about case:
+ ## Codes in disk .text files, mysql and bml files may be mixed-cased
+ ## Codes in memcache and %TXT_CACHE are lower-case
+ ## Codes are not case-sensitive
+
+ ## %lc_code: lower-case code --> original code
+ my %lc_codes = map { lc($_) => $_ } @$codes;
+
+ ## %memkeys: lower-case code --> memcache key
+ my %memkeys;
+ foreach my $code (keys %lc_codes) {
+ my $cache_key = "ml.${lang}.${dmid}.${code}";
+ my $text = $TXT_CACHE{$cache_key} unless $LJ::NO_ML_CACHE;
+
+ if (defined $text) {
+ $strings{ $lc_codes{$code} } = $text;
+ $LJ::_ML_USED_STRINGS{$code} = $text if $LJ::IS_DEV_SERVER;
+ } else {
+ $memkeys{$cache_key} = $code;
+ }
+ }
+
+ return \%strings unless %memkeys;
+
+ my $mem = LJ::MemCache::get_multi(keys %memkeys) || {};
+
+ ## %dbload: lower-case key --> text; text may be empty (but defined) string
+ my %dbload;
+ foreach my $cache_key (keys %memkeys) {
+ my $code = $memkeys{$cache_key};
+ my $text = $mem->{$cache_key};
+
+ if (defined $text) {
+ $strings{ $lc_codes{$code} } = $text;
+ $LJ::_ML_USED_STRINGS{$code} = $text if $LJ::IS_DEV_SERVER;
+ $TXT_CACHE{$cache_key} = $text;
+ } else {
+ # we need to cache nonexistant/empty strings because otherwise we're running a lot of queries all the time
+ # to cache nonexistant strings, value of %dbload must be defined
+ $dbload{$code} = '';
+ }
+ }
+
+ return \%strings unless %dbload;
+
+ my $l = $LN_CODE{$lang};
+
+ # This shouldn't happen!
+ die ("Unable to load language code: $lang") unless $l;
+
+ my $dbr = LJ::get_db_reader();
+ my $bind = join(',', map { '?' } keys %dbload);
+ my $sth = $dbr->prepare("SELECT i.itcode, t.text, i.visible".
+ " FROM ml_text t, ml_latest l, ml_items i".
+ " WHERE t.dmid=? AND t.txtid=l.txtid".
+ " AND l.dmid=? AND l.lnid=? AND l.itid=i.itid".
+ " AND i.dmid=? AND i.itcode IN ($bind)");
+ $sth->execute($dmid, $dmid, $l->{lnid}, $dmid, keys %dbload);
+
+ # now replace the empty strings with the defined ones that we got back from the database
+ while (my ($code, $text, $vis) = $sth->fetchrow_array) {
+ # some MySQL codes might be mixed-case
+ $dbload{ lc($code) } = $text;
+
+ # if not currently visible, then set it
+ unless ( $vis ) {
+ my $dbh = LJ::get_db_writer();
+ $dbh->do( 'UPDATE ml_items SET visible = 1 WHERE itcode = ?',
+ undef, $code );
+ }
+ }
+
+ while (my ($code, $text) = each %dbload) {
+ $strings{ $lc_codes{$code} } = $text;
+ $LJ::_ML_USED_STRINGS{$code} = $text if $LJ::IS_DEV_SERVER;
+
+ my $cache_key = "ml.${lang}.${dmid}.${code}";
+ $TXT_CACHE{$cache_key} = $text;
+ LJ::MemCache::set($cache_key, $text);
+ }
+
+ return \%strings;
+}
+
+sub get_lang_names {
+ my @langs = @_;
+ push @langs, @LJ::LANGS unless @langs;
+
+ my @list;
+
+ foreach my $code (@langs) {
+ my $l = LJ::Lang::get_lang($code);
+ next unless $l;
+
+ my $item = "langname.$code";
+ my $namethislang = BML::ml($item);
+ my $namenative = LJ::Lang::get_text($l->{'lncode'}, $item);
+
+ push @list, $code, $namenative;
+ }
+
+ return \@list;
+}
+
+sub set_lang {
+ my $lang = shift;
+
+ my $l = LJ::Lang::get_lang($lang);
+ my $remote = LJ::get_remote();
+
+ # default cookie value to set
+ my $cval = $l->{lncode} . "/" . time();
+
+ # if logged in, change userprop and make cookie expiration
+ # the same as their login expiration
+ if ($remote) {
+ $remote->set_prop("browselang", $l->{lncode});
+
+ if ($remote->{_session}->{exptype} eq 'long') {
+ $cval = [ $cval, $remote->{_session}->{timeexpire} ];
+ }
+ }
+
+ # set cookie
+ $BML::COOKIE{langpref} = $cval;
+
+ # set language through BML so it will apply immediately
+ BML::set_language($l->{lncode});
+
+ return;
+}
+
+# The translation system now supports the ability to add multiple plural forms of the word
+# given different rules in a languge. This functionality is much like the plural support
+# in the S2 styles code. To use this code you must use the BML::ml function and pass
+# the number of items as one of the variables. To make sure that you are allowing the
+# utmost compatibility for each language you should not hardcode the placement of the
+# number of items in relation to the noun. Let the translation string do this for you.
+# A translation string is in the format of, with num being the variable storing the
+# number of items.
+# =[[num]] [[?num|singular|plural1|plural2|pluralx]]
+
+sub resolve_plural {
+ my ($lang, $vars, $varname, $wordlist) = @_;
+ my $count = $vars->{$varname};
+ my @wlist = split(/\|/, $wordlist);
+ my $plural_form = plural_form($lang, $count);
+ return $wlist[$plural_form];
+}
+
+# TODO: make this faster, using AUTOLOAD and symbol tables pointing to dynamically
+# generated subs which only use $_[0] for $count.
+sub plural_form {
+ my ($lang, $count) = @_;
+ return plural_form_en($count) if $lang =~ /^en/;
+ return plural_form_ru($count) if $lang =~ /^ru/ || $lang =~ /^uk/ || $lang =~ /^be/;
+ return plural_form_fr($count) if $lang =~ /^fr/ || $lang =~ /^pt_BR/;
+ return plural_form_lt($count) if $lang =~ /^lt/;
+ return plural_form_pl($count) if $lang =~ /^pl/;
+ return plural_form_singular() if $lang =~ /^hu/ || $lang =~ /^ja/ || $lang =~ /^tr/;
+ return plural_form_lv($count) if $lang =~ /^lv/;
+ return plural_form_is($count) if $lang =~ /^is/;
+ return plural_form_en($count); # default
+}
+
+# English, Danish, German, Norwegian, Swedish, Estonian, Finnish, Greek, Hebrew, Italian, Portugese, Spanish, Esperanto
+sub plural_form_en {
+ my ($count) = shift;
+ return 0 if $count == 1;
+ return 1;
+}
+
+# French, Brazilian Portuguese
+sub plural_form_fr {
+ my ($count) = shift;
+ return 1 if $count > 1;
+ return 0;
+}
+
+# Croatian, Czech, Russian, Slovak, Ukrainian, Belarusian
+sub plural_form_ru {
+ my ($count) = shift;
+ return 0 if ($count%10 == 1 and $count%100 != 11);
+ return 1 if ($count%10 >= 2 and $count%10 <= 4 and ($count%100 < 10 or $count%100>=20));
+ return 2;
+}
+
+# Polish
+sub plural_form_pl {
+ my ($count) = shift;
+ return 0 if($count == 1);
+ return 1 if($count%10 >= 2 && $count%10 <= 4 && ($count%100 < 10 || $count%100 >= 20));
+ return 2;
+}
+
+# Lithuanian
+sub plural_form_lt {
+ my ($count) = shift;
+ return 0 if($count%10 == 1 && $count%100 != 11);
+ return 1 if ($count%10 >= 2 && ($count%100 < 10 || $count%100 >= 20));
+ return 2;
+}
+
+# Hungarian, Japanese, Korean (not supported), Turkish
+sub plural_form_singular {
+ return 0;
+}
+
+# Latvian
+sub plural_form_lv {
+ my ($count) = shift;
+ return 0 if($count%10 == 1 && $count%100 != 11);
+ return 1 if($count != 0);
+ return 2;
+}
+
+# Icelandic
+sub plural_form_is {
+ my ($count) = shift;
+ return 0 if ($count%10 == 1 and $count%100 != 11);
+ return 1;
+}
+
+1;
diff -r 0b01e0370322 -r e8d5bfb23489 cgi-bin/ljlang.pl
--- a/cgi-bin/ljlang.pl Sat Sep 12 12:14:17 2009 +0800
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,840 +0,0 @@
-#!/usr/bin/perl
-#
-
-use strict;
-use lib "$LJ::HOME/cgi-bin";
-
-use Class::Autouse qw(
- LJ::LangDatFile
- );
-
-package LJ::Lang;
-
-use constant MAXIMUM_ITCODE_LENGTH => 80;
-
-my @day_short = (qw[Sun Mon Tue Wed Thu Fri Sat]);
-my @day_long = (qw[Sunday Monday Tuesday Wednesday Thursday Friday Saturday]);
-my @month_short = (qw[Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec]);
-my @month_long = (qw[January February March April May June July August September October November December]);
-
-# For init_cvsprefixes(), langdat_file_of_lang_itcode(), and stuff.
-my @shared_cvsprefixes = qw(cvs/livejournal cvs/dw-free);
-my @local_cvsprefixes = qw(cvs/local cvs/dw-nonfree);
-my ($cvspfx_shared, $cvspfx_local);
-
-# get entire array of days and months
-sub day_list_short { return @LJ::Lang::day_short; }
-sub day_list_long { return @LJ::Lang::day_long; }
-sub month_list_short { return @LJ::Lang::month_short; }
-sub month_list_long { return @LJ::Lang::month_long; }
-
-# access individual day or month given integer
-sub day_short { return $day_short[$_[0] - 1]; }
-sub day_long { return $day_long[$_[0] - 1]; }
-sub month_short { return $month_short[$_[0] - 1]; }
-sub month_long { return $month_long[$_[0] - 1]; }
-
-# lang codes for individual day or month given integer
-sub day_short_langcode { return "date.day." . lc(LJ::Lang::day_long(@_)) . ".short"; }
-sub day_long_langcode { return "date.day." . lc(LJ::Lang::day_long(@_)) . ".long"; }
-sub month_short_langcode { return "date.month." . lc(LJ::Lang::month_long(@_)) . ".short"; }
-sub month_long_langcode { return "date.month." . lc(LJ::Lang::month_long(@_)) . ".long"; }
-
-# Translated names for individual day or month given integer. You probably want
-# these, not the ones above.
-sub day_short_ml { return LJ::Lang::ml( LJ::Lang::day_short_langcode( @_ ) ); }
-sub day_long_ml { return LJ::Lang::ml( LJ::Lang::day_long_langcode( @_ ) ); }
-sub month_short_ml { return LJ::Lang::ml( LJ::Lang::month_short_langcode( @_ ) ); }
-sub month_long_ml { return LJ::Lang::ml( LJ::Lang::month_long_langcode( @_ ) ); }
-
-## ordinal suffix
-sub day_ord {
- my $day = shift;
-
- # teens all end in 'th'
- if ($day =~ /1\d$/) { return "th"; }
-
- # otherwise endings in 1, 2, 3 are special
- if ($day % 10 == 1) { return "st"; }
- if ($day % 10 == 2) { return "nd"; }
- if ($day % 10 == 3) { return "rd"; }
-
- # everything else (0,4-9) end in "th"
- return "th";
-}
-
-sub time_format
-{
- my ($hours, $h, $m, $formatstring) = @_;
-
- if ($formatstring eq "short") {
- if ($hours == 12) {
- my $ret;
- my $ap = "a";
- if ($h == 0) { $ret .= "12"; }
- elsif ($h < 12) { $ret .= ($h+0); }
- elsif ($h == 12) { $ret .= ($h+0); $ap = "p"; }
- else { $ret .= ($h-12); $ap = "p"; }
- $ret .= sprintf(":%02d$ap", $m);
- return $ret;
- } elsif ($hours == 24) {
- return sprintf("%02d:%02d", $h, $m);
- }
- }
- return "";
-}
-
-#### ml_ stuff:
-my $LS_CACHED = 0;
-my %DM_ID = (); # id -> { type, args, dmid, langs => { => 1, => 0, => 1 } }
-my %DM_UNIQ = (); # "$type/$args" => ^^^
-my %LN_ID = (); # id -> { ..., ..., 'children' => [ $ids, .. ] }
-my %LN_CODE = (); # $code -> ^^^^
-my $LAST_ERROR;
-my %TXT_CACHE;
-
-sub last_error
-{
- return $LAST_ERROR;
-}
-
-sub set_error
-{
- $LAST_ERROR = $_[0];
- return 0;
-}
-
-sub get_lang
-{
- my $code = shift;
- load_lang_struct() unless $LS_CACHED;
- return $LN_CODE{$code};
-}
-
-sub get_lang_id
-{
- my $id = shift;
- load_lang_struct() unless $LS_CACHED;
- return $LN_ID{$id};
-}
-
-sub get_dom
-{
- my $dmcode = shift;
- load_lang_struct() unless $LS_CACHED;
- return $DM_UNIQ{$dmcode};
-}
-
-sub get_dom_id
-{
- my $dmid = shift;
- load_lang_struct() unless $LS_CACHED;
- return $DM_ID{$dmid};
-}
-
-sub get_domains
-{
- load_lang_struct() unless $LS_CACHED;
- return values %DM_ID;
-}
-
-sub get_root_lang
-{
- my $dom = shift; # from, say, get_dom
- return undef unless ref $dom eq "HASH";
-
- my $lang_override = LJ::run_hook("root_lang_override", $dom);
- return get_lang($lang_override) if $lang_override;
-
- foreach (keys %{$dom->{'langs'}}) {
- if ($dom->{'langs'}->{$_}) {
- return get_lang_id($_);
- }
- }
- return undef;
-}
-
-sub load_lang_struct
-{
- return 1 if $LS_CACHED;
- my $dbr = LJ::get_db_reader();
- return set_error("No database available") unless $dbr;
- my $sth;
-
- $sth = $dbr->prepare("SELECT dmid, type, args FROM ml_domains");
- $sth->execute;
- while (my ($dmid, $type, $args) = $sth->fetchrow_array) {
- my $uniq = $args ? "$type/$args" : $type;
- $DM_UNIQ{$uniq} = $DM_ID{$dmid} = {
- 'type' => $type, 'args' => $args, 'dmid' => $dmid,
- 'uniq' => $uniq,
- };
- }
-
- $sth = $dbr->prepare("SELECT lnid, lncode, lnname, parenttype, parentlnid FROM ml_langs");
- $sth->execute;
- while (my ($id, $code, $name, $ptype, $pid) = $sth->fetchrow_array) {
- $LN_ID{$id} = $LN_CODE{$code} = {
- 'lnid' => $id,
- 'lncode' => $code,
- 'lnname' => $name,
- 'parenttype' => $ptype,
- 'parentlnid' => $pid,
- };
- }
- foreach (values %LN_CODE) {
- next unless $_->{'parentlnid'};
- push @{$LN_ID{$_->{'parentlnid'}}->{'children'}}, $_->{'lnid'};
- }
-
- $sth = $dbr->prepare("SELECT lnid, dmid, dmmaster FROM ml_langdomains");
- $sth->execute;
- while (my ($lnid, $dmid, $dmmaster) = $sth->fetchrow_array) {
- $DM_ID{$dmid}->{'langs'}->{$lnid} = $dmmaster;
- }
-
- $LS_CACHED = 1;
-}
-
-sub init_cvsprefixes {
- return if defined($cvspfx_shared);
-
- foreach my $p (@shared_cvsprefixes) {
- if (-d "$LJ::HOME/$p") {
- $cvspfx_shared = $p;
- last;
- }
- }
- $cvspfx_shared ||= "";
-
- foreach my $p (@local_cvsprefixes) {
- if (-d "$LJ::HOME/$p") {
- $cvspfx_local = $p;
- last;
- }
- }
- $cvspfx_local ||= "";
-}
-
-sub langdat_file_of_lang_itcode
-{
- my ($lang, $itcode, $want_cvs) = @_;
-
- my $langdat_file = LJ::Lang::relative_langdat_file_of_lang_itcode($lang, $itcode);
- my $cvs_extra = "";
- if ($want_cvs) {
- init_cvsprefixes();
- if ($lang eq "en") {
- $cvs_extra = "/$cvspfx_shared";
- } else {
- $cvs_extra = "/$cvspfx_local";
- }
- }
- return "$LJ::HOME$cvs_extra/$langdat_file";
-}
-
-sub relative_langdat_file_of_lang_itcode
-{
- my ($lang, $itcode) = @_;
-
- my $root_lang = "en";
- my $root_lang_local = $LJ::DEFAULT_LANG;
-
- my $base_file = "bin/upgrading/$lang\.dat";
-
- # not a root or root_local lang, just return base file location
- unless ($lang eq $root_lang || $lang eq $root_lang_local) {
- return $base_file;
- }
-
- my $is_local = $lang eq $root_lang_local;
-
- # is this a filename-based itcode?
- if ($itcode =~ m!^(/.+\.bml)!) {
- my $file = $1;
-
- # given the filename of this itcode and the current
- # source, what langdat file should we use?
- my $langdat_file = "htdocs$file\.text";
- $langdat_file .= $is_local ? ".local" : "";
- return $langdat_file;
- }
-
- # not a bml file, goes into base .dat file
- return $base_file;
-}
-
-sub itcode_for_langdat_file {
- my ($langdat_file, $itcode) = @_;
-
- # non-bml itcode, return full itcode path
- unless ($langdat_file =~ m!^/.+\.bml\.text(?:\.local)?$!) {
- return $itcode;
- }
-
- # bml itcode, strip filename and return
- if ($itcode =~ m!^/.+\.bml(\..+)!) {
- return $1;
- }
-
- # fallback -- full $itcode
- return $itcode;
-}
-
-sub get_chgtime_unix
-{
- my ($lncode, $dmid, $itcode) = @_;
- load_lang_struct() unless $LS_CACHED;
-
- $dmid = int($dmid || 1);
-
- my $l = get_lang($lncode) or return "No lang info for lang $lncode";
- my $lnid = $l->{'lnid'}
- or die "Could not get lang_id for lang $lncode";
-
- my $itid = LJ::Lang::get_itemid($dmid, $itcode)
- or return 0;
-
- my $dbr = LJ::get_db_reader();
- $dmid += 0;
- my $chgtime = $dbr->selectrow_array("SELECT chgtime FROM ml_latest WHERE dmid=? AND itid=? AND lnid=?",
- undef, $dmid, $itid, $lnid);
- die $dbr->errstr if $dbr->err;
- return $chgtime ? LJ::mysqldate_to_time($chgtime) : 0;
-}
-
-sub get_itemid
-{
- &LJ::nodb;
- my ($dmid, $itcode, $opts) = @_;
- load_lang_struct() unless $LS_CACHED;
-
- if (length $itcode > MAXIMUM_ITCODE_LENGTH) {
- warn "'$itcode' exceeds maximum code length, truncating to " . MAXIMUM_ITCODE_LENGTH . " symbols";
- $itcode = substr($itcode, 0, MAXIMUM_ITCODE_LENGTH);
- }
-
- my $dbr = LJ::get_db_reader();
- $dmid += 0;
- my $itid = $dbr->selectrow_array("SELECT itid FROM ml_items WHERE dmid=$dmid AND itcode=?", undef, $itcode);
- return $itid if defined $itid;
-
- my $dbh = LJ::get_db_writer();
- return 0 unless $dbh;
-
- # allocate a new id
- LJ::get_lock($dbh, 'global', 'mlitem_dmid') || return 0;
- $itid = $dbh->selectrow_array("SELECT MAX(itid)+1 FROM ml_items WHERE dmid=?", undef, $dmid);
- $itid ||= 1; # if the table is empty, NULL+1 == NULL
- $dbh->do("INSERT INTO ml_items (dmid, itid, itcode, notes) ".
- "VALUES (?, ?, ?, ?)", undef, $dmid, $itid, $itcode, $opts->{'notes'});
- LJ::release_lock($dbh, 'global', 'mlitem_dmid');
-
- if ($dbh->err) {
- return $dbh->selectrow_array("SELECT itid FROM ml_items WHERE dmid=$dmid AND itcode=?",
- undef, $itcode);
- }
- return $itid;
-}
-
-# this is called when editing text from a web UI.
-# first try and run a local hook to save the text,
-# if that fails then just call set_text
-
-# returns ($success, $responsemsg) where responsemsg can be output
-# from whatever saves the text
-sub web_set_text {
- my ($dmid, $lncode, $itcode, $text, $opts) = @_;
-
- my $resp = '';
- my $hook_ran = 0;
-
- if (LJ::are_hooks('web_set_text')) {
- $hook_ran = LJ::run_hook('web_set_text', $dmid, $lncode, $itcode, $text, $opts);
- }
-
- # save in the db
- my $save_success = LJ::Lang::set_text($dmid, $lncode, $itcode, $text, $opts);
- $resp = LJ::Lang::last_error() unless $save_success;
- warn $resp if ! $save_success && $LJ::IS_DEV_SERVER;
-
- return ($save_success, $resp);
-}
-
-sub set_text
-{
- &LJ::nodb;
- my ($dmid, $lncode, $itcode, $text, $opts) = @_;
- load_lang_struct() unless $LS_CACHED;
-
- my $l = $LN_CODE{$lncode} or return set_error("Language not defined.");
- my $lnid = $l->{'lnid'};
- $dmid += 0;
-
- # is this domain/language request even possible?
- return set_error("Bogus domain")
- unless exists $DM_ID{$dmid};
- return set_error("Bogus lang for that domain")
- unless exists $DM_ID{$dmid}->{'langs'}->{$lnid};
-
- my $itid = get_itemid($dmid, $itcode, { 'notes' => $opts->{'notes'}});
- return set_error("Couldn't allocate itid.") unless $itid;
-
- my $dbh = LJ::get_db_writer();
- my $txtid = 0;
-
- my $oldtextid = $dbh->selectrow_array("SELECT txtid FROM ml_text WHERE lnid=? AND dmid=? AND itid=?", undef, $lnid, $dmid, $itid);
-
- if (defined $text) {
- my $userid = $opts->{'userid'} + 0;
- # Strip bad characters
- $text =~ s/\r//;
- my $qtext = $dbh->quote($text);
- LJ::get_lock( $dbh, 'global', 'ml_text_txtid' ) || return 0;
- $txtid = $dbh->selectrow_array("SELECT MAX(txtid)+1 FROM ml_text WHERE dmid=?", undef, $dmid);
- $txtid ||= 1;
- $dbh->do("INSERT INTO ml_text (dmid, txtid, lnid, itid, text, userid) ".
- "VALUES ($dmid, $txtid, $lnid, $itid, $qtext, $userid)");
- LJ::release_lock( $dbh, 'global', 'ml_text_txtid' );
- return set_error("Error inserting ml_text: ".$dbh->errstr) if $dbh->err;
- }
- if ($opts->{'txtid'}) {
- $txtid = $opts->{'txtid'}+0;
- }
-
- my $staleness = $opts->{'staleness'}+0;
- $dbh->do("REPLACE INTO ml_latest (lnid, dmid, itid, txtid, chgtime, staleness) ".
- "VALUES ($lnid, $dmid, $itid, $txtid, NOW(), $staleness)");
- return set_error("Error inserting ml_latest: ".$dbh->errstr) if $dbh->err;
- LJ::MemCache::set("ml.${lncode}.${dmid}.${itcode}", $text) if defined $text;
-
- my $langids;
- {
- my $vals;
- my $rec = sub {
- my $l = shift;
- my $rec = shift;
- foreach my $cid (@{$l->{'children'}}) {
- my $clid = $LN_ID{$cid};
- if ($opts->{'childrenlatest'}) {
- my $stale = $clid->{'parenttype'} eq "diff" ? 3 : 0;
- $vals .= "," if $vals;
- $vals .= "($cid, $dmid, $itid, $txtid, NOW(), $stale)";
- }
- $langids .= "," if $langids;
- $langids .= $cid+0;
- LJ::MemCache::delete("ml.$clid->{'lncode'}.${dmid}.${itcode}");
- $rec->($clid, $rec);
- }
- };
- $rec->($l, $rec);
-
- # set descendants to use this mapping
- $dbh->do("INSERT IGNORE INTO ml_latest (lnid, dmid, itid, txtid, chgtime, staleness) ".
- "VALUES $vals") if $vals;
-
- # update languages that have no translation yet
- if ($oldtextid) {
- $dbh->do("UPDATE ml_latest SET txtid=$txtid WHERE dmid=$dmid ".
- "AND lnid IN ($langids) AND itid=$itid AND txtid=$oldtextid") if $langids;
- } else {
- $dbh->do("UPDATE ml_latest SET txtid=$txtid WHERE dmid=$dmid ".
- "AND lnid IN ($langids) AND itid=$itid AND staleness >= 3") if $langids;
- }
- }
-
- if ($opts->{'changeseverity'} && $langids) {
- my $newstale = $opts->{'changeseverity'} == 2 ? 2 : 1;
- $dbh->do("UPDATE ml_latest SET staleness=$newstale WHERE lnid IN ($langids) AND ".
- "dmid=$dmid AND itid=$itid AND txtid<>$txtid AND staleness < $newstale");
- }
-
- return 1;
-}
-
-sub remove_text {
- my ($dmid, $itcode, $lncode) = @_;
-
- my $dbh = LJ::get_db_writer();
-
- my $itid = $dbh->selectrow_array("SELECT itid FROM ml_items WHERE dmid=? AND itcode=?",
- undef, $dmid, $itcode);
- die "Unknown item code $itcode." unless $itid;
-
- # need to delete everything from: ml_items ml_latest ml_text
-
- $dbh->do("DELETE FROM ml_items WHERE dmid=? AND itid=?",
- undef, $dmid, $itid);
-
- my @txtids = ();
- my $sth = $dbh->prepare("SELECT txtid FROM ml_latest WHERE dmid=? AND itid=?");
- $sth->execute($dmid, $itid);
- while (my $txtid = $sth->fetchrow_array) {
- push @txtids, $txtid;
- }
-
- $dbh->do("DELETE FROM ml_latest WHERE dmid=? AND itid=?",
- undef, $dmid, $itid);
-
- my $txtid_bind = join(",", map { "?" } @txtids);
- $dbh->do("DELETE FROM ml_text WHERE dmid=? AND txtid IN ($txtid_bind)",
- undef, $dmid, @txtids);
-
- # delete from memcache if lncode is defined
- LJ::MemCache::delete("ml.${lncode}.${dmid}.${itcode}") if $lncode;
-
- return 1;
-}
-
-sub get_effective_lang {
-
- my $lang;
- if (LJ::is_web_context()) {
- $lang = BML::get_language();
- }
- if (my $remote = LJ::get_remote()) {
- # we have a user; try their browse language
- $lang ||= $remote->prop("browselang");
- }
-
- # did we get a valid language code?
- if ($lang && $LN_CODE{$lang}) {
- return $lang;
- }
-
- # had no language code, or invalid. return default
- return $LJ::DEFAULT_LANG;
-}
-
-sub ml {
- my ($code, $vars) = @_;
-
- if (LJ::is_web_context()) {
- # this means we should use BML::ml and not do our own handling
- my $text = BML::ml($code, $vars);
- $LJ::_ML_USED_STRINGS{$code} = $text if $LJ::IS_DEV_SERVER;
- return $text;
- }
-
- my $lang = LJ::Lang::get_effective_lang();
- return get_text($lang, $code, undef, $vars);
-}
-
-sub string_exists {
- my ($code, $vars) = @_;
-
- my $string = LJ::Lang::ml($code, $vars);
- return LJ::Lang::is_missing_string($string) ? 0 : 1;
-}
-
-# LJ::Lang::ml will return a number of values for "invalid string"
-# -- this function will tell you if the value is one of
-# those values. gross.
-sub is_missing_string {
- my $string = shift;
-
- return ( $string eq "" ||
- $string =~ /^\[missing string/ ||
- $string =~ /^\[uhhh:/ ) ? 1 : 0;
-}
-
-sub get_text
-{
- my ($lang, $code, $dmid, $vars) = @_;
- $lang ||= $LJ::DEFAULT_LANG;
-
- my $from_db = sub {
- my $text = get_text_multi($lang, $dmid, [ $code ]);
- return $text->{$code};
- };
-
- my $from_files = sub {
- my ($localcode, @files);
- if ($code =~ m!^(/.+\.bml)(\..+)!) {
- my $file;
- ($file, $localcode) = ("$LJ::HTDOCS$1", $2);
- @files = ("$file.text.local", "$file.text");
- } else {
- $localcode = $code;
- @files = ("$LJ::HOME/bin/upgrading/$LJ::DEFAULT_LANG.dat",
- "$LJ::HOME/bin/upgrading/en.dat");
- }
-
- foreach my $tf (@files) {
- next unless -e $tf;
-
- # compare file modtime to when the string was updated in the DB.
- # whichever is newer is authoritative
- my $fmodtime = (stat $tf)[9];
- my $dbmodtime = LJ::Lang::get_chgtime_unix($lang, $dmid, $code);
- return $from_db->() if ! $fmodtime || $dbmodtime > $fmodtime;
-
- my $ldf = $LJ::REQ_LANGDATFILE{$tf} ||= LJ::LangDatFile->new($tf);
- my $val = $ldf->value($localcode);
- return $val if $val;
- }
- return "[missing string $code]";
- };
-
- my $gen_mld = LJ::Lang::get_dom('general');
- my $is_gen_dmid = defined $dmid ? $dmid == $gen_mld->{dmid} : 1;
- my $text = ($LJ::IS_DEV_SERVER && $is_gen_dmid &&
- ($lang eq "en" ||
- $lang eq $LJ::DEFAULT_LANG)) ?
- $from_files->() :
- $from_db->();
-
- if ($vars) {
- $text =~ s/\[\[\?([\w\-]+)\|(.+?)\]\]/resolve_plural($lang, $vars, $1, $2)/eg;
- $text =~ s/\[\[([^\[]+?)\]\]/$vars->{$1}/g;
- }
-
- $LJ::_ML_USED_STRINGS{$code} = $text if $LJ::IS_DEV_SERVER;
-
- return $text || ($LJ::IS_DEV_SERVER ? "[uhhh: $code]" : "");
-}
-
-# Loads multiple language strings at once. These strings
-# cannot however contain variables, if you have variables
-# you wouldn't be calling this anyway!
-# args: $lang, $dmid, array ref of lang codes
-sub get_text_multi
-{
- my ($lang, $dmid, $codes) = @_;
-
- return {} unless $codes;
-
- $dmid = int($dmid || 1);
- $lang ||= $LJ::DEFAULT_LANG;
- load_lang_struct() unless $LS_CACHED;
- ## %strings: code --> text
- my %strings;
-
- ## normalize the codes: all chars must be in lower case
- ## MySQL string comparison isn't case-sensitive, but memcaches keys are.
- ## Caller will get %strings with keys in original case.
- ##
- ## Final note about case:
- ## Codes in disk .text files, mysql and bml files may be mixed-cased
- ## Codes in memcache and %TXT_CACHE are lower-case
- ## Codes are not case-sensitive
-
- ## %lc_code: lower-case code --> original code
- my %lc_codes = map { lc($_) => $_ } @$codes;
-
- ## %memkeys: lower-case code --> memcache key
- my %memkeys;
- foreach my $code (keys %lc_codes) {
- my $cache_key = "ml.${lang}.${dmid}.${code}";
- my $text = $TXT_CACHE{$cache_key} unless $LJ::NO_ML_CACHE;
-
- if (defined $text) {
- $strings{ $lc_codes{$code} } = $text;
- $LJ::_ML_USED_STRINGS{$code} = $text if $LJ::IS_DEV_SERVER;
- } else {
- $memkeys{$cache_key} = $code;
- }
- }
-
- return \%strings unless %memkeys;
-
- my $mem = LJ::MemCache::get_multi(keys %memkeys) || {};
-
- ## %dbload: lower-case key --> text; text may be empty (but defined) string
- my %dbload;
- foreach my $cache_key (keys %memkeys) {
- my $code = $memkeys{$cache_key};
- my $text = $mem->{$cache_key};
-
- if (defined $text) {
- $strings{ $lc_codes{$code} } = $text;
- $LJ::_ML_USED_STRINGS{$code} = $text if $LJ::IS_DEV_SERVER;
- $TXT_CACHE{$cache_key} = $text;
- } else {
- # we need to cache nonexistant/empty strings because otherwise we're running a lot of queries all the time
- # to cache nonexistant strings, value of %dbload must be defined
- $dbload{$code} = '';
- }
- }
-
- return \%strings unless %dbload;
-
- my $l = $LN_CODE{$lang};
-
- # This shouldn't happen!
- die ("Unable to load language code: $lang") unless $l;
-
- my $dbr = LJ::get_db_reader();
- my $bind = join(',', map { '?' } keys %dbload);
- my $sth = $dbr->prepare("SELECT i.itcode, t.text, i.visible".
- " FROM ml_text t, ml_latest l, ml_items i".
- " WHERE t.dmid=? AND t.txtid=l.txtid".
- " AND l.dmid=? AND l.lnid=? AND l.itid=i.itid".
- " AND i.dmid=? AND i.itcode IN ($bind)");
- $sth->execute($dmid, $dmid, $l->{lnid}, $dmid, keys %dbload);
-
- # now replace the empty strings with the defined ones that we got back from the database
- while (my ($code, $text, $vis) = $sth->fetchrow_array) {
- # some MySQL codes might be mixed-case
- $dbload{ lc($code) } = $text;
-
- # if not currently visible, then set it
- unless ( $vis ) {
- my $dbh = LJ::get_db_writer();
- $dbh->do( 'UPDATE ml_items SET visible = 1 WHERE itcode = ?',
- undef, $code );
- }
- }
-
- while (my ($code, $text) = each %dbload) {
- $strings{ $lc_codes{$code} } = $text;
- $LJ::_ML_USED_STRINGS{$code} = $text if $LJ::IS_DEV_SERVER;
-
- my $cache_key = "ml.${lang}.${dmid}.${code}";
- $TXT_CACHE{$cache_key} = $text;
- LJ::MemCache::set($cache_key, $text);
- }
-
- return \%strings;
-}
-
-sub get_lang_names {
- my @langs = @_;
- push @langs, @LJ::LANGS unless @langs;
-
- my @list;
-
- foreach my $code (@langs) {
- my $l = LJ::Lang::get_lang($code);
- next unless $l;
-
- my $item = "langname.$code";
- my $namethislang = BML::ml($item);
- my $namenative = LJ::Lang::get_text($l->{'lncode'}, $item);
-
- push @list, $code, $namenative;
- }
-
- return \@list;
-}
-
-sub set_lang {
- my $lang = shift;
-
- my $l = LJ::Lang::get_lang($lang);
- my $remote = LJ::get_remote();
-
- # default cookie value to set
- my $cval = $l->{lncode} . "/" . time();
-
- # if logged in, change userprop and make cookie expiration
- # the same as their login expiration
- if ($remote) {
- $remote->set_prop("browselang", $l->{lncode});
-
- if ($remote->{_session}->{exptype} eq 'long') {
- $cval = [ $cval, $remote->{_session}->{timeexpire} ];
- }
- }
-
- # set cookie
- $BML::COOKIE{langpref} = $cval;
-
- # set language through BML so it will apply immediately
- BML::set_language($l->{lncode});
-
- return;
-}
-
-# The translation system now supports the ability to add multiple plural forms of the word
-# given different rules in a languge. This functionality is much like the plural support
-# in the S2 styles code. To use this code you must use the BML::ml function and pass
-# the number of items as one of the variables. To make sure that you are allowing the
-# utmost compatibility for each language you should not hardcode the placement of the
-# number of items in relation to the noun. Let the translation string do this for you.
-# A translation string is in the format of, with num being the variable storing the
-# number of items.
-# =[[num]] [[?num|singular|plural1|plural2|pluralx]]
-
-sub resolve_plural {
- my ($lang, $vars, $varname, $wordlist) = @_;
- my $count = $vars->{$varname};
- my @wlist = split(/\|/, $wordlist);
- my $plural_form = plural_form($lang, $count);
- return $wlist[$plural_form];
-}
-
-# TODO: make this faster, using AUTOLOAD and symbol tables pointing to dynamically
-# generated subs which only use $_[0] for $count.
-sub plural_form {
- my ($lang, $count) = @_;
- return plural_form_en($count) if $lang =~ /^en/;
- return plural_form_ru($count) if $lang =~ /^ru/ || $lang =~ /^uk/ || $lang =~ /^be/;
- return plural_form_fr($count) if $lang =~ /^fr/ || $lang =~ /^pt_BR/;
- return plural_form_lt($count) if $lang =~ /^lt/;
- return plural_form_pl($count) if $lang =~ /^pl/;
- return plural_form_singular() if $lang =~ /^hu/ || $lang =~ /^ja/ || $lang =~ /^tr/;
- return plural_form_lv($count) if $lang =~ /^lv/;
- return plural_form_is($count) if $lang =~ /^is/;
- return plural_form_en($count); # default
-}
-
-# English, Danish, German, Norwegian, Swedish, Estonian, Finnish, Greek, Hebrew, Italian, Portugese, Spanish, Esperanto
-sub plural_form_en {
- my ($count) = shift;
- return 0 if $count == 1;
- return 1;
-}
-
-# French, Brazilian Portuguese
-sub plural_form_fr {
- my ($count) = shift;
- return 1 if $count > 1;
- return 0;
-}
-
-# Croatian, Czech, Russian, Slovak, Ukrainian, Belarusian
-sub plural_form_ru {
- my ($count) = shift;
- return 0 if ($count%10 == 1 and $count%100 != 11);
- return 1 if ($count%10 >= 2 and $count%10 <= 4 and ($count%100 < 10 or $count%100>=20));
- return 2;
-}
-
-# Polish
-sub plural_form_pl {
- my ($count) = shift;
- return 0 if($count == 1);
- return 1 if($count%10 >= 2 && $count%10 <= 4 && ($count%100 < 10 || $count%100 >= 20));
- return 2;
-}
-
-# Lithuanian
-sub plural_form_lt {
- my ($count) = shift;
- return 0 if($count%10 == 1 && $count%100 != 11);
- return 1 if ($count%10 >= 2 && ($count%100 < 10 || $count%100 >= 20));
- return 2;
-}
-
-# Hungarian, Japanese, Korean (not supported), Turkish
-sub plural_form_singular {
- return 0;
-}
-
-# Latvian
-sub plural_form_lv {
- my ($count) = shift;
- return 0 if($count%10 == 1 && $count%100 != 11);
- return 1 if($count != 0);
- return 2;
-}
-
-# Icelandic
-sub plural_form_is {
- my ($count) = shift;
- return 0 if ($count%10 == 1 and $count%100 != 11);
- return 1;
-}
-
-1;
diff -r 0b01e0370322 -r e8d5bfb23489 cgi-bin/modperl_subs.pl
--- a/cgi-bin/modperl_subs.pl Sat Sep 12 12:14:17 2009 +0800
+++ b/cgi-bin/modperl_subs.pl Sat Sep 12 05:33:57 2009 +0000
@@ -62,7 +62,7 @@ use MIME::Words;
# Try to load DBI::Profile
BEGIN { $LJ::HAVE_DBI_PROFILE = eval "use DBI::Profile (); 1;" }
-require "ljlang.pl";
+use LJ::Lang;
require "htmlcontrols.pl";
require "weblib.pl";
require "imageconf.pl";
diff -r 0b01e0370322 -r e8d5bfb23489 t/commafy.t
--- a/t/commafy.t Sat Sep 12 12:14:17 2009 +0800
+++ b/t/commafy.t Sat Sep 12 05:33:57 2009 +0000
@@ -4,7 +4,7 @@ use Test::More 'no_plan';
use Test::More 'no_plan';
use lib "$ENV{LJHOME}/cgi-bin";
require 'ljlib.pl';
-require 'ljlang.pl';
+use LJ::Lang;
is(LJ::commafy("lalala"), "lalala");
is(LJ::commafy("1"), "1");
diff -r 0b01e0370322 -r e8d5bfb23489 t/console-faqcat.t
--- a/t/console-faqcat.t Sat Sep 12 12:14:17 2009 +0800
+++ b/t/console-faqcat.t Sat Sep 12 05:33:57 2009 +0000
@@ -3,8 +3,8 @@ use Test::More tests => 15;
use Test::More tests => 15;
use lib "$ENV{LJHOME}/cgi-bin";
require 'ljlib.pl';
-require 'ljlang.pl';
BEGIN { $LJ::HOME = $ENV{LJHOME}; }
+use LJ::Lang;
use LJ::Console;
use LJ::Test qw (temp_user);
local $LJ::T_NO_COMMAND_PRINT = 1;
diff -r 0b01e0370322 -r e8d5bfb23489 t/faq.t
--- a/t/faq.t Sat Sep 12 12:14:17 2009 +0800
+++ b/t/faq.t Sat Sep 12 05:33:57 2009 +0000
@@ -5,7 +5,7 @@ use lib "$ENV{LJHOME}/cgi-bin";
use lib "$ENV{LJHOME}/cgi-bin";
require 'ljlib.pl';
-require 'ljlang.pl';
+use LJ::Lang;
use LJ::Faq;
use LJ::Test qw(memcache_stress);
diff -r 0b01e0370322 -r e8d5bfb23489 t/settings.t
--- a/t/settings.t Sat Sep 12 12:14:17 2009 +0800
+++ b/t/settings.t Sat Sep 12 05:33:57 2009 +0000
@@ -4,7 +4,7 @@ use Test::More;
use Test::More;
use lib "$ENV{LJHOME}/cgi-bin";
require 'ljlib.pl';
-require 'ljlang.pl';
+use LJ::Lang;
#plan tests => ;
plan skip_all => 'Fix this test! LJ/Setting/WebpageURL.pm is missing';
--------------------------------------------------------------------------------