短編の作者データ・作品データを扱うためのPerlモジュール。
おそらく運営者しか使わないものですが。
# Tanpen.pm use strict; package Tanpen; my %Author; # 作者データと作品データを格納するハッシュ my @Turn; # 各期の作品データを格納する配列 my %RealName; # 別名から本名を返すハッシュ(別名があれば) # データ構造作成 &_read_alias; &_read_entries; # 別名ファイルの読み込み sub _read_alias { open(IN, "alias.txt") or die "alias list open fail!\n"; while (<IN>) { next if (/^#/); chomp; my @name = split /\t/; foreach my $n (@name) { $RealName{$n} = $name[0]; } } close IN; } # 全作品データファイルの読み込み sub _read_entries { open(IN, "entries.txt") or die "entry list open fail!\n"; while (<IN>) { next if (/^#/); chomp; my ($turn, $entry, $title, $author, $letters, $result, $pre, $fin, $mail, $url, $sitename) = split(/\t/); my $real = $RealName{$author} || $author; # {投稿名}の要素がなかったら作る unless ($Author{$author}) { # 更に{本名}の要素がなかったら新たに作る unless ($Author{$real}) { $Author{$real}->{id} = "$turn-$entry"; } # {投稿名}と{本名}が違う場合は{本名}と同じ内容を指す if ($real ne $author) { $Author{$author} = $Author{$real}; } } # メール、ウェブサイトは最新のものを設定 $Author{$real}->{mail} = $mail; $Author{$real}->{url} = $url if ($url); $Author{$real}->{sitename} = $sitename if ($sitename); # 作品リストに作品データを追加 my $work = { turn => $turn, entry => $entry, title => $title, author => $author, result => $result, letters => $letters, pre => $pre, fin => $fin, }; my $workobj = Tanpen::Work->new($work); push @{$Author{$real}->{works}}, $workobj; $Turn[$turn - 1]->[$entry - 1] = $workobj; } close IN; } # 作者オブジェクトの作成とメソッドの定義 sub new { my $class = shift; bless \%Author, $class; } sub id { my ($self, $name) = @_; return $self->{$name}->{id}; } sub mail { my ($self, $name) = @_; return $self->{$name}->{mail}; } sub url { my ($self, $name) = @_; return ($self->{$name}->{url} || ""); } sub sitename { my ($self, $name) = @_; return ($self->{$name}->{sitename} || ""); } sub link_tag { my ($self, $name) = @_; return "" unless ($self->{$name}->{url}); my $url = $self->{$name}->{url}; my $sitename = $self->{$name}->{sitename} || $url; return qq{<a href="$url">$sitename</a>}; } sub result_string { my ($self, $name) = @_; return join "", map $_->{result}, @{$self->{$name}->{works}}; } sub work_list { my ($self, $name) = @_; return @{$self->{$name}->{works}}; } sub has_alias { my ($self, $name) = @_; return ($RealName{$name}) ? 1 : 0; } sub real_name { my ($self, $name) = @_; return ($RealName{$name} || $name); } sub turn_list { return @Turn; } sub author_list { my $self = shift; my $include_alias = shift || 0; if ($include_alias) { return sort keys %Author } else { return grep { if (has_alias($self, $_)) { real_name($self, $_) eq $_; } else { 1; } } sort keys %Author; } } 1; # 作品オブジェクト package Tanpen::Work; sub new { my $class = shift; my $ref = shift; bless { turn => $ref->{turn}, entry => $ref->{entry}, title => $ref->{title}, author => $ref->{author}, result => $ref->{result}, letters => $ref->{letters}, pre => $ref->{pre}, fin => $ref->{fin}, }, $class; } sub turn { my $self = shift; return $self->{turn}; } sub entry { my $self = shift; return $self->{entry}; } sub title { my $self = shift; return $self->{title}; } sub author { my $self = shift; return $self->{author}; } sub result { my $self = shift; return $self->{result}; } sub letters { my $self = shift; return $self->{letters}; } sub pre { my $self = shift; return $self->{pre}; } sub fin { my $self = shift; return $self->{fin}; } 1;
# alllist.txt -> entries.txt use strict; use Jcode; while (<>) { chomp; #jcode(\$_); my($turn, $entry, $title, $realname, $author, $letters, $result, $pre, $fin, $mail, $url, $sitename) = split /\t/; $mail =~ s/@/\@/; print join "\t", ($turn, $entry, $title, $author, $letters, $result, $pre, $fin, $mail, $url, $sitename); print "\n"; }YukiWiki 2.1.2 (C) 2000-2004 by Hiroshi Yuki.