Committer: ailyin
LJSUP-9344 (clean up output of texttool.pl): tidy it up, no functional changesU trunk/bin/upgrading/texttool.pl
Modified: trunk/bin/upgrading/texttool.pl
===================================================================
--- trunk/bin/upgrading/texttool.pl 2011-07-27 03:57:02 UTC (rev 19534)
+++ trunk/bin/upgrading/texttool.pl 2011-07-27 04:46:15 UTC (rev 19535)
@@ -14,26 +14,25 @@
my $opt_only;
my $opt_verbose;
my $opt_all; ## load texts for all known languages
-my $force_override = 0;
-my $opt_force_popstruct = 0;
+my $force_override = 0;
+my $opt_force_popstruct = 0;
my $opt_process_deadphrases = 0;
GetOptions(
- "help" => \$opt_help,
- "local-lang=s" => \$opt_local_lang,
- "verbose" => \$opt_verbose,
- "only=s" => \$opt_only,
- "all" => \$opt_all,
- "force-override" => \$force_override,
- 'force-popstruct' => \$opt_force_popstruct,
- 'process-deadphrases' => \$opt_process_deadphrases,
- ) or die "can't parse arguments";
+ "help" => \$opt_help,
+ "local-lang=s" => \$opt_local_lang,
+ "verbose" => \$opt_verbose,
+ "only=s" => \$opt_only,
+ "all" => \$opt_all,
+ "force-override" => \$force_override,
+ 'force-popstruct' => \$opt_force_popstruct,
+ 'process-deadphrases' => \$opt_process_deadphrases,
+) or die "can't parse arguments";
my $mode = shift @ARGV;
help() if $opt_help or not defined $mode;
-sub help
-{
+sub help {
die "Usage: texttool.pl <command>
Where 'command' is one of:
@@ -79,94 +78,112 @@
}
## make sure $LJHOME is set so we can load & run everything
-unless (-d $ENV{'LJHOME'}) {
- die "LJHOME environment variable is not set, or is not a directory.\n".
- "You must fix this before you can run this database update script.";
+unless ( -d $ENV{'LJHOME'} ) {
+ die "LJHOME environment variable is not set, or is not a directory.\n"
+ . "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";
-require "$ENV{'LJHOME'}/cgi-bin/weblib.pl";
-my %dom_id; # number -> {}
-my %dom_code; # name -> {}
-my %lang_id; # number -> {}
-my %lang_code; # name -> {}
+require 'ljlib.pl';
+require 'ljlang.pl';
+require 'weblib.pl';
+
+my %dom_id; # number -> {}
+my %dom_code; # name -> {}
+my %lang_id; # number -> {}
+my %lang_code; # name -> {}
my @lang_domains;
my $set = sub {
- my ($hash, $key, $val, $errmsg) = @_;
+ my ( $hash, $key, $val, $errmsg ) = @_;
die "$errmsg$key\n" if exists $hash->{$key};
$hash->{$key} = $val;
};
-foreach my $scope ("general", "local")
-{
+foreach my $scope ( "general", "local" ) {
my $file = $scope eq "general" ? "text.dat" : "text-local.dat";
my $ffile = "$ENV{'LJHOME'}/bin/upgrading/$file";
- unless (-e $ffile) {
+ unless ( -e $ffile ) {
next if $scope eq "local";
die "$file file not found; odd: did you delete it?\n";
}
- open (F, $ffile) or die "Can't open file: $file: $!\n";
+ open( F, $ffile ) or die "Can't open file: $file: $!\n";
while (<F>) {
- s/\s+$//; s/^\#.+//;
+ s/\s+$//;
+ s/^\#.+//;
next unless /\S/;
- my @vals = split(/:/, $_);
+ my @vals = split( /:/, $_ );
my $what = shift @vals;
# language declaration
- if ($what eq "lang") {
+ if ( $what eq "lang" ) {
my $lang = {
- 'scope' => $scope,
- 'lnid' => $vals[0],
- 'lncode' => $vals[1],
- 'lnname' => $vals[2],
- 'parentlnid' => 0, # default. changed later.
+ 'scope' => $scope,
+ 'lnid' => $vals[0],
+ 'lncode' => $vals[1],
+ 'lnname' => $vals[2],
+ 'parentlnid' => 0, # default. changed later.
'parenttype' => 'diff',
};
$lang->{'parenttype'} = $vals[3] if defined $vals[3];
- if (defined $vals[4]) {
- unless (exists $lang_code{$vals[4]}) {
- die "Can't declare language $lang->{'lncode'} with missing parent language $vals[4].\n";
+ if ( defined $vals[4] ) {
+ unless ( exists $lang_code{ $vals[4] } ) {
+ die "Can't declare language $lang->{'lncode'} "
+ . "with missing parent language $vals[4].\n";
}
- $lang->{'parentlnid'} = $lang_code{$vals[4]}->{'lnid'};
+ $lang->{'parentlnid'} = $lang_code{ $vals[4] }->{'lnid'};
}
- $set->(\%lang_id, $lang->{'lnid'}, $lang, "Language already defined with ID: ");
- $set->(\%lang_code, $lang->{'lncode'}, $lang, "Language already defined with code: ");
+ $set->(
+ \%lang_id, $lang->{'lnid'}, $lang,
+ "Language already defined with ID: "
+ );
+ $set->(
+ \%lang_code, $lang->{'lncode'}, $lang,
+ "Language already defined with code: "
+ );
}
# domain declaration
- if ($what eq "domain") {
+ if ( $what eq "domain" ) {
my $dcode = $vals[1];
- my ($type, $args) = split(m!/!, $dcode);
+ my ( $type, $args ) = split( m!/!, $dcode );
my $dom = {
'scope' => $scope,
- 'dmid' => $vals[0],
- 'type' => $type,
- 'args' => $args || "",
+ 'dmid' => $vals[0],
+ 'type' => $type,
+ 'args' => $args || "",
};
- $set->(\%dom_id, $dom->{'dmid'}, $dom, "Domain already defined with ID: ");
- $set->(\%dom_code, $dcode, $dom, "Domain already defined with parameters: ");
+ $set->(
+ \%dom_id, $dom->{'dmid'}, $dom,
+ "Domain already defined with ID: "
+ );
+ $set->(
+ \%dom_code, $dcode, $dom,
+ "Domain already defined with parameters: "
+ );
}
# langdomain declaration
- if ($what eq "langdomain") {
+ if ( $what eq "langdomain" ) {
my $ld = {
- 'lnid' =>
- (exists $lang_code{$vals[0]} ? $lang_code{$vals[0]}->{'lnid'} :
- die "Undefined language: $vals[0]\n"),
- 'dmid' =>
- (exists $dom_code{$vals[1]} ? $dom_code{$vals[1]}->{'dmid'} :
- die "Undefined domain: $vals[1]\n"),
+ 'lnid' => (
+ exists $lang_code{ $vals[0] }
+ ? $lang_code{ $vals[0] }->{'lnid'}
+ : die "Undefined language: $vals[0]\n"
+ ),
+ 'dmid' => (
+ exists $dom_code{ $vals[1] }
+ ? $dom_code{ $vals[1] }->{'dmid'}
+ : die "Undefined domain: $vals[1]\n"
+ ),
'dmmaster' => $vals[2] ? "1" : "0",
- };
+ };
push @lang_domains, $ld;
}
}
close F;
}
-if ($mode eq "check") {
+if ( $mode eq "check" ) {
print "all good.\n";
exit 0;
}
@@ -181,52 +198,74 @@
# indenter
my $idlev = 0;
-my $out = sub {
+my $out = sub {
my @args = @_;
while (@args) {
my $a = shift @args;
- if ($a eq "+") { $idlev++; }
- elsif ($a eq "-") { $idlev--; }
- elsif ($a eq "x") { $a = shift @args; die " "x$idlev . $a . "\n"; }
- else { print " "x$idlev, $a, "\n"; }
+ if ( $a eq "+" ) { $idlev++; }
+ elsif ( $a eq "-" ) { $idlev--; }
+ elsif ( $a eq "x" ) {
+ $a = shift @args;
+ die " " x $idlev . $a . "\n";
+ }
+ else { print " " x $idlev, $a, "\n"; }
}
};
-my @good = qw(load popstruct poptext dumptext dumptextcvs newitems wipedb makeusable copyfaq remove
- wipecrumbs loadcrumbs);
+my @good = qw(
+ load popstruct poptext dumptext dumptextcvs newitems wipedb
+ makeusable copyfaq remove wipecrumbs loadcrumbs
+);
-popstruct() if $mode eq "popstruct" or $mode eq "load";
-poptext(@ARGV) if $mode eq "poptext" or $mode eq "load";
-copyfaq() if $mode eq "copyfaq" or $mode eq "load";
-loadcrumbs() if $mode eq "loadcrumbs" or $mode eq "load";
-makeusable() if $mode eq "makeusable" or $mode eq "load";
-dumptext($1, @ARGV) if $mode =~ /^dumptext(cvs)?$/;
-newitems() if $mode eq "newitems";
-wipedb() if $mode eq "wipedb";
+popstruct() if $mode eq "popstruct" or $mode eq "load";
+poptext(@ARGV) if $mode eq "poptext" or $mode eq "load";
+copyfaq() if $mode eq "copyfaq" or $mode eq "load";
+loadcrumbs() if $mode eq "loadcrumbs" or $mode eq "load";
+makeusable() if $mode eq "makeusable" or $mode eq "load";
+dumptext( $1, @ARGV ) if $mode =~ /^dumptext(cvs)?$/;
+newitems() if $mode eq "newitems";
+wipedb() if $mode eq "wipedb";
wipecrumbs() if $mode eq "wipecrumbs";
remove(@ARGV) if $mode eq "remove" and scalar(@ARGV) == 2;
help() unless grep { $mode eq $_ } @good;
exit 0;
-sub makeusable
-{
- $out->("Making usable...", '+');
+sub makeusable {
+ $out->( "Making usable...", '+' );
my $rec = sub {
- my ($lang, $rec) = @_;
+ my ( $lang, $rec ) = @_;
my $l = $lang_code{$lang};
- $out->("x", "Bogus language: $lang") unless $l;
- my @children = grep { $_->{'parentlnid'} == $l->{'lnid'} } values %lang_code;
- foreach my $cl ( sort { $a->{'lncode'} cmp $b->{'lncode'} } @children ) {
+ $out->( "x", "Bogus language: $lang" ) unless $l;
+
+ my @children = sort { $a->{'lncode'} cmp $b->{'lncode'} }
+ grep { $_->{'parentlnid'} == $l->{'lnid'} } values %lang_code;
+
+ foreach my $cl (@children) {
my %need;
- # push downwards everything that has some valid text in some language (< 4)
- $sth = $dbh->prepare("SELECT dmid, itid, txtid FROM ml_latest WHERE lnid=$l->{'lnid'} AND staleness < 4");
+
+ # push downwards everything that has some valid text in
+ # some language (< 4)
+ $sth = $dbh->prepare(
+ qq{
+ SELECT dmid, itid, txtid
+ FROM ml_latest
+ WHERE lnid=$l->{'lnid'} AND staleness < 4
+ }
+ );
$sth->execute;
- while (my ($dmid, $itid, $txtid) = $sth->fetchrow_array) {
+ while ( my ( $dmid, $itid, $txtid ) = $sth->fetchrow_array ) {
$need{"$dmid:$itid"} = $txtid;
}
- $sth = $dbh->prepare("SELECT dmid, itid, txtid FROM ml_latest WHERE lnid=$cl->{'lnid'}");
+
+ $sth = $dbh->prepare(
+ qq{
+ SELECT dmid, itid, txtid
+ FROM ml_latest
+ WHERE lnid=$cl->{'lnid'}
+ }
+ );
$sth->execute;
- while (my ($dmid, $itid, $txtid) = $sth->fetchrow_array) {
+ while ( my ( $dmid, $itid, $txtid ) = $sth->fetchrow_array ) {
delete $need{"$dmid:$itid"};
}
@@ -236,85 +275,109 @@
}
foreach my $k ( sort keys %need ) {
- my ($dmid, $itid) = split(/:/, $k);
+ my ( $dmid, $itid ) = split( /:/, $k );
my $txtid = $need{$k};
my $stale = $cl->{'parenttype'} eq "diff" ? 3 : 0;
- $dbh->do("INSERT INTO ml_latest (lnid, dmid, itid, txtid, chgtime, staleness) VALUES ".
- "($cl->{'lnid'}, $dmid, $itid, $txtid, NOW(), $stale)");
+ $dbh->do(
+ qq{
+ INSERT INTO ml_latest
+ (lnid, dmid, itid, txtid, chgtime, staleness)
+ VALUES
+ ($cl->{'lnid'}, $dmid, $itid, $txtid, NOW(), $stale)
+ }
+ );
die $dbh->errstr if $dbh->err;
- $out->("[$l->{'lncode'} => $cl->{'lncode'}] $itid") if $opt_verbose;
+ $out->("[$l->{'lncode'} => $cl->{'lncode'}] $itid")
+ if $opt_verbose;
}
- $rec->($cl->{'lncode'}, $rec);
+ $rec->( $cl->{'lncode'}, $rec );
}
};
- $rec->("en", $rec);
- $out->("-", "done.");
+ $rec->( "en", $rec );
+ $out->( "-", "done." );
}
-sub copyfaq
-{
+sub copyfaq {
my $faqd = LJ::Lang::get_dom("faq");
- my $ll = LJ::Lang::get_root_lang($faqd);
+ my $ll = LJ::Lang::get_root_lang($faqd);
unless ($ll) { return; }
my $domid = $faqd->{'dmid'};
- $out->("Copying FAQ...", '+');
+ $out->( "Copying FAQ...", '+' );
my %existing;
- $sth = $dbh->prepare("SELECT i.itcode FROM ml_items i, ml_latest l ".
- "WHERE l.lnid=$ll->{'lnid'} AND l.dmid=$domid AND l.itid=i.itid AND i.dmid=$domid");
+ $sth = $dbh->prepare(
+ qq{
+ SELECT i.itcode
+ FROM ml_items i, ml_latest l
+ WHERE
+ l.lnid=$ll->{'lnid'} AND
+ l.dmid=$domid AND
+ l.itid=i.itid AND
+ i.dmid=$domid
+ }
+ );
$sth->execute;
$existing{$_} = 1 while $_ = $sth->fetchrow_array;
# faq category
$sth = $dbh->prepare("SELECT faqcat, faqcatname FROM faqcat");
$sth->execute;
- while (my ($cat, $name) = $sth->fetchrow_array) {
+ while ( my ( $cat, $name ) = $sth->fetchrow_array ) {
next if exists $existing{"cat.$cat"};
my $opts = { 'childrenlatest' => 1 };
- LJ::Lang::set_text($dbh, $domid, $ll->{'lncode'}, "cat.$cat", $name, $opts);
+ LJ::Lang::set_text( $dbh, $domid, $ll->{'lncode'}, "cat.$cat", $name,
+ $opts );
}
# faq items
$sth = $dbh->prepare("SELECT faqid, question, answer, summary FROM faq");
$sth->execute;
- while (my ($faqid, $q, $a, $s) = $sth->fetchrow_array) {
- next if
- exists $existing{"$faqid.1question"} and
- exists $existing{"$faqid.2answer"} and
- exists $existing{"$faqid.3summary"};
+ while ( my ( $faqid, $q, $a, $s ) = $sth->fetchrow_array ) {
+ next
+ if exists $existing{"$faqid.1question"}
+ and exists $existing{"$faqid.2answer"}
+ and exists $existing{"$faqid.3summary"};
my $opts = { 'childrenlatest' => 1 };
- LJ::Lang::set_text($dbh, $domid, $ll->{'lncode'}, "$faqid.1question", $q, $opts);
- LJ::Lang::set_text($dbh, $domid, $ll->{'lncode'}, "$faqid.2answer", $a, $opts);
- LJ::Lang::set_text($dbh, $domid, $ll->{'lncode'}, "$faqid.3summary", $s, $opts);
+ LJ::Lang::set_text( $dbh, $domid, $ll->{'lncode'}, "$faqid.1question",
+ $q, $opts );
+ LJ::Lang::set_text( $dbh, $domid, $ll->{'lncode'}, "$faqid.2answer",
+ $a, $opts );
+ LJ::Lang::set_text( $dbh, $domid, $ll->{'lncode'}, "$faqid.3summary",
+ $s, $opts );
}
- $out->('-', "done.");
+ $out->( '-', "done." );
}
-sub wipedb
-{
- $out->("Wiping DB...", '+');
+sub wipedb {
+ $out->( "Wiping DB...", '+' );
foreach (qw(domains items langdomains langs latest text)) {
$out->("deleting from $_");
$dbh->do("DELETE FROM ml_$_");
}
- $out->("-", "done.");
+ $out->( "-", "done." );
}
-sub wipecrumbs
-{
- $out->('Wiping DB of all crumbs...', '+');
+sub wipecrumbs {
+ $out->( 'Wiping DB of all crumbs...', '+' );
# step 1: get all items that are crumbs. [from ml_items]
my $genid = $dom_code{'general'}->{'dmid'};
my @crumbs;
- my $sth = $dbh->prepare("SELECT itcode FROM ml_items
- WHERE dmid = $genid AND itcode LIKE 'crumb.\%'");
+ my $sth = $dbh->prepare(
+ qq{
+ SELECT itcode
+ FROM ml_items
+ WHERE dmid = $genid AND itcode LIKE 'crumb.\%'
+ }
+ );
$sth->execute;
- while (my ($itcode) = $sth->fetchrow_array) {
+
+ while ( my ($itcode) = $sth->fetchrow_array ) {
+
# push onto list
push @crumbs, $itcode;
}
@@ -322,16 +385,15 @@
# step 2: remove the items that have these unique dmid/itids
foreach my $code (@crumbs) {
$out->("deleting $code");
- remove("general", $code);
+ remove( "general", $code );
}
# done
- $out->('-', 'done.');
+ $out->( '-', 'done.' );
}
-sub loadcrumbs
-{
- $out->('Loading all crumbs into DB...', '+');
+sub loadcrumbs {
+ $out->( 'Loading all crumbs into DB...', '+' );
# get domain id of 'general' and language id of 'en'
my $genid = $dom_code{'general'}->{'dmid'};
@@ -339,8 +401,8 @@
# list of crumbs
my @crumbs;
- foreach (keys %LJ::CRUMBS_LOCAL) { push @crumbs, $_; }
- foreach (keys %LJ::CRUMBS) { push @crumbs, $_; }
+ foreach ( keys %LJ::CRUMBS_LOCAL ) { push @crumbs, $_; }
+ foreach ( keys %LJ::CRUMBS ) { push @crumbs, $_; }
# begin iterating, order doesn't matter...
foreach my $crumbkey (@crumbs) {
@@ -348,26 +410,31 @@
my $local = $LJ::CRUMBS_LOCAL{$crumbkey} ? 1 : 0;
# see if it exists
- my $itid = $dbh->selectrow_array("SELECT itid FROM ml_items
- WHERE dmid = $genid AND itcode = 'crumb.$crumbkey'")+0;
+ my $itid = $dbh->selectrow_array(
+ qq{
+ SELECT itid
+ FROM ml_items
+ WHERE dmid = $genid AND itcode = 'crumb.$crumbkey'
+ }
+ ) + 0;
unless ($itid) {
$out->("inserting crumb.$crumbkey");
my $lang = $local ? $loclang : 'en';
- LJ::Lang::set_text( $genid, $lang, "crumb.$crumbkey", $crumb->[0] );
+ LJ::Lang::set_text( $genid, $lang, "crumb.$crumbkey",
+ $crumb->[0] );
}
}
# done
- $out->('-', 'done.');
+ $out->( '-', 'done.' );
}
-sub popstruct
-{
- $out->("Populating structure...", '+');
+sub popstruct {
+ $out->( "Populating structure...", '+' );
my $languages_changed = 0;
- my $langdata = $dbh->selectall_arrayref(
+ my $langdata = $dbh->selectall_arrayref(
'SELECT * FROM ml_langs',
{ 'Slice' => {} },
);
@@ -378,9 +445,9 @@
my $l = $lang_id{ $langrow->{'lnid'} };
$languages_changed ||= !$l;
- $l ||= {};
+ $l ||= {};
- foreach my $key ( qw( lncode lnname parenttype parentlnid ) ) {
+ foreach my $key (qw( lncode lnname parenttype parentlnid )) {
$languages_changed ||= ( $l->{$key} ne $langrow->{$key} );
}
@@ -392,7 +459,7 @@
}
if ( $languages_changed || $opt_force_popstruct ) {
- $out->('Languages:', '+');
+ $out->( 'Languages:', '+' );
foreach my $l ( values %lang_id ) {
$out->("$l->{'lnname'} (lncode=$l->{'lncode'})");
$dbh->do(
@@ -401,17 +468,19 @@
(lnid, lncode, lnname, parenttype, parentlnid)
VALUES (?, ?, ?, ?, ?)
}, undef,
- $l->{'lnid'}, $l->{'lncode'}, $l->{'lnname'},
+ $l->{'lnid'}, $l->{'lncode'}, $l->{'lnname'},
$l->{'parenttype'}, $l->{'parentlnid'},
);
}
$out->('-');
- } else {
- $out->('Languages seem to be unchanged, not changing anything without --force-popstruct');
}
+ else {
+ $out->( 'Languages seem to be unchanged, not changing '
+ . 'anything without --force-popstruct' );
+ }
my $domains_changed = 0;
- my $domdata = $dbh->selectall_arrayref(
+ my $domdata = $dbh->selectall_arrayref(
'SELECT * FROM ml_domains',
{ 'Slice' => {} },
);
@@ -422,9 +491,9 @@
my $l = $dom_id{ $domrow->{'dmid'} };
$domains_changed ||= !$l;
- $l ||= {};
+ $l ||= {};
- foreach my $key ( qw( type args ) ) {
+ foreach my $key (qw( type args )) {
$domains_changed ||= ( $l->{$key} ne $domrow->{$key} );
}
@@ -436,8 +505,8 @@
}
if ( $domains_changed || $opt_force_popstruct ) {
- $out->('Domains:', '+');
- foreach my $d (values %dom_id) {
+ $out->( 'Domains:', '+' );
+ foreach my $d ( values %dom_id ) {
$out->("$d->{'type'}\[$d->{'args'}\]");
$dbh->do(
'REPLACE INTO ml_domains (dmid, type, args) VALUES (?, ?, ?)',
@@ -445,30 +514,41 @@
);
}
$out->('-');
- } else {
- $out->('Domains seem to be unchanged, not changing anything without --force-popstruct');
}
+ else {
+ $out->( 'Domains seem to be unchanged, not changing '
+ . 'anything without --force-popstruct' );
+ }
$out->('Inserting/updating language domains ...');
foreach my $ld (@lang_domains) {
- $dbh->do("INSERT IGNORE INTO ml_langdomains (lnid, dmid, dmmaster) VALUES ".
- "(" . join(",", map { $dbh->quote($ld->{$_}) } qw(lnid dmid dmmaster)) . ")");
+ $dbh->do(
+ qq{
+ INSERT IGNORE INTO ml_langdomains
+ (lnid, dmid, dmmaster)
+ VALUES (?, ?, ?)
+ }, undef,
+ $ld->{'lnid'}, $ld->{'dmid'}, $ld->{'dmmaster'}
+ );
}
- $out->("-", "done.");
+ $out->( "-", "done." );
}
-sub poptext
-{
+sub poptext {
my @langs = @_;
unless (@langs) {
if ($opt_all) {
@langs = keys %lang_code;
- } else {
- die "No languages to load are specified.\n" .
- "Warning: most language files except en.dat and en_LJ.dat are obsolete.\n" .
- "Either run 'texttool.pl load en en_LJ' to load up-to-date files,\n" .
- "or 'texttool.pl --all load' if you really want to load texts in all languages.\n";
}
+ else {
+ die "No languages to load are specified.\n"
+ . "Warning: most language files except en.dat "
+ . "and en_LJ.dat are obsolete.\n"
+ . "Either run 'texttool.pl load en en_LJ' to "
+ . "load up-to-date files,\n"
+ . "or 'texttool.pl --all load' if you really want "
+ . "to load texts in all languages.\n";
+ }
}
$out->('Populating text (reading all these files may take a while)...');
@@ -476,7 +556,7 @@
$out->('+');
# learn about base files
- my %source; # langcode -> absfilepath
+ my %source; # langcode -> absfilepath
foreach my $lang (@langs) {
my $file = "$ENV{'LJHOME'}/bin/upgrading/${lang}.dat";
next if $opt_only && $lang ne $opt_only;
@@ -502,10 +582,10 @@
$source{"$ENV{'LJHOME'}/$tf"} = [ $lang, $pfx, $tf ];
}
- my %existing_item; # langid -> code -> 1
+ my %existing_item; # langid -> code -> 1
foreach my $file ( sort keys %source ) {
- my ( $lang, $pfx, $filename_short ) = @{$source{$file}};
+ my ( $lang, $pfx, $filename_short ) = @{ $source{$file} };
$out->("reading $filename_short...") if $opt_verbose;
my $ldf = LJ::LangDatFile->new($file);
@@ -513,161 +593,200 @@
my $l = $lang_code{$lang} or die "unknown language '$lang'";
my $addcount = 0;
- $ldf->foreach_key(sub {
- my $code = shift;
- my %metadata = $ldf->meta($code);
- my $text = $ldf->value($code);
+ my $msgprefix = "[$filename_short, lang=$lang]";
- $code = "$pfx$code";
- die "Code in file $filename_short can't start with a dot: $code"
- if $code =~ /^\./;
+ $ldf->foreach_key(
+ sub {
+ my $code = shift;
- # load existing items for target language
- unless (exists $existing_item{$l->{'lnid'}}) {
- $existing_item{$l->{'lnid'}} = {};
- my $sth = $dbh->prepare(qq{
- SELECT i.itcode, t.text
- FROM ml_latest l, ml_items i, ml_text t
- WHERE
- i.dmid = 1 AND
- l.dmid = 1 AND
- i.itid = l.itid AND
- l.lnid = ? AND
- t.lnid = l.lnid AND
- t.txtid = l.txtid AND
- i.dmid = i.dmid AND
- t.dmid = i.dmid
- });
- $sth->execute($l->{lnid});
- die $sth->errstr if $sth->err;
- while (my ($code, $oldtext) = $sth->fetchrow_array) {
- $existing_item{$l->{'lnid'}}->{ lc($code) } = $oldtext;
+ my %metadata = $ldf->meta($code);
+ my $text = $ldf->value($code);
+
+ $code = "$pfx$code";
+ if ( $code =~ /^[.]/ ) {
+ die "Code in file $filename_short can't start "
+ . "with a dot: $code";
}
- }
- # Remove last '\r' char from loaded from files text before compare.
- # In database text stored without this '\r', LJ::Lang::set_text remove it
- # before update database.
- $text =~ s/\r//;
+ # load existing items for target language
+ unless ( exists $existing_item{ $l->{'lnid'} } ) {
+ $existing_item{ $l->{'lnid'} } = {};
+ my $sth = $dbh->prepare(
+ qq{
+ SELECT i.itcode, t.text
+ FROM ml_latest l, ml_items i, ml_text t
+ WHERE
+ i.dmid = 1 AND
+ l.dmid = 1 AND
+ i.itid = l.itid AND
+ l.lnid = ? AND
+ t.lnid = l.lnid AND
+ t.txtid = l.txtid AND
+ i.dmid = i.dmid AND
+ t.dmid = i.dmid
+ }
+ );
+ $sth->execute( $l->{lnid} );
+ die $sth->errstr if $sth->err;
+ while ( my ( $code, $oldtext ) = $sth->fetchrow_array ) {
+ $existing_item{ $l->{'lnid'} }->{ lc($code) } =
+ $oldtext;
+ }
+ }
- ## do not update existing texts in DB by default.
- ## --force-override flag allows to disable this restriction.
- return if exists $existing_item{$l->{'lnid'}}->{$code}
+ # Remove last '\r' char from loaded from files
+ # text before compare. In database text stored
+ # without this '\r', LJ::Lang::set_text remove
+ # it before update database.
+ $text =~ s/\r//;
+
+ ## do not update existing texts in DB by default.
+ ## --force-override flag allows to disable this restriction.
+ return
+ if exists $existing_item{ $l->{'lnid'} }->{$code}
and not $force_override;
-
- my $old_text = $existing_item{$l->{'lnid'}}->{$code};
- unless ( $old_text eq $text ) {
- $addcount++;
- if ($old_text) {
- $out->("[$filename_short, lang=$lang] $code: $old_text => $text");
- } else {
- $out->("[$filename_short, lang=$lang] $code: setting to $text");
- }
+ my $old_text = $existing_item{ $l->{'lnid'} }->{$code};
- # if the text is changing, the staleness is at least 1
- my $staleness = $metadata{'staleness'}+0 || 1;
+ unless ( $old_text eq $text ) {
+ $addcount++;
+ if ($old_text) {
+ $out->("$msgprefix $code: $old_text => $text");
+ }
+ else {
+ $out->("$msgprefix $code: setting to $text");
+ }
- my $res = LJ::Lang::set_text($dbh, 1, $l->{'lncode'}, $code, $text,
- { 'staleness' => $staleness,
- 'notes' => $metadata{'notes'},
- 'changeseverity' => 2, });
+ # if the text is changing, the staleness is at least 1
+ my $staleness = $metadata{'staleness'} + 0 || 1;
- unless ($res) {
- $out->('x', "ERROR: " . LJ::Lang::last_error());
+ my $res = LJ::Lang::set_text(
+ $dbh, 1,
+ $l->{'lncode'},
+ $code, $text,
+ { 'staleness' => $staleness,
+ 'notes' => $metadata{'notes'},
+ 'changeseverity' => 2,
+ }
+ );
+
+ unless ($res) {
+ $out->( 'x', "ERROR: " . LJ::Lang::last_error() );
+ }
}
}
- });
+ );
if ( $addcount > 0 ) {
- $out->("added $addcount from $file");
+ $out->("added $addcount from $filename_short");
}
}
- $out->("-", "done.");
+ $out->( "-", "done." );
# dead phrase removal
if ($opt_process_deadphrases) {
- $out->("Removing dead phrases...", '+');
- foreach my $file ("deadphrases.dat", "deadphrases-local.dat") {
+ $out->( "Removing dead phrases...", '+' );
+ foreach my $file ( "deadphrases.dat", "deadphrases-local.dat" ) {
my $ffile = "$ENV{'LJHOME'}/bin/upgrading/$file";
next unless -s $ffile;
$out->("File: $file");
- open (DP, $ffile) or die;
- while (my $li = <DP>) {
+ open( DP, $ffile ) or die;
+ while ( my $li = <DP> ) {
$li =~ s/\#.*//;
next unless $li =~ /\S/;
$li =~ s/\s+$//;
- my ($dom, $it) = split(/\s+/, $li);
+ my ( $dom, $it ) = split( /\s+/, $li );
next unless exists $dom_code{$dom};
my $dmid = $dom_code{$dom}->{'dmid'};
-
+
my @items;
- if ($it =~ s/\*$/\%/) {
- my $sth = $dbh->prepare("SELECT itcode FROM ml_items WHERE dmid=? AND itcode LIKE ?");
- $sth->execute($dmid, $it);
+ if ( $it =~ s/\*$/\%/ ) {
+ my $sth = $dbh->prepare(
+ qq{
+ SELECT itcode
+ FROM ml_items
+ WHERE dmid=? AND itcode LIKE ?
+ }
+ );
+ $sth->execute( $dmid, $it );
push @items, $_ while $_ = $sth->fetchrow_array;
- } else {
+ }
+ else {
@items = ($it);
}
+
foreach (@items) {
- remove($dom, $_, 1);
+ remove( $dom, $_, 1 );
}
}
close DP;
}
- $out->('-', "Done.");
+ $out->( '-', "Done." );
}
}
-sub dumptext
-{
+sub dumptext {
my $to_cvs = shift;
- my @langs = @_;
+ my @langs = @_;
unless (@langs) { @langs = keys %lang_code; }
- $out->('Dumping text...', '+');
- foreach my $lang (@langs)
- {
+ $out->( 'Dumping text...', '+' );
+ foreach my $lang (@langs) {
$out->("$lang");
my $l = $lang_code{$lang};
- my %fh_map = (); # filename => filehandle
+ my %fh_map = (); # filename => filehandle
- my $sth = $dbh->prepare("SELECT i.itcode, t.text, l.staleness, i.notes FROM ".
- "ml_items i, ml_latest l, ml_text t ".
- "WHERE l.lnid=$l->{'lnid'} AND l.dmid=1 ".
- "AND i.dmid=1 AND l.itid=i.itid AND ".
- "t.dmid=1 AND t.txtid=l.txtid AND ".
- # only export mappings that aren't inherited:
- "t.lnid=$l->{'lnid'} ".
- "ORDER BY i.itcode");
+ # the part "t.lnid=$l->{'lnid'}" is added to ensure that
+ # we only export mappings that aren't inherited
+ my $sth = $dbh->prepare(
+ qq{
+ SELECT i.itcode, t.text, l.staleness, i.notes
+ FROM ml_items i, ml_latest l, ml_text t
+ WHERE
+ l.lnid=$l->{'lnid'} AND
+ l.dmid=1 AND
+ i.dmid=1 AND
+ l.itid=i.itid AND
+ t.dmid=1 AND
+ t.txtid=l.txtid AND
+ t.lnid=$l->{'lnid'}
+ ORDER BY i.itcode
+ }
+ );
$sth->execute;
die $dbh->errstr if $dbh->err;
my $writeline = sub {
- my ($fh, $k, $v) = @_;
+ my ( $fh, $k, $v ) = @_;
# kill any \r since they shouldn't be there anyway
$v =~ s/\r//g;
# print to .dat file
- if ($v =~ /\n/) {
+ if ( $v =~ /\n/ ) {
$v =~ s/\n\./\n\.\./g;
print $fh "$k<<\n$v\n.\n";
- } else {
+ }
+ else {
print $fh "$k=$v\n";
}
};
- while (my ($itcode, $text, $staleness, $notes) = $sth->fetchrow_array) {
- if ($itcode =~ m!\.bml/! || $itcode =~ /[\s=]/) {
+ while ( my ( $itcode, $text, $staleness, $notes ) =
+ $sth->fetchrow_array )
+ {
+ if ( $itcode =~ m!\.bml/! || $itcode =~ /[\s=]/ ) {
warn "Skipping item code '$itcode'";
next;
}
- my $langdat_file = LJ::Lang::langdat_file_of_lang_itcode($lang, $itcode, $to_cvs);
- $itcode = LJ::Lang::itcode_for_langdat_file($langdat_file, $itcode);
+ my $langdat_file =
+ LJ::Lang::langdat_file_of_lang_itcode( $lang, $itcode,
+ $to_cvs );
+ $itcode =
+ LJ::Lang::itcode_for_langdat_file( $langdat_file, $itcode );
my $fh = $fh_map{$langdat_file};
unless ($fh) {
@@ -675,12 +794,15 @@
# the dir might not exist in some cases, so if it doesn't
# we'll create a zero-byte file to overwrite
# -- yeah, this is really gross
- unless (-e $langdat_file) {
- system("install", "-D", "/dev/null", $langdat_file);
+ unless ( -e $langdat_file ) {
+ system( "install", "-D", "/dev/null", $langdat_file );
}
- open ($fh, ">$langdat_file")
- or die "unable to open langdat file: $langdat_file ($lang, $itcode, $to_cvs, $!)";
+ my $openres = open( $fh, ">$langdat_file" );
+ unless ($openres) {
+ die "unable to open langdat file: "
+ . "$langdat_file ($lang, $itcode, $to_cvs, $!)";
+ }
$fh_map{$langdat_file} = $fh;
@@ -688,51 +810,52 @@
$fh->print(";; -*- coding: utf-8 -*-\n");
}
- $writeline->($fh, "$itcode|staleness", $staleness)
+ $writeline->( $fh, "$itcode|staleness", $staleness )
if $staleness;
- $writeline->($fh, "$itcode|notes", $notes)
+ $writeline->( $fh, "$itcode|notes", $notes )
if $notes =~ /\S/;
- $writeline->($fh, $itcode, $text);
+ $writeline->( $fh, $itcode, $text );
# newline between record sets
print $fh "\n";
}
# close filehandles now
- foreach my $file (keys %fh_map) {
+ foreach my $file ( keys %fh_map ) {
close $fh_map{$file} or die "unable to close: $file ($!)";
}
}
- $out->('-', 'done.');
+ $out->( '-', 'done.' );
}
-sub newitems
-{
- $out->("Searching for referenced text codes...", '+');
+sub newitems {
+ $out->( "Searching for referenced text codes...", '+' );
my $top = $ENV{'LJHOME'};
my @files;
push @files, qw(htdocs cgi-bin bin);
- my %items; # $scope -> $key -> 1;
- while (@files)
- {
- my $file = shift @files;
+ my %items; # $scope -> $key -> 1;
+ while (@files) {
+ my $file = shift @files;
my $ffile = "$top/$file";
next unless -e $ffile;
- if (-d $ffile) {
+ if ( -d $ffile ) {
$out->("dir: $file");
- opendir (MD, $ffile) or die "Can't open $file";
- while (my $f = readdir(MD)) {
- next if $f eq "." || $f eq ".." ||
- $f =~ /^\.\#/ || $f =~ /(\.png|\.gif|~|\#)$/;
+ opendir( MD, $ffile ) or die "Can't open $file";
+ while ( my $f = readdir(MD) ) {
+ next
+ if $f eq "."
+ || $f eq ".."
+ || $f =~ /^\.\#/
+ || $f =~ /(\.png|\.gif|~|\#)$/;
unshift @files, "$file/$f";
}
closedir MD;
}
- if (-f $ffile) {
+ if ( -f $ffile ) {
my $scope = "local";
$scope = "general" if -e "$top/cvs/livejournal/$file";
- open (F, $ffile) or die "Can't open $file";
+ open( F, $ffile ) or die "Can't open $file";
my $line = 0;
while (<F>) {
$line++;
@@ -741,7 +864,7 @@
}
while (/\(=_ML\s+(.+?)\s+_ML=\)/g) {
my $code = $1;
- if ($code =~ /^\./ && $file =~ m!^htdocs/!) {
+ if ( $code =~ /^\./ && $file =~ m!^htdocs/! ) {
$code = "$file$code";
$code =~ s!^htdocs!!;
}
@@ -752,21 +875,34 @@
}
}
- $out->(sprintf("%d general and %d local found.",
- scalar keys %{$items{'general'}},
- scalar keys %{$items{'local'}}));
+ $out->(
+ sprintf(
+ "%d general and %d local found.",
+ scalar keys %{ $items{'general'} },
+ scalar keys %{ $items{'local'} }
+ )
+ );
# [ General ]
- my %e_general; # code -> 1
+ my %e_general; # code -> 1
$out->("Checking which general items already exist in database...");
- my $sth = $dbh->prepare("SELECT i.itcode FROM ml_items i, ml_latest l WHERE ".
- "l.dmid=1 AND l.lnid=1 AND i.dmid=1 AND i.itid=l.itid ");
+ my $sth = $dbh->prepare(
+ qq{
+ SELECT i.itcode
+ FROM ml_items i, ml_latest l
+ WHERE l.dmid=1 AND l.lnid=1 AND i.dmid=1 AND i.itid=l.itid
+ }
+ );
$sth->execute;
- while (my $it = $sth->fetchrow_array) { $e_general{$it} = 1; }
- $out->(sprintf("%d found", scalar keys %e_general));
- foreach my $it (keys %{$items{'general'}}) {
+
+ while ( my $it = $sth->fetchrow_array ) { $e_general{$it} = 1; }
+ $out->( sprintf( "%d found", scalar keys %e_general ) );
+
+ foreach my $it ( keys %{ $items{'general'} } ) {
next if exists $e_general{$it};
- my $res = LJ::Lang::set_text($dbh, 1, "en", $it, undef, { 'staleness' => 4 });
+ my $res =
+ LJ::Lang::set_text( $dbh, 1, "en", $it, undef,
+ { 'staleness' => 4 } );
$out->("Adding general: $it ... $res");
}
@@ -778,38 +914,53 @@
$out->("Checking which local items already exist in database...");
my %e_local;
- $sth = $dbh->prepare("SELECT i.itcode FROM ml_items i, ml_latest l WHERE ".
- "l.dmid=1 AND l.lnid=$ll->{'lnid'} AND i.dmid=1 AND i.itid=l.itid ");
+ $sth = $dbh->prepare(
+ qq{
+ SELECT i.itcode
+ FROM ml_items i, ml_latest l
+ WHERE
+ l.dmid=1 AND
+ l.lnid=$ll->{'lnid'} AND
+ i.dmid=1 AND
+ i.itid=l.itid
+ }
+ );
$sth->execute;
- while (my $it = $sth->fetchrow_array) { $e_local{$it} = 1; }
- $out->(sprintf("%d found\n", scalar keys %e_local));
- foreach my $it (keys %{$items{'local'}}) {
+ while ( my $it = $sth->fetchrow_array ) { $e_local{$it} = 1; }
+ $out->( sprintf( "%d found\n", scalar keys %e_local ) );
+
+ foreach my $it ( keys %{ $items{'local'} } ) {
next if exists $e_general{$it};
next if exists $e_local{$it};
- my $res = LJ::Lang::set_text($dbh, 1, $ll->{'lncode'}, $it, undef, { 'staleness' => 4 });
+ my $res =
+ LJ::Lang::set_text( $dbh, 1, $ll->{'lncode'}, $it, undef,
+ { 'staleness' => 4 } );
$out->("Adding local: $it ... $res");
}
}
- $out->('-', 'done.');
+ $out->( '-', 'done.' );
}
sub remove {
- my ($dmcode, $itcode, $no_error) = @_;
+ my ( $dmcode, $itcode, $no_error ) = @_;
my $dmid;
- if (exists $dom_code{$dmcode}) {
+ if ( exists $dom_code{$dmcode} ) {
$dmid = $dom_code{$dmcode}->{'dmid'};
- } else {
- $out->("x", "Unknown domain code $dmcode.");
}
+ else {
+ $out->( "x", "Unknown domain code $dmcode." );
+ }
my $qcode = $dbh->quote($itcode);
- my $itid = $dbh->selectrow_array("SELECT itid FROM ml_items WHERE dmid=$dmid AND itcode=$qcode");
+ my $itid = $dbh->selectrow_array(
+ "SELECT itid FROM ml_items WHERE dmid=$dmid AND itcode=$qcode");
return if $no_error && !$itid;
- $out->("x", "Unknown item code $itcode.") unless $itid;
+ $out->( "x", "Unknown item code $itcode." ) unless $itid;
# need to delete everything from: ml_items ml_latest ml_text
- my $affected = $dbh->do("DELETE FROM ml_items WHERE dmid=$dmid AND itid=$itid");
+ my $affected =
+ $dbh->do("DELETE FROM ml_items WHERE dmid=$dmid AND itid=$itid");
# we're only outputting something if this is something
# significant, according to ml_items
@@ -818,12 +969,14 @@
}
my $txtids = "";
- my $sth = $dbh->prepare("SELECT txtid FROM ml_latest WHERE dmid=$dmid AND itid=$itid");
+ my $sth = $dbh->prepare(
+ "SELECT txtid FROM ml_latest WHERE dmid=$dmid AND itid=$itid");
$sth->execute;
- while (my $txtid = $sth->fetchrow_array) {
+ while ( my $txtid = $sth->fetchrow_array ) {
$txtids .= "," if $txtids;
$txtids .= $txtid;
}
$dbh->do("DELETE FROM ml_latest WHERE dmid=$dmid AND itid=$itid");
- $dbh->do("DELETE FROM ml_text WHERE dmid=$dmid AND txtid IN ($txtids)") if $txtids;
+ $dbh->do("DELETE FROM ml_text WHERE dmid=$dmid AND txtid IN ($txtids)")
+ if $txtids;
}
