admin/JM-tl-modify.pl

   1 #!/usr/bin/env perl
   2 #------------------------------------------------------------
   3 # translation_list の手動での更新を行うためのスクリプトです。
   4 # 直接編集することなしに、ステータスを更新できます。
   5 #
   6 # 引き数なしで本コマンドを実行すると、ヘルプが表示されます。
   7 #------------------------------------------------------------
   8
   9 use Getopt::Std;
  10
  11 my $DEBUG = 1;
  12 my %status;
  13 my $tlist_body = "";
  14 my $update_timestamp = 0;
  15 my $update_name = "";
  16 my $update_email = "";
  17 my %opts;
  18
  19 BEGIN{
  20     $epath = `dirname $0`; chomp $epath;
  21     my $lpath = "$epath/../bin";
  22     unshift (@INC, $lpath);
  23 }
  24
  25 use strict 'vars';
  26 use JMtl ('line2hash', 'hash2line');
  27
  28 getopts("tn:e:c", \%opts);
  29 print "$#ARGV\n";
  30 print $opts{"c"},"\n";
  31
  32 if ($#ARGV < 2) {
  33     print STDERR "Usage: JM-tl-modify.pl [OPTIONS] translation_list pagename new_status\n";
  34     print STDERR "    pagename = name.[1-9]\n";
  35     print STDERR "    new_status = TR DO DP PR RO RR\n";
  36     print STDERR "\n";
  37     print STDERR "OPTIONS:\n";
  38     print STDERR "    -t : Update timestamp\n";
  39     print STDERR "    -n NAME : Update name field\n";
  40     print STDERR "    -e MAIL : Update mail field\n";
  41     print STDERR "    -c : Clear entry of specified pagename\n";
  42     exit 0;
  43 }
  44
  45 my $tlist = $ARGV[0];
  46 my $page = $ARGV[1];
  47 my $command = $ARGV[2];
  48
  49 #printf "tlist = %s\n", $tlist;
  50 #printf "page = %s\n", $page;
  51 #printf "command = %s\n", $command;
  52
  53 # %status への代入
  54 # 他のフィールドは使用しないので、初期化せず。
  55 $status{'stat'} = $command;
  56 $status{'page'} = $page;
  57
  58 my $ismatch = 'no';
  59
  60 open TLO, $tlist or die "cannot open $tlist\n";
  61 while (<TLO>) {
  62     chomp;
  63     my %ti = line2hash($_);
  64
  65     if ($ti{'kind'} eq 'link' &&
  66         "$ti{'lname'}.$ti{'lsec'}" eq $status{'page'} &&
  67         $status{'stat'} =~ /^R/)
  68     {
  69         $ti{'stat'} = 'up2date';
  70         my $tll = hash2line(%ti);
  71         if ($DEBUG eq "yes") {print "$ismatch MATCH: $tll\n"};
  72         $tlist_body .= "$tll\n";
  73         next;
  74     }
  75     unless ("$ti{'fname'}.$ti{'sec'}" eq $status{'page'}) {
  76         $tlist_body .= "$_\n";
  77         if ($DEBUG eq "yes") {print "$ismatch : $_\n"};
  78         next;
  79     }
  80
  81     $ismatch = 'on';
  82
  83     if ($ti{'stat'} =~ /^1st/) {
  84         $ti{'stat'} = "1st_";
  85     } else {
  86         $ti{'stat'} = "upd_";
  87     }
  88   SW1: {
  89       if ($status{'stat'} =~ /^TR/){$ti{'stat'} .= 'rsv'; last SW1;}
  90       if ($status{'stat'} =~ /^DO/){$ti{'stat'} .= 'dft'; last SW1;}
  91       if ($status{'stat'} =~ /^DP/){$ti{'stat'} .= 'prf'; last SW1;}
  92       if ($status{'stat'} =~ /^PR/){$ti{'stat'} .= 'prf'; last SW1;}
  93       if ($status{'stat'} =~ /^RO/){$ti{'stat'} = 'up2date'; last SW1;}
  94       if ($status{'stat'} =~ /^RR/){$ti{'stat'} = 'up2datR'; last SW1;}
  95       die "error in STAT description\n" if not $opts{"c"};
  96   }
  97
  98     if ($status{'stat'} =~ /^R/){
  99         $ti{'rver'} = $ti{'over'};
 100         $ti{'dver'} = $ti{'over'};
 101 #       $ti{'newsec'} = $ti{'sec'};
 102     }
 103
 104 #    $ti{'tdat'}  = $status{'date'};
 105 #    $ti{'tmail'} = $status{'mail'};
 106 #    $ti{'tname'} = $status{'name'};
 107
 108     if ($opts{"t"}) {
 109         my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
 110         $year += 1900; $mon += 1;
 111         $ti{'tdat'} = sprintf("%04d/%02d/%02d", $year, $mon, $mday);
 112     }
 113     $ti{'tname'} = $opts{"n"} if $opts{"n"};
 114     $ti{'tmail'} = $opts{"e"} if $opts{"e"};
 115
 116     if ($opts{"c"}) {
 117         $ti{'tdat'} = '';
 118         $ti{'tname'} = '';
 119         $ti{'tmail'} = '';
 120     }
 121
 122     my $tll = hash2line(%ti);
 123
 124     if ($DEBUG eq "yes") {print "$ismatch MATCH: $tll\n"};
 125     $tlist_body .= "$tll\n";
 126 }
 127 close TLO;
 128 if ($ismatch eq "no") {die "No match in $tlist\n"};
 129
 130 system "mv -f $tlist $tlist.orig";
 131 open TLN, "| nkf -w > $tlist" or die "cannot open $tlist.new\n";
 132 print TLN $tlist_body;
 133 close TLN;
 134 print "UPDATE: $tlist ($page)\n";