admin/ml2cvs

   1 #!/usr/bin/perl
   2 #
   3 # JMpost (admin/tools/Jmpost) を用いてポストされた
   4 # メールから Git への登録 (translation_list 変更他)
   5 # をする perl スクリプト.
   6 #
   7 # メールは UTF-8 変換後に標準入力から流してください。
   8 #
   9 # cat <mail> | nkf -Lu -w | ml2cvs
  10 #
  11 my $DEBUG = "off";
  12 my ($epath, %status);
  13
  14 $ENV{"LANG"} = "C";
  15
  16 BEGIN{
  17     $epath = `dirname $0`; chomp $epath;
  18     my $lpath = "$epath/../bin";
  19     unshift (@INC, $lpath);
  20 }
  21 use strict 'vars';
  22 use JMtl ('line2hash', 'hash2line');
  23
  24 my $ROFFROOT = "$epath/../manual";
  25 my $WWW_ROOT = "$epath/../www";
  26 my $DISTROOT = "$epath/../dist";
  27
  28 my $draft_body = "";
  29 my $release_body = "";
  30
  31 #
  32 # parse the post
  33 #
  34 my $context = "header";
  35 my ($mlnumber);
  36
  37 while (<>){
  38     chomp;
  39     if ($DEBUG eq "on") {print "$context : $_ \n";}
  40
  41     if ($context eq "header"){
  42         if (/^Subject:/) {
  43             if($_ =~ /\(non-menber post\)/){
  44                 print STDERR "non-member post. ignore.\n";
  45                 exit 0;
  46             }
  47
  48             (my $trash, $mlnumber) = split;
  49
  50             if ($mlnumber !~ /\[JM:[0-9]{5,5}\]/){
  51                 $mlnumber = '[LOCAL]';
  52             }
  53         }
  54         if (/^<STATUS>/) { $context = "status"; next;}
  55     }
  56
  57     if ($context eq "status"){
  58         my $val = $_; $val =~ s/^[a-z]{4}: +//; $val =~ s/ +$//;
  59         if (/^stat:/){$status{'stat'} =  $val; next;}
  60         if (/^ppkg:/){$status{'ppkg'} =  $val; next;}
  61         if (/^page:/){$status{'page'} =  $val; next;}
  62         if (/^date:/){$status{'date'} =  $val; next;}
  63         if (/^mail:/){$status{'mail'} =  $val; next;}
  64         if (/^name:/){$status{'name'} =  $val; next;}
  65         if (/^<\/STATUS>/) { $context = "intermission"; next;}
  66     }
  67
  68     if ($context eq "intermission"){
  69         unless (/^$/){ $context = "body";}
  70         # ここは next; が入らない!
  71     }
  72
  73     if ($context eq "body"){
  74         if (/^_{40,}$/) { $context = "end"; next; }
  75         $draft_body .= "$_\n";
  76         unless ($_ =~ /\.\\\"O/){
  77             $release_body .= "$_\n";
  78         }
  79     }
  80
  81     if ($context eq "end") { next; }
  82 }
  83
  84 if ($DEBUG eq "on") {
  85     for my $key (keys %status){
  86         print "$key: $status{$key}\n";
  87     }
  88 }
  89
  90 # Delete bogus blank lines at the bottom
  91 $draft_body =~ s/\n+\n$/\n/;
  92 $release_body =~ s/\n+\n$/\n/;
  93
  94 #
  95 # determine filenames
  96 #
  97 my $ppkg = $status{'ppkg'};
  98 my $dir = $ppkg; $dir =~ s/ /_/eg;
  99 my $name = $status{'page'};
 100 ($name =~ /.*\.([1-9])$/) || die "Filename match failed\n";
 101 my $sec = $1;
 102
 103 my $bdir = "$ROFFROOT/$dir";
 104
 105 my $ddir = "$bdir/draft/man$sec";
 106 my $rdir = "$bdir/release/man$sec";
 107
 108 my $draft   = "$ddir/$name";
 109 my $release = "$rdir/$name";
 110
 111 my ($df_stat, $rf_stat);
 112 if (-f $draft)   {$df_stat = "upd";} else {$df_stat = "new";}
 113 if (-f $release) {$rf_stat = "upd";} else {$rf_stat = "new";}
 114
 115 my $tlist = "$bdir/translation_list";
 116 my $clog  = "$bdir/ChangeLog";
 117
 118 my $clog_ins = `date`; chomp $clog_ins;
 119 $clog_ins .= "  JM ML to Git Gateway\n\n";
 120
 121 #
 122 # translation_list
 123 #
 124 my $tlist_body = "";
 125 my $ismatch = "no";
 126
 127 open TLO, $tlist or die "cannot open $tlist\n";
 128 while (<TLO>){
 129     chomp;
 130     my %ti = line2hash($_);
 131
 132     if ($ti{'kind'} eq 'link' &&
 133         "$ti{'lname'}.$ti{'lsec'}" eq $status{'page'} &&
 134         $status{'stat'} =~ /^R/)
 135     {
 136         $ti{'stat'} = 'up2date';
 137         my $tll = hash2line(%ti);
 138         if ($DEBUG eq "yes") {print "$ismatch MATCH: $tll\n"};
 139         $tlist_body .= "$tll\n";
 140         next;
 141     }
 142
 143     unless ("$ti{'fname'}.$ti{'sec'}" eq $status{'page'}) {
 144         $tlist_body .= "$_\n";
 145         if ($DEBUG eq "yes") {print "$ismatch : $_\n"};
 146         next;
 147     }
 148
 149     $ismatch = "on";
 150
 151     if ($ti{'stat'} =~ /^1st/){
 152         $ti{'stat'} = "1st_";
 153     } else {
 154         $ti{'stat'} = "upd_";
 155     }
 156   SW1:{
 157       if ($status{'stat'} =~ /^TR/){$ti{'stat'} .= 'rsv'; last SW1;}
 158       if ($status{'stat'} =~ /^DO/){$ti{'stat'} .= 'dft'; last SW1;}
 159       if ($status{'stat'} =~ /^DP/){$ti{'stat'} .= 'prf'; last SW1;}
 160       if ($status{'stat'} =~ /^PR/){$ti{'stat'} .= 'prf'; last SW1;}
 161       if ($status{'stat'} =~ /^RO/){$ti{'stat'} = 'up2date'; last SW1;}
 162       if ($status{'stat'} =~ /^RR/){$ti{'stat'} = 'up2datR'; last SW1;}
 163       die "error in STAT description\n";
 164   }
 165
 166     if ($status{'stat'} =~ /^R/){
 167         $ti{'rver'} = $ti{'over'};
 168         $ti{'dver'} = $ti{'over'};
 169 #       $ti{'newsec'} = $ti{'sec'};
 170     }
 171
 172     $ti{'tdat'}  = $status{'date'};
 173     $ti{'tmail'} = $status{'mail'};
 174     $ti{'tname'} = $status{'name'};
 175
 176     my $tll = hash2line(%ti);
 177
 178     if ($DEBUG eq "yes") {print "$ismatch MATCH: $tll\n"};
 179     $tlist_body .= "$tll\n";
 180 }
 181 close TLO;
 182 if ($ismatch eq "no") {die "No match in $tlist\n"};
 183
 184 system "mv -f $tlist $tlist.orig";
 185 open TLN, "| nkf -w > $tlist" or die "cannot open $tlist.new\n";
 186 print TLN $tlist_body;
 187 close TLN;
 188 print "UPDATE: $tlist\n";
 189
 190 $clog_ins .= "\t* translation_list: $mlnumber\n";
 191
 192 #
 193 # draft page
 194 #
 195 if ($status{'stat'} =~ /^D/ || $status{'stat'} =~ /^R/){
 196     system "mkdir -p $ddir";
 197     open DF, "| nkf -w > $draft" || die "cannot open $draft";
 198     print DF $draft_body;
 199     close DF;
 200
 201     $clog_ins .= "\t* draft/man$sec/$name: $mlnumber\n";
 202
 203     if ($df_stat eq "upd") {print "UPDATE: $draft\n" }
 204     else {print "CREATE: $draft\n";}
 205 }
 206
 207 #
 208 # release page
 209 #
 210 if ($status{'stat'} =~ /^R/){
 211     system "mkdir -p $rdir";
 212     open RF, "| nkf -w > $release" || die "cannot open $release";
 213     print RF $release_body;
 214     close RF;
 215
 216     $clog_ins .= "\t* release/man$sec/$name: $mlnumber\n";
 217
 218     if ($rf_stat eq "upd") {print "UPDATE: $release\n" }
 219     else {print "CREATE: $release\n";}
 220 }
 221
 222 #
 223 # ChangeLog
 224 #
 225 my $clog_body = `cat $clog`;
 226 $clog_body =~ s/^/$clog_ins\n/;
 227
 228 system "mv -f $clog $clog.orig";
 229 open CL, "| nkf -w > $clog" || die "cannot oepn $clog for writing\n";
 230 print CL $clog_body;
 231 close CL;
 232
 233 print "UPDATE: $clog\n";
 234
 235
 236 unless ($status{'stat'} =~ /^R/) {exit 0;}
 237 #
 238 # $ppkg:        パッケージ名
 239 # $dir:         $ppkg のスペースを _ に置換した文字列
 240 # $name:        ファイル名
 241
 242 #
 243 # www/news.m4
 244 #
 245 my ($pagelink);
 246 if ($rf_stat eq "new") {
 247     $pagelink = "   _NEW_PAGE($ppkg, $name)\n";
 248 } else {
 249     $pagelink = "   _UPD_PAGE($ppkg, $name)\n";
 250 }
 251
 252 my $newsfile = "$WWW_ROOT/news.m4";
 253 system "mv -f $newsfile $newsfile.orig";
 254 open NMO, "nkf -w $newsfile.orig |" || die "cannot open $newsfile.orig for reading\n";
 255 open NMN, "| nkf -w > $newsfile" || die "cannot open $newsfile for writing\n";
 256
 257 my $date = `date "+%Y/%m/%d"`; chomp $date;
 258 NEWS: while (<NMO>){
 259     unless (m/ML2CVS ADD HERE/) {print NMN; next;}
 260
 261     print NMN;
 262     my $tmp = <NMO>;
 263
 264     unless ($tmp =~ $date) { # 日付がマッチしなかった
 265         print NMN " <H2>$date</H2>\n";
 266         print NMN " <P>\n";
 267         print NMN "  以下のファイルを追加・更新しました。\n";
 268         print NMN " </P>\n";
 269         print NMN " <DL>\n";
 270         print NMN "  <DT>$ppkg</DT>\n  <DD>\n";
 271         print NMN $pagelink;
 272         print NMN "  </DD>\n </DL>\n\n";
 273
 274         print NMN $tmp;
 275         next;
 276     }
 277
 278     # 日付がマッチした
 279     #
 280     print NMN $tmp; # 日付行を出力
 281
 282     while (($tmp = <NMO>) !~ /<\/DL>/) {
 283         unless ($tmp =~ /<DT>$ppkg/){
 284             print NMN $tmp;
 285             next;
 286         }
 287
 288         # パッケージがマッチ
 289         #
 290         do {
 291             print NMN $tmp;
 292             $tmp = <NMO>;
 293         } until ($tmp =~ /<\/DD>/);
 294         print NMN $pagelink;
 295         print NMN $tmp;  #</DD> 行
 296         next NEWS;
 297     }
 298
 299     # 日付はマッチしたが、マッチするパッケージがなかった
 300     print NMN "  <DT>$ppkg</DT>\n  <DD>\n";
 301     print NMN $pagelink;
 302     print NMN "  </DD>\n";
 303
 304     print NMN $tmp;
 305 }
 306 close NMO; # news.m4.orig
 307 close NMN; # news.m4
 308
 309 print "UPDATE: $newsfile\n";
 310
 311
 312 unless ($rf_stat eq "new") { exit 0;}
 313 #
 314 # dist/script/pkgs.list
 315 #
 316 my $pkgsfile = "$DISTROOT/script/pkgs.list";
 317 if (`grep $dir $pkgsfile` == 0) {exit 0;}
 318
 319 system "cp -f $pkgsfile $pkgsfile.orig";
 320 open PL, "nkf -w >> $pkgsfile" || die "cannot open $pkgsfile for addition\n";
 321 print PL "$dir\tY\n";
 322 close PL;
 323 print "UPDATE: $pkgsfile\n";
 324
 325 exit 0;
 326