| $description |
以下のリストから選んでください:
|
END
}
# HTML 文書の末尾の作成
# 引数
# $title 文書のタイトル
sub printHtmlClosing {
local($title) = @_;
print "
\n";
print "$title にもどる
\n"
if &FormSubmitted();
print <<"END";
END
}
#
# CGI (Common Gateway Interface) 関係のサブルーチン
#
# ユーザ情報カードを読み込んだ連想配列 %param から
# クッキーにセットすべき文字列を作る.
sub HashToCookie {
local(%param) = @_;
local(@pairs) = ();
local($key, $value);
foreach $key (sort(keys(%param))) {
$value = $param{$key};
push(@pairs, &URLEncode($key) . ":" . &URLEncode($value));
}
join('&', @pairs);
}
# CGI スクリプトから呼び出した場合, 自分自身のファイル名を返す.
# これは応答の送り先や戻り先のリンクとして使われる.
sub CGISelfName {
$ENV{'SCRIPT_NAME'};
}
# CGI データの長さを返す.
sub CGIDataLength {
$ENV{'CONTENT_LENGTH'};
}
# ユーザが Submit ボタンを押した場合真が、
# そうでない場合偽が返される。
# CGI プロトコル参照.
sub FormSubmitted() {
return ($ENV{"CONTENT_LENGTH"} > 0);
}
# CGI データを読み込んで連想配列として返す.
# データが与えられていない場合は空リストが返る.
sub getCGIData {
local(%card);
local($data, $key, $value);
require 'jcode.pl';
return () unless &FormSubmitted();
read(STDIN, $alldata, &CGIDataLength);
foreach $data (split(/&/, $alldata)) {
($key, $value) = split(/=/, $data);
$value =~ tr/+/ /;
$value = &URLDecode($value);
&jcode'convert(*value, "euc");
$card{$key} = $value;
}
%card;
}
# 引数 $x を URL エンコードして返す.
# クッキーにいれる文字列は全てこの処理をしなくてはならない。
# CGI プロトコル参照.
sub URLEncode {
local($x) = @_;
$x =~ s/([&:;=%\x00-\x21])/sprintf("%%%02X",unpack("C",$1))/ge;
return $x;
}
# URL エンコードされた文字列 (引数 $x) を解読して返す.
# クッキー起源の文字列は全てこの処理をしなくてはならない。
# CGI プロトコル参照.
sub URLDecode {
local($x) = @_;
$x =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack("C",hex($1))/ge;
return $x;
}
0;
# addcgi.pl - CGI main program for dcbib
# Copyright (C) TOYODA Eizi, 1999. All rights reserved.
#
$rcsid .= '$Id: addcgi.pl,v 1.20 1999/11/06 18:14:50 toyoda Exp $';
#
require 'open3.pl';
$TITLE = "dcbib 文献登録のページ";
$MAILADDR = "toyoda\@gfd-dennou.org";
$BINDIR = '/usr/bin';
if (not &FormSubmitted()) {
&SyokiGamen();
exit 0;
}
%card = &getCGIData();
if ($card{'phase'} eq 'initial') {
if (not &EmailCheck($card{'from'})) {
&SyokiGamen("電子メールアドレスを入力してください.");
exit 0;
}
&NyuuryokuGamen();
} else {
&KekkaGamen();
}
exit 0;
sub SyokiGamen {
local($message) = @_;
&printHtmlOpening($TITLE);
if ($message) {
print "
", $message;
}
print <
EOF
&printHtmlClosing($TITLE);
}
sub NyuuryokuGamen {
$lang = $card{'lang'} || 'ja';
$user = $card{'from'};
$user =~ s/@.*//;
&printHtmlOpening($TITLE);
print <
EOF
&printHtmlClosing($TITLE);
}
sub KekkaGamen {
($exitcode, $pid, @result) = &processCard;
&printHtmlOpening($TITLE);
print "
\n";
if ($exitcode == 0) {
$result = "成功";
} elsif ($exitcode == 1) {
$result = "(警告はあるものの) いちおう成功";
} else {
$result = "失敗";
}
print "処理は${result}しました
\n";
print join("
\n", @result);
print <
送信内容は以下のとおりです。
EOF
foreach $key (keys %card) {
print "- $key:
- $card{$key}\n";
}
print "
\n";
&printHtmlClosing($TITLE);
}
sub processCard {
if ($select = $card{'select-author-or-editor'}) {
$card{$select} = $card{'author-or-editor'};
delete $card{'author-or-editor'};
delete $card{'select-author-or-editor'};
}
delete $card{'phase'};
local($READ, $WRITE, $pid, @result, $exitcode);
$READ = "READ";
$WRITE = "WRITE";
$pid = &open3($WRITE, $READ, '', "$BINDIR/dcbib-add");
&writeCardStream($WRITE, %card);
close($WRITE);
@result = <$READ>;
(waitpid($pid, 0) >= 0)
|| (@result = ("$?: invocation failed."));
$exitcode = (($? >> 8) & 255);
($exitcode, $pid, @result)
}
sub EmailCheck {
local($email) = @_;
return 0 unless $email;
return ($email =~ /.@./);
}
sub writeCardStream {
local($WRITE, %card) = @_;
local(%xcard);
foreach $key (keys %card) {
$xcard{"$key:"} = $card{$key};
}
&emlWrite($WRITE, %xcard);
}
sub date {
local($sec, $min, $hour, $day, $mon, $year) = gmtime(time);
return sprintf("%04d-%02d-%02d", $year+1900, $mon+1, $day);
}
# error.pl: error handler
# $Id: error.pl,v 1.3 1999/05/18 12:47:51 toyoda Exp $
# Copyright (c) TOYODA Eizi, 1998. All rights reserved.
# see COPYING.TXT for terms of license.
sub die {
local($msg) = @_;
print STDERR "ERROR: $msg\n";
exit 2;
}
sub warn {
local($msg) = @_;
print STDERR "WARNING: $msg\n";
$exit = 1;
}
sub okay {
local($msg) = join(' ', @_);
print STDERR "OK: $msg\n";
}
sub exit {
exit $exit;
}
# RFC-822-like file reading/writing module
# $Id: rfc822.pl,v 1.4 1999/11/06 18:04:25 toyoda Exp $
# Copyright (c) TOYODA Eizi, 1998. All rights reserved.
# see COPYING.TXT for terms of license.
sub emlOpenFile {
local($file) = @_;
&open_r($file) || &die("cannot open <$file>");
&emlSetFile($file);
}
sub emlSetFile {
($emlFile) = @_;
}
sub emlReadLine {
&readline($emlFile);
}
# -- emlRead() ---
#
# Reads RFC 822 headers from $inputfile and returns hash with which
# $returned_hash{$field_name} == $filed_value,
# where $field_name is lowercased and colon-containing filed name.
# If $field_value contains '\n', it means that the header
# $field_name appeared more than once.
# Undefined return value means there is a format error.
sub emlRead {
local(%headers) = ();
local($name, $val) = ("", "");
while ($_ = &emlReadLine) {
s/\r?\n$//;
last if /^$/;
if (!/^\s/) {
next if /^From /;
if (!/^([-A-Za-z0-9]*:)\s*(.*)/) {
&warn("broken header <$_> in $emlFile");
return undef;
}
($name = $1) =~ tr/A-Z/a-z/;
($val = $2) =~ s/[\t\r]/ /g;
if (defined $headers{$name}) {
# 同名複数ヘッダは改行区切
$headers{$name} .= "\n$val";
} else {
$headers{$name} = $val;
}
} else {
s/[\t\r]/ /g;
# 継続行はタブ区切
s/^ */\t/;
$headers{$name} .= $_;
}
}
%headers;
}
sub emlWrite {
local($outfnam, %headers) = @_;
local($fieldname, @values, $value, $folded);
foreach $fieldname (keys %headers) {
local(@values) = split(/\n/, $headers{$fieldname});
foreach $value (@values) {
next if $value =~ /^[ \n\t]*$/;
$folded = $value;
$folded =~ s/\t/\n\t/g;
print $outfnam "$fieldname $value\n";
}
}
}
# misc. file io concerned subroutines
# $Id: fio.pl,v 1.4 1999/05/18 12:47:51 toyoda Exp $
# Copyright (c) TOYODA Eizi, 1998. All rights reserved.
# see COPYING.TXT for terms of license.
# create file to write. make directory if necessary.
sub creat {
local($fnam) = @_;
local($parent) = $fnam;
&CheckUmask;
&mkdir($parent) if ($parent =~ s/\/[^\/]+$//);
open($fnam, ">$fnam") || &die("creat $fnam");
$fnam;
}
sub CheckUmask {
return unless ((umask) & 0660);
local($umask) = (umask) & ~0660;
&warn(sprintf("warning: umask set to %04lo\n", $umask));
umask $umask;
}
sub mkdir {
local($dnam) = @_;
return if (-d $dnam);
local($parent) = $dnam;
if ($parent =~ s/\/[^\/]+$//) {
&mkdir($parent);
} else {
return;
}
mkdir($dnam, 0777) || &die("mkdir $dnam");
}
# test.pl - 文献カードの内容のチェック
# $Id: test.pl,v 1.6 1999/11/01 10:42:09 toyoda Exp $
# Copyright (c) TOYODA Eizi, 1998. All rights reserved.
# see COPYING.TXT for terms of license.
# 仮定:
# 各ヘッダの内容は %HEADER に格納されている。
sub testCard {
local(*HEADER) = @_;
if (!$HEADER{'cardtype:'}) {
&die("cardtype: not given.");
} elsif ($HEADER{'cardtype:'} eq 'article') {
&testCardAuthor;
&testCardTitle;
&testCardJournal;
&testCardYear;
&testCardPages(0);
} elsif ($HEADER{'cardtype:'} eq 'inbook') {
&testCardAuthorOrEditor;
&testCardTitle;
&testCardPublisher;
&testCardYear;
&testCardChapter;
&testCardPages(1);
} elsif ($HEADER{'cardtype:'} eq 'book') {
&testCardAuthorOrEditor;
&testCardTitle;
&testCardPublisher;
&testCardYear;
} else {
&die("unknown CardType: $HEADER{'cardtype:'}.");
}
}
sub testCardChapter {
&die("chapter: required.") if ($required && !$HEADER{'chapter:'});
}
sub testCardPublisher {
&die("publisher: required.") if ($required && !$HEADER{'publisher:'});
}
sub testCardPages {
local($required) = @_;
&die("pages: required.") if (!$required && !$HEADER{'pages:'});
&warn("pages: has no number. Are you sure?")
if ($HEADER{'pages:'} !~ /[0-9]/);
}
sub testCardAuthorOrEditor {
local($fail) = 1;
if ($HEADER{'author:'}) {
&testCardAuthor;
$fail = 0;
}
if ($HEADER{'editor:'}) {
&testCardEditor;
$fail = 0;
}
}
sub testCardEditor {
&die("editor: required.") unless $HEADER{'editor:'};
}
sub testCardAuthor {
&die("author: required.") unless $HEADER{'author:'};
&warn("author: should begin in uppercase letter.")
if ($HEADER{'author:'} =~ /^[a-z]/);
&warn("author: should begin in A-Za-z. ($HEADER{'author:'})")
unless ($HEADER{'author:'} =~ /^[A-Za-z]/);
}
sub testCardJournal {
&die("journal: required.") if (!$HEADER{'journal:'});
}
sub testCardTitle {
&die("title: required.") if (!$HEADER{'title:'});
# 本当は ASCII を強制してもよいが、もうちょっと弱気に
# アルファベットが1文字もみあたらないと警告する
&warn("title: has no letter. Are you sure?")
if ($HEADER{'title:'} !~ /[A-Za-z]/);
}
sub testCardYear {
$HEADER{'year:'} =~ s/\s+//g;
if ($HEADER{'year:'} =~ /([^0-9x]+)/) {
local($bad) = $1;
$HEADER{'year:'} =~ tr/0-9/x/c;
&warn("year: has bad character '$bad' --- converted to 'x'.");
}
&die("year: required.") if ($HEADER{'year:'} !~ /[0-9x]/);
}
# card.pl - 文献カードのフィールドたちに関する情報
# $Id: card.pl,v 1.2 1999/05/30 13:33:54 toyoda Exp $
# Copyright (c) TOYODA Eizi, 1998. All rights reserved.
# see COPYING.TXT for terms of license.
sub cardTypeHash {
%CARDTYPE = (
'article' => '定期刊行物または学術雑誌の記事',
'book' => '書籍 (出版者が明確なもの)',
'booklet' => '書籍 (出版者の明確でないもの)',
'inbook' => '書籍の一部 (固有の表題をもたないもの)',
'incollection' => '書籍の一部 (表題のついたまとまり)',
'inproceedings' => '会議の予稿集に収録された論文',
'manual' => '技術文書',
'masterthesis' => '修士論文',
'misc' => 'その他',
'phdthesis' => '博士論文',
'proceedings' => '会議の予稿集',
'techreport' => '学校や団体の刊行した報告集のひとつ',
'unpublished' => '未公刊文献',
);
%REQUIREDFIELD = (
'article' => 'author title journal year',
'book' => 'author/editor title publisher year',
'booklet' => 'title',
'inbook' => 'author/editor title chapter/pages publisher year',
'incollection' => 'author title booktitle publisher year',
'inproceedings' => 'author title booktitle year',
'manual' => 'title',
'masterthesis' => 'author title school year',
'misc' => '',
'phdthesis' => 'author title school year',
'proceedings' => 'title year',
'techreport' => 'author title institution year',
'unpublished' => 'author title note',
);
%OPTIONFIELD = (
'article' => 'volume number pages month',
'book' => 'volume series address edition month',
'booklet' => 'author howpublished address month year',
'inbook' => 'volume series address edition month',
'incollection' => 'editor chapter pages address month',
'inproceedings' => 'editor pages organization publisher address',
'manual' => 'author organization address edition month year',
'masterthesis' => 'address month',
'misc' => 'author title howpublished month year',
'phdthesis' => 'address month',
'proceedings' => 'editor publisher organization address month',
'techreport' => 'type number address month',
'unpublished' => 'month year',
);
%FIELDDESCRIPTION = (
'address' => '出版者の住所 (著名な出版社ならば都市名だけで可)',
'author' => '著者 (複数いる場合はそれぞれ別の行に記述)',
'booktitle' => '書籍の表題',
'chapter' => '章番号',
'edition' => '書籍の版数',
'editor' => '編集者',
'howpublished' => 'どのように刊行されたか',
'institution' => '発行元組織',
'journal' => '定期刊行物名称',
'month' => '刊行された月 (未刊行の場合は書かれた月)',
'note' => '付加情報',
'number' => '号数',
'organization' => '発行元組織 (会議のスポンサー)',
'pages' => 'ページ範囲',
'publisher' => '出版者',
'school' => '大学',
'series' => '書籍シリーズの表題',
'title' => '表題',
'type' => '報告書の種別',
'volume' => '巻番号',
'year' => '刊行された年 (未刊行の場合は書かれた年)',
);
}
sub cardTypeList {
defined %CARDTYPE || cardTypeHash;
keys %CARDTYPE;
}
sub cardTypeDescription {
local($type) = @_;
defined %CARDTYPE || cardTypeHash;
$CARDTYPE{$type};
}
sub requiredFields {
local($type) = @_;
defined %REQUIREDFIELD || cardTypeHash;
split(' ', $REQUIREDFIELD{$type});
}
sub optionFields {
local($type) = @_;
defined %OPTIONFIELD || cardTypeHash;
split(' ', $OPTIONFIELD{$type});
}
sub availableFields {
local($type) = @_;
defined %OPTIONFIELD || cardTypeHash;
split(' ', "$REQUIREDFIELD{$type} $OPTIONFIELD{$type}");
}
# japanese.pl - 日本語文字コード変換ルーチン
# $Id: japanese.pl,v 1.5 1999/05/18 12:47:51 toyoda Exp $
# Copyright (C) TOYODA Eizi, 1999. All rights reserved.
#
# プログラムの内部表現として日本語 EUC を使うためのサブルーチン。
#
# &initKC
# 漢字コード変換手段を選択する. 自動的に起動されるが
# 自動判定履歴を初期化する場合には明示的に呼んでもよい.
#
# &open_r($filename)
# ファイルを読み込みのために開き, そのハンドルを返す.
#
# &readline($handle)
# $handle から 1 行読み取り内部コードに変換したものを返す.
#
# $KCMethod
# 'jcodepl': Perl で自ら jcode.pl を読みに行く. 最善の手段.
# 'nkf': /usr/bin にあるものを起動する. 次善の策.
# undef: 最悪.
#
# $KCICode, $KCOCode
# 'jis' ISO-2022-JP
# 'euc' 日本語 EUC (デフォルト)
# 'sjis' JIS X 0208-1997 付属書 シフト符号化表現
sub initKC {
$KC_NKF = '/usr/bin/nkf';
if (require 'jcode.pl') {
$KCMethod = 'jcodepl';
} elsif (-x $KC_NKF) {
$KCMethod = 'nkf';
} else {
die "no kanji conversion method found.";
}
$KCIcode = undef;
}
sub open_r {
local($filename) = @_;
defined($KCMethod) || &initKC;
local($path);
if ($KCMethod eq 'nkf') {
$path = "$KC_NKF -e \"$filename\"|"
} else {
$path = "<$filename";
}
open($filename, "$path") && $filename;
}
sub readline {
local($handle) = @_;
local($line, $code);
defined($KCMethod) || &initKC;
($line = <$handle>) || return undef;
return $line if ($line !~ /[\033\200-\377]/);
if ($KCMethod eq 'jcodepl') {
($code = &jcode'getcode(*line)) && ($KCIcode = $code);
&jcode'convert(*line, 'euc', $KCIcode);
&jcode'h2z_euc(*line);
}
$line;
}
# debug code: not executed if this file follows 'exit;' line.
while ($fnam = shift) {
$handle = &open_r($fnam);
while ($_ = &readline($handle)) {
print;
}
}