#!/usr/bin/perl
#
# mksigen-write.pl - SIGEN ファイルを作る perl スクリプト
#                    kitamo さんの作った writesigen.pl の改造版
#                    である writesigen2.pl の後継版
#
#   ※ SIGEN ファイルとは mksigen という perl で書かれたディレクトリ
#      データベースマネージャのための説明ファイルです.
#      詳しくは http://www.gfd-dennou.org/arch/cc-env/mksigen/desc.htm
#      を参照のこと.
#
    @MAINTAINERS = ('Kitamori Taichi   <kitamo@ep.sci.hokudia.ac.jp>',
		    'Morikawa Yasuhiro <morikawa@ep.sci.hokudai.ac.jp>',
		   );
    $UPDATE      = '2004/10/10';
    $VERSION     = '1.0';
    $URL         =
    'http://www.ep.sci.hokudai.ac.jp/~morikawa/perl/mksigen-write/SIGEN_PUB.htm';

#
# ・ TODO
#
# ・ History
#
#    - 1.0  2004/10/10 (森川靖大)
#           + writesigen2.pl から改名
#

##################################################
#####                                        #####
##           各ユーザの設定                    ###
#####                                        #####
##################################################

# 0: gate-toroku-system または passwd または
#    ログインネームを使用
#
# 1: 以下の $WRITER を使用

$FORCENAME = 1;

$WRITER = "森川 靖大"; # Maintainer および 更新者 (履歴欄に書く名前)

######### 以下は書き換えないで下さい. #############

##################################################
#####                                        #####
##      SIGEN ファイルの書式に依存した設定     ###
#####                                        #####
##################################################
# タブ文字を何文字分に数えるか
$TABLEN = 8;
# デフォルトのインデントはタブ文字いくつ分か
$TABINDENT = 2;


##################################################
#####                                        #####
##                 初期設定                    ###
#####                                        #####
##################################################
# オプション処理のため, getopts を組み込む.
require 'getopts.pl'
    || die "getopts.pl is not found.\n";

# h, H, v, V, f, Fのみ引数をとる.
&Getopts('i:hHvVfm');

##################################################
#####                                        #####
##                 引数識別                    ###
#####                                        #####
##################################################
# まずは取得
@filenames = @ARGV;

# 引数オプションとして v や V が与えられた場合には
# バージョン情報だけ表示x
if ($opt_v || $opt_V) {
    &Caution if $FORCENAME;
    &PrintVersion;
    exit 1;
}

# 引数が無い場合やオプションとして h や H が与えられた
# 場合にはヘルプを表示
if ($#ARGV < 0 || $opt_h || $opt_H){
    &Caution if $FORCENAME;
    &Help;
    exit 1;
}

# $FORCENAME が真の場合は何は無くとも表示
&Caution if $FORCENAME;

# 引数オプションとして f や F が与えられた場合には強制的に
# アップデートするフラグを真に
$UpdateForce = 0;
if ($opt_f) {
    $UpdateForce = 1;
}

# 引数オプションとして m や M が与えられた場合には
# 複数行入力を可能に
$MultiLine = 0;
if ($opt_m) {
    $MultiLine = 1;
}

# 引数がオプション i の場合, 引数として与えられたものを
# 雛型として利用.
undef $EXAMPLE;
if ($opt_i) {
    $EXAMPLE = $opt_i;
}

##################################################
#####                                        #####
##           Help などのサブルーチン           ###
#####   (これ以外のサブルーチンは末尾に)     #####
##################################################
sub Help() {
    print STDOUT <<EOF;
  mksigen-write.pl:
    USAGE:
      mksigen-write.pl [-vVhHfm] [-i exam[.SIGEN]] file[.SIGEN] [file ...]

    OPTION:
      -v, -V        : Show Version Number
      -h, -H        : Show Help
      -f            : Force Update
      -i exam.SIGEN : Use existing SIGEN file for example
      -m            : Enable MultiLine Input
                      (Please Enter 2 times).

EOF
    &PrintVersion;
}
sub PrintVersion() {
    print STDOUT <<EOF;
  mksigen-write.pl Version $VERSION, Last Update: $UPDATE.

EOF
    foreach $MAINTAINER (@MAINTAINERS) {
	print STDOUT "  $MAINTAINER \n";
    }
    print STDOUT "    All Right Reserved.\n\n";
}
sub Caution(){
    print STDOUT <<EOF
  ************   CAUTION !!! *****************
    PLEASE CHANGE \"\$WRITER\" TO YOUR NAME !!!
    IF YOU WANT GET USER-NAME AUTOMATICALLY,
    CHANGE \"\$FORCENAME\" to \"0\" !!!
  ********************************************

EOF
}

