Андрей (andy) wrote in changelog,
Андрей
andy
changelog

[livejournal] r19535: LJSUP-9344 (clean up output of texttool....

Committer: ailyin
LJSUP-9344 (clean up output of texttool.pl): tidy it up, no functional changes
U   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;
 }

Tags: andy, livejournal, pl
Subscribe
  • Post a new comment

    Error

    Anonymous comments are disabled in this journal

    default userpic

    Your reply will be screened

    Your IP address will be recorded 

  • 0 comments