admin/mktrlist

   1 #! /usr/bin/perl
   2 #
   3 # 新しいパッケージをレポジトリに入れた時に
   4 # translation_listを自動作成するスクリプト
   5 #
   6 # original/ディレクトリ以下にファイルを揃えてから、
   7 # translation_listがあるべきディレクトリで実行して下さい。
   8 # パッケージ名はディレクトリから、バージョンはlsmファイルから
   9 # 所得します。
  10 # 標準出力に結果を出力するので、適当にリダイレクトして下さい。
  11 #
  12 # BUG:
  13 # ・シンボリックリンクには対応していません。
  14 # ・manページの日付所得に失敗することがあります。
  15 #
  16 use Text::ParseWords;
  17 use Cwd;
  18
  19 sub detectdate
  20 {
  21         local ($time, $year, $month, $day);
  22         local ($pattern) = $_[0];
  23         @monthstr = ('Jan','Feb','Mar','Apr','May','Jun',
  24                      'Jul','Aug','Sep','Oct','Nov','Dec');
  25
  26         $year = "????";
  27         $month = "??";
  28         $day = "??";
  29
  30         @pat = split (/\s+/, $pattern);
  31
  32         for($x = 0; $x <= $#pat; $x++){
  33                 $dd = $pat[$x];
  34                 if($dd =~ /\d+/) {
  35                         if($dd <= 31){
  36                                 $day = sprintf("%02d", $dd);
  37                         } else {
  38                                 $year = sprintf("%04d", $dd);
  39                         }
  40
  41                 } else {
  42                         for($i = 0; $i <= $#monthstr; $i++){
  43                                 if($dd =~ /$monthstr[$i].*/i){
  44                                         $month = sprintf("%02d", $i + 1);
  45                                         last;
  46                                 }
  47                         }
  48                 }
  49         }
  50         return "$year/$month/$day";
  51 }
  52
  53 sub packagename
  54 {
  55         local @p = split('/', cwd());
  56         local $pname = $p[$#p];
  57
  58         $pname =~ tr/_/ /;
  59
  60         return $pname;
  61 }
  62
  63
  64 sub lsmversion
  65 {
  66         local $ret;
  67
  68         opendir DH, 'original';
  69         @files = grep /.*\.lsm/, readdir DH;
  70         closedir DH;
  71
  72         open FF, "original/$files[0]";
  73         while(<FF>){
  74                 if(/Version:\s+(.+)$/){
  75                         $ret = $1;
  76                         last;
  77                 }
  78         }
  79         close FF;
  80         return $ret;
  81 }
  82
  83 sub parseman {
  84         local ($dir, $name) = @_;
  85         local($key, $datestr);
  86
  87         open FF, "original/$dir/$name";
  88         while(<FF>){
  89                 if(/^\.\\\"/) { next; }
  90                 if(/^\.SO/i){
  91                         local($src, $dist);
  92                         m@/(\w+)\.(\w+)@;
  93                         $src = sprintf("%-2s %s", $2, $1);
  94                         $name =~ /(\w+)\.(\w+)/;
  95                         $dist = sprintf("%-2s %s", $2, $1);
  96                         $alias{$dist} = $src;
  97                         last;
  98                 }
  99                 if(/^\.TH/i){
 100                         @words = quotewords('\\s+', 0, $_);
 101                         $manname = $words[1];
 102                         $manname =~ tr/[A-Z]/[a-z]/;
 103                         $section = $words[2];
 104                         $datestr = &detectdate($words[3]);
 105                         $key = sprintf("%-2s %s", $section, $manname);
 106                         $otime{$key} = $datestr;
 107                         last;
 108                 }
 109                 if(/^\.DD/i){
 110                         /^\.DD\s+(.+)/i;
 111                         $datestr = &detectdate($1);
 112                         next;
 113                 }
 114                 if(/^\.DT/i){
 115                         @words = split;
 116                         $name = $words[1];
 117                         $name =~ tr/[A-Z]/[a-z]/;
 118                         $sec = $words[2];
 119                         $key = sprintf("%-2s %s", $sec, $name);
 120                         $otime{$key} = $datestr;
 121                         last;
 122                 }
 123         }
 124         close FF;
 125 }
 126
 127
 128 sub searchman
 129 {
 130         opendir DH, 'original';
 131         @mandirs = grep /man.+/, readdir DH;
 132         closedir DH;
 133
 134         foreach $d (@mandirs) {
 135                 opendir DH, "original/$d";
 136                 @manfiles = grep /.+\..+/, readdir DH;
 137                 closedir DH;
 138                 foreach $f (@manfiles) {
 139                         &parseman($d, $f);
 140 #print "$f\n";
 141                 }
 142         }
 143
 144 }
 145
 146 sub expandalias {
 147         foreach $k (keys %alias){
 148                 $otime{$k} = $otime{$alias{$k}};
 149         }
 150 }
 151
 152
 153 sub printlist {
 154         local($name, $sec);
 155         foreach $k (sort keys %otime){
 156                 ($sec, $name) = split / +/, $k;
 157                 if($alias{$k} ne ''){
 158                         local($osec, $oname) = split / +/, $alias{$k};
 159                         print join ':', '※', $package, $ver, $otime{$k},
 160                                 $name, $sec, $oname, $osec, "\n";
 161                 } else {
 162                         print join ':', '×', $package, $ver, $otime{$k},
 163                                 $name, $sec, '', '', '', '', "\n";
 164                 }
 165         }
 166 }
 167
 168         $package = &packagename();
 169         $ver = &lsmversion();
 170         &searchman();
 171         &expandalias();
 172         &printlist();