##################################################
#####                                        #####
##               ユーザ名取得                  ###
#####                                        #####
##################################################
$newname = &GetUserName;

if (!$FORCENAME && $newname) {
    $WRITER = $newname
}

##################################################
#####                                        #####
##          手本 SIGEN ファイル解析            ###
#####                                        #####
##################################################
if ($EXAMPLE) {
    # $EXAMPLE は SIGEN ファイルか?
    # もしも SIGEN が末尾に付いていない場合は .SIGEN を付けて探査
    if ($EXAMPLE !~ /^.*SIGEN$/) {
	# ディレクトリの場合を考慮して末尾のスラッシュを排除
	$EXAMPLE =~ s|/+$||;
	# 末尾に ".SIGEN" を追加
	$EXAMPLE = "$EXAMPLE".".SIGEN";
    }

    # $EXAMPLE はファイルとして存在するか?
    unless (-f $EXAMPLE) {
	die "$EXAMPLE is not found.\n" ;
    }

    print STDOUT "Input $EXAMPLE for example file ...  ";

    %exam = &ReadHeaders($EXAMPLE);

    # ヘッダが正しい情報を持っているかチェック
    $exam_subject = $exam{'subject:'};
    $exam_desc    = $exam{'description:'};
    $exam_note    = $exam{'note:'};

    unless ($exam_subject) {
	die "$EXAMPLE is not correct SIGEN file.\n";
    }

    print STDOUT "done.\n";
}


##################################################
#####                                        #####
##             メインルーチン                  ###
#####                                        #####
##################################################
#
# 1つ1つのファイルに関して処理
#
foreach $file (@filenames){
    #
    # 引数が存在しない場合はスキップ
    #
    unless (-e $file) {
	print STDOUT "$file is not found. Skipping ...\n" ;
	next;
    }

    #
    # ディレクトリを表す末尾のスラッシュ「/」を取り除く
    #
    $file =~ s|/+$||;

    #
    # SIGEN ファイル名生成
    #
    # 引数が .SIGEN ファイルで終わる場合はそれを処理する.
    if ($file =~ /^.*SIGEN$/) {
	$sigenfile = "${file}";
    } else {
	$sigenfile = "${file}.SIGEN";
    }

    #
    # 複数のファイルを処理してしまわない動作.
    #
    $nextflag = 0;
    foreach $used_sigen (@used_sigens) {
	if ($sigenfile eq $used_sigen) {
	    $nextflag = 1;
	}
    }
    if ($nextflag) {
	print STDOUT "$sigenfile is already treated. Skipping ...\n" ;
	next;
    }
    push(@used_sigens, $sigenfile);

    #
    # SIGEN ファイルが存在する場合は Update と履歴を更新する
    #
    if (-f $sigenfile){
	unless ($UpdateForce) {
	    print STDOUT "Update ${sigenfile} ? [Y/n]: " ;
	    $ans = <STDIN>;
	    if ($ans =~ /^[nN].*$/) {
		print STDOUT "Skipping $sigenfile ... \n";
		next;
	    }
	}
	print STDOUT "  History: ";
	$hist = <STDIN>;
	chomp($hist);
	print STDOUT "Updating $sigenfile ...";
	&UpdateSigen($sigenfile, $hist);
	print STDOUT " done.\n";
	
	next;
    }

    #
    # SIGEN ファイルが存在しない場合, 問い合わせて新規作成する
    #
    
    #  日付情報の生成
    $today = &GetToday;
    
    #####
    #  ファイル情報入力
    print STDOUT "Please Input Data for $sigenfile ...\n";
    # Subject
    $subject = &InputFromSTDIN('Subject:', $MultiLine, $exam_subject);
    if (!$subject) {
	die "Please Input Something to \"Subject:\".\n";
    }
    $desc = &InputFromSTDIN('Description:', $MultiLine, $exam_desc);
    $note = &InputFromSTDIN('Note:', $MultiLine, $exam_note);
    $hist = &InputFromSTDIN('History:', 0, '');

    #  SIGEN ファイルに 出力
    print STDOUT "Generating $sigenfile ...";
    open(SIGEN, ">$sigenfile");
    print SIGEN <<EOF;
Subject:	$subject
Maintainer:	$WRITER
Description:	$desc
Note:		$note
Update:		$today  $hist

履歴
	$today  $WRITER  $hist
EOF
    print STDOUT " done.\n";
}

exit 0;

##################################################
#####                                        #####
##             サブルーチン群                  ###
#####                                        #####
##################################################

#
# 標準入力取得用サブルーチン
#   (kitamo さんのアイディアをちょっと改造).
#
#   使用例
#           &InputFromSTDIN($header, $multi, $default)
#           &InputFromSTDIN($header, $multi)
#           &InputFromSTDIN($header)
#   引数
#           $header       "Subject:", "Description:" など
#           $multi        真なら複数行入力可能に
#           $default      未入力の際に代わるデフォルト値
#
sub InputFromSTDIN() {
    local($header, $multi, $default) = @_;
    local($TABLEN)    = $TABLEN;
    local($TABINDENT) = $TABINDENT;

    # ヘッダの長さからタブを何文字分入れるか決める。
    local($tabnum) = $TABINDENT - &trunc(length($header) / $TABLEN);
    die "Header \"$header\" is too long.\n" if ($tabnum < 0);

    # タブ文字およびインデント生成
    local($tab) = "\t" x $tabnum;
    local($indent) = "\t" x $TABINDENT;

    if ($default) {
	print STDOUT "  ${header} [", "$default", "] ";
    } else {
	print STDOUT "  ${header}${tab}";
    }

    # 標準入力の取得
    local($first) = 1;
    local($val)     = '';
    local($val_tmp) = '';
    while ($first || $val_tmp ne '' && $multi) {
	# 標準入力受け待ち画面の整形
	if (!$first) {
	    print STDOUT "$indent";
	}
	# 標準入力の取得
	$val_tmp = <STDIN>;
	chomp($val_tmp);
	# 複数行を受ける際の結合
	if ($first) {
	    $val = $val_tmp;
	} else {
	    # 空白行の場合は結合しない
	    if ($val_tmp ne '') {
		$val .= "\n" . "$indent" . "$val_tmp";
	    }
	}
	$first = 0;
    }

    chomp($val);
    # 値が空白でデフォルト値がある場合はそれを返す.
    if ($val eq '' && $default) {
	$val = $default;
    }
    chomp($val);
    return $val;
}


#
# 元々存在する $sigenfile をアップデートするサブルーチン
#
sub UpdateSigen(){
    local($sigenfile, $hist) = @_;
    # PATH が書かれている場合は, ファイル名のみを取り出す.
    @dir_names = split(/\//, $sigenfile);
    $sigenfilename = pop(@dir_names);
    local($sigentmp)  = "/tmp/${sigenfilename}.$$";

    local($today)  = &GetToday;
    open(ORG, "$sigenfile");
    open(UPDATE, "> $sigentmp");

    while (<ORG>){
	chomp($_);
	if ($_ =~ /^Update.*$/){
	    $_ = "Update:\t\t$today  $hist";
	}
	print UPDATE "$_\n";
    }
    # 履歴情報追加
    print UPDATE "\t$today  $WRITER  $hist\n";

    close(ORG);
    close(UPDATE);
    system "mv -f $sigentmp $sigenfile";
    system "chmod 664 $sigenfile";
}

#
# 本日の日時を取得し, 2004/09/28 のような形に整形するサブルーチン
#   kitamo さんの writesigen.pl より
#
sub GetToday() {
    local(@date, $year, $month, $day, $today);
    @date = localtime();
    $year = 1900 + @date[5];
    $month = 1 + @date[4];
    $day = @date[3];
    
    if ($month < 10) {
	$month = "0${month}";
    }
    if ($day < 10) {
	$day = "0${day}";
    }
    $today = "$year/$month/$day";
    return $today;
}

#
# ユーザ名取得用サブルーチン (dcreal-sigen から移植したものを改造)
#   http://www.gfd-dennou.org/arch/cc-env/dcreal/SIGEN.htm
#
sub GetUserName(){
    local(@passwd)    = getpwuid($<);
    local($loginname) = $passwd[0];
    local(@userinfo)  = split(/,/, $passwd[6]);
    local($name)      = $userinfo[0];
    local($tmpfile) = "/tmp/nametmpfile.$$";
    local(@knames, $kname);
    
    # まずは gate のデータベースから
    if (-x "/usr/local/bin/gate-user-show"){
	system ("gate-user-show $loginname > $tmpfile");
	open (GATE, "$tmpfile");
	while (<GATE>) {
	    chomp($_);
	    if ($_ =~ /^kname/){
		@knames = split(/: /, $_);
		$kname  = $knames[1];
	    }
	}
	close(GATE);
	system ("rm $tmpfile");
	return $kname;

    # gate が無い場合は /etc/passwd の情報より
    } elsif ($name) {
	return $name;

    # それもないならユーザー名
    } elsif ($loginname) {
	return $loginname;

    # 最後は偽を返す
    } else {
	return nil;
    }
}

#
# SIGEN ファイルのヘッダ解析用サブルーチン (mksigen.pl から移植して改造)
#   http://www.gfd-dennou.org/arch/cc-env/mksigen/desc.htm
#
sub ReadHeaders() {
    local($emlfile) = @_;
    local($name, $val, %headers);
    $name = ""; undef %headers;
    #
    open(READ, "$emlfile");
    while (<READ>) {
	# 行末の改行を取り除く
	chomp;
	s/\r$//;
	# 何も書き込まれていなければ終了
	last if /^$/;
	# 行の始めにスペースが入らないものを要素として取り込む
	if (!/^\s/) {
	    # 「Subject: Test」のような書式を想定
	    if (!/^([-A-Za-z0-9]*:)\s*(.*)/) {
		warn "Error: broken header \"$_\" in $emlfile\n";
		next;
	    }
	    ($name = $1) =~ tr/A-Z/a-z/;
	    ($val = $2) =~ s/[\r]/ /g;
	    if (defined $headers{$name}) {
		$headers{$name} .= "\n$val";
	    } else {
		$headers{$name} = $val;
	    }
	} else {
	    s/[\r]/ /g;
	    s/^ */ /;
	    $headers{$name} .= "\n$_";
	}
    }
    return %headers;
}

# 切り上げサブルーチン
#   http://www2u.biglobe.ne.jp/~MAS/perl/waza/menu.html
#   - http://www2u.biglobe.ne.jp/~MAS/perl/waza/ceil.html
#
#   使い方
#          &ceil($val, $col)
#          &ceil($val)
#   引数
#          $val       切り上げる数
#          $col       小数点以下のどこまで残すか
#                     ... 1: 小数一桁, 0: 零の位, -1: 一の位 ...
#                     与えない場合は 0 (零の位) となる.
sub ceil {
    local($val, $col) = @_;
    local($r) = 10 ** $col;
    if ($val > 0) {
	local($tmp) = $val * $r;
	if ($tmp == int($tmp)) {
	    return $tmp / $r;
	} else {
	    return int($tmp + 1) / $r;
	}
    } else {
	return int($val * $r) / $r;
    }
}

# 切り捨てサブルーチン
#   http://www2u.biglobe.ne.jp/~MAS/perl/waza/menu.html
#   - http://www2u.biglobe.ne.jp/~MAS/perl/waza/trunc.html
#
#   使い方
#          &ceil($val, $col)
#          &ceil($val)
#   引数
#          $val       切り捨てる数
#          $col       小数点以下のどこまで残すか
#                     ... 1: 小数一桁, 0: 零の位, -1: 一の位 ...
#                     与えない場合は 0 (零の位) となる.
sub trunc {
    local($val, $col) = @_;
    local($r) = 10 ** $col;
    if ($val > 0) {
	return int($val * $r) / $r;
    } else {
	local($tmp) = $val * $r;
	if ($tmp == int($tmp)) {
	    return $tmp / $r;
	} else {
	    return int($tmp - 1) / $r;
	}
    }
}