1 |
#!/usr/bin/perl |
#!/usr/bin/perl |
|
#!perl |
|
2 |
# |
# |
3 |
# wiki.cgi - This is YukiWiki, yet another Wiki clone. |
# wiki.cgi - This is YukiWiki, yet another Wiki clone. |
4 |
# |
# |
9 |
# This program is free software; you can redistribute it and/or |
# This program is free software; you can redistribute it and/or |
10 |
# modify it under the same terms as Perl itself. |
# modify it under the same terms as Perl itself. |
11 |
# |
# |
|
############################## |
|
|
# |
|
12 |
# walwiki.cgi based on yukiwiki.cgi - Yet another WikiWikiWeb clone. |
# walwiki.cgi based on yukiwiki.cgi - Yet another WikiWikiWeb clone. |
|
# |
|
|
# WalWikiの現バージョンは、YukiWiki 2.0.beta1をベースにしています。 |
|
|
# |
|
|
# * 更新内容 |
|
|
# |
|
|
# 2.0.beta1.wal.1 on 2002/05/19,22:32:19 |
|
|
# (1) Footerの変更 |
|
|
# (2) WikiNameの拡張 : PerlCEも包含、PPMInstallは含まない |
|
|
# (3) 別名リンク([別名 URL])に対応。 |
|
|
# (4) ISBNをアマゾン.jpのAsociateプログラムリンクに変換。 |
|
|
# (5) [[#box:InterWikiName]]でInterWikiなテキストボックス生成 |
|
|
# (6) HTMLモード対応。 |
|
|
# |
|
|
# 旧2.0.alpha0.wal.3版までの修正の内、以下に変更があります。 |
|
|
# ・以下はYukiWiki2に実装されたため、独自コードはなくなりました。 |
|
|
# - インラインの画像変換 |
|
|
# - YukiWikiDB対応 |
|
|
# - テーブル |
|
|
# - DB関連モジュールuseのeval化 |
|
|
# - BracketNameによるキーからブラケットを排除 |
|
|
# ・ISBN番号への対応はWalWiki2.0より、InterWikiへのAdd-Onになりました。 |
|
|
# [[ISBN http://www.amazon.co.jp/exec/obidos/ASIN/isbn($1)/walrdigi-22]]のように登録。 |
|
|
# |
|
|
#======================================= |
|
13 |
|
|
14 |
# Walrus add (debug) start |
# Walrus add (debug) start |
15 |
my $walrus_log; |
my $walrus_log; |
86 |
my $NAME_OF_WikiPageLicense = 'WikiPageLicense'; |
my $NAME_OF_WikiPageLicense = 'WikiPageLicense'; |
87 |
my $AdminSpecialPage = 'Admin Special Page'; # must include spaces. |
my $AdminSpecialPage = 'Admin Special Page'; # must include spaces. |
88 |
############################## |
############################## |
|
# my $wiki_name = '\b([A-Z][a-z]+([A-Z][a-z]+)+)\b'; # Walrus del (2) |
|
|
my $wiki_name = '\b([A-Z][a-z]+([A-Z][a-z]*)+)\b'; # Walrus add (2) |
|
89 |
my $bracket_name = '\[\[(\S+?)\]\]'; |
my $bracket_name = '\[\[(\S+?)\]\]'; |
90 |
my $embedded_name = '\[\[(#\S+?)\]\]'; |
my $embedded_name = '\[\[(#\S+?)\]\]'; |
91 |
my $interwiki_definition = '\[\[(\S+?)\ (\S+?)\]\]'; |
my %fmt; ## formatter objects |
|
my $interwiki_name = 'i:([^:]+):([^:].*)'; |
|
92 |
############################## |
############################## |
93 |
my $embed_comment = '[[#comment]]'; |
my $embed_comment = '[[#comment]]'; |
94 |
my $embed_rcomment = '[[#rcomment]]'; |
my $embed_rcomment = '[[#rcomment]]'; |
736 |
$line =~ s%\[Q\[([^]]+)\](?: \[<([\x21-\x5A\x5E-\x7E]+)>\])?\]%「<q@{[$2?qq( cite="$2"):'']}>$1</q>」%g; |
$line =~ s%\[Q\[([^]]+)\](?: \[<([\x21-\x5A\x5E-\x7E]+)>\])?\]%「<q@{[$2?qq( cite="$2"):'']}>$1</q>」%g; |
737 |
$line =~ s|'''([^']+)'''|<strong>$1</strong>|g; |
$line =~ s|'''([^']+)'''|<strong>$1</strong>|g; |
738 |
$line =~ s|''([^']+)''|<em>$1</em>|g; |
$line =~ s|''([^']+)''|<em>$1</em>|g; |
739 |
$line =~ s! |
$line =~ s{ |
740 |
( |
((?:$bracket_name)) # [[likethis]], [[#comment]], [[Friend:remotelink]] |
|
(?:<(?:mailto|http|https|ftp|urn|news):[\x21-\x7E]*)> |
|
|
| |
|
|
(?:$bracket_name)) # [[likethis]], [[#comment]], [[Friend:remotelink]] |
|
741 |
|\[\[([^[]+?)]>>([0-9]+)] # [[WikiName]>>1] |
|\[\[([^[]+?)]>>([0-9]+)] # [[WikiName]>>1] |
742 |
|>>([0-9]+) |
|>>([0-9]+) |
743 |
! |
|<([A-Za-z0-9%]+:(?:(?!>).)+)> |
744 |
my ($l, $page,$anchor, $anum) = ($1, $3,$4, 0+$5); |
}{ |
745 |
|
my ($l, $page,$anchor, $anum, $uri) = ($1, $3,$4, 0+$5, $6); |
746 |
if ($l) { |
if ($l) { |
747 |
&make_link($l) |
&make_link($l) |
748 |
} elsif (defined $page) { |
} elsif (defined $page) { |
749 |
&make_wikilink ($page, anchor => 0+$anchor); |
&make_wikilink ($page, anchor => 0+$anchor); |
750 |
} elsif ($anum) { |
} elsif ($anum) { |
751 |
qq(<a href="#anchor-$anum" class="wiki-anchor">>>$anum</a>); |
qq(<a href="#anchor-$anum" class="wiki-anchor">>>$anum</a>); |
752 |
|
} elsif ($uri) { |
753 |
|
&make_urilink ($uri); |
754 |
} |
} |
755 |
!gex; |
}gex; |
756 |
return $line; |
return $line; |
757 |
} |
} |
758 |
|
|
771 |
} |
} |
772 |
} |
} |
773 |
|
|
774 |
|
sub make_urilink ($;%) { |
775 |
|
require URI; |
776 |
|
my $uri = shift; |
777 |
|
if ($uri =~ s/^IW://) { ## InterWiki (not URI) |
778 |
|
$uri = &unescape ($uri); |
779 |
|
if ($uri =~ /^([^\x00-\x2F\x3A-\x40\x5B-\x60\x7B-\x7F]+|"(?:\\.|[^"\\])+"):([^\x00-\x2F\x3A-\x40\x5B-\x60\x7B-\x7F]+|"(?:\\.|[^"\\])+")$/) { |
780 |
|
my ($site, $name) = ($1, $2); |
781 |
|
for ($site, $name) { |
782 |
|
if (s/^"//) { s/"$//; s/\\(.)/$1/g } |
783 |
|
} |
784 |
|
if ($interwiki{$site}) { |
785 |
|
my $uri = &escape ($fmt{interwiki}->replace ($interwiki{$site} => {site => $site, name => $name})); |
786 |
|
$site = &escape ($site); $name = &escape ($name); |
787 |
|
qq(<<a href="$uri" class="out-of-wiki interwiki" title="$name ($site); URI: <$uri>">$name</a>>); |
788 |
|
} else { |
789 |
|
qq(<未登録の <a href="$url_cgi?InterWikiName" class="wiki">InterWikiName</a>: @{[&escape ($site)]}>); |
790 |
|
} |
791 |
|
} else { |
792 |
|
qq(<不正な <a href="$url_cgi?InterWikiName" class="wiki">InterWikiName</a>: @{[&escape($uri)]}>); |
793 |
|
} |
794 |
|
} elsif ($uri =~ /^urn:/) { ## URN |
795 |
|
my $uri2 = &escape (URI->new ('/uri-res/N2L?'.&unescape ($uri), 'http')->canonical); |
796 |
|
qq(<<a href="$uri2" title="URI: <$uri> (via <$uri2>)" class="out-of-wiki urn">$uri</a>>); |
797 |
|
} elsif ($uri =~ s/^MAIL://) { ## mail address (not URI) |
798 |
|
my $uri2 = &escape (URI->new ('mailto:'.&unescape ($uri))->canonical); |
799 |
|
qq(<<a href="$uri2" class="out-of-wiki mail">$uri</a>>); |
800 |
|
} elsif ($uri =~ s/^IMG(?:\([^)]+\))?://) { ## image (not URI itself) |
801 |
|
my $uri2 = &escape (URI->new (&unescape ($uri))->canonical); |
802 |
|
qq(<img src="$uri2" alt="" title="URI: <$uri2>" class="out-of-wiki">); |
803 |
|
} else { ## misc. URI |
804 |
|
CGI::Carp::warningsToBrowser (0); |
805 |
|
my $uri2 = &escape (URI->new (&unescape ($uri))->canonical); |
806 |
|
CGI::Carp::warningsToBrowser (1); |
807 |
|
qq(<<a href="$uri2" title="URI: <$uri2>" class="out-of-wiki">$uri</a>>); |
808 |
|
} |
809 |
|
} |
810 |
|
|
811 |
|
## to be obsoleted |
812 |
sub make_link { |
sub make_link { |
813 |
my $chunk = shift; |
my $chunk = shift; |
814 |
# Walrus add (3) start |
# Walrus add (3) start |
815 |
$chunk =~ s/^<(.*)>$/$1/; |
$chunk =~ s/^<(.*)>$/$1/; |
816 |
my $name = $chunk; |
my $name = $chunk; |
|
if ($chunk =~ /^\[\[([^ ]+?) ([^ ]+?)\]\]$/ and $form{mypage} ne $InterWikiName) { |
|
|
($name, $chunk) = ($1, $2); |
|
|
} elsif ($chunk =~ /^mailto:(.*)$/) { |
|
|
$name = $1; |
|
|
} |
|
|
if ($use_autoimg and $name =~ /^(http|https|ftp):.+\.(png|gif|jpe?g)/) { |
|
|
$name = qq(<img src="$name">) ; |
|
|
} |
|
817 |
$name = &unarmor_name($name); |
$name = &unarmor_name($name); |
818 |
# Walrus add (3) end |
# Walrus add (3) end |
819 |
if ($chunk =~ /^(http|https|ftp|news):/) { |
if ($chunk =~ /^$embedded_name$/) { |
|
# Walrus mod (3) start |
|
|
# if ($use_autoimg and $chunk =~ /\.(gif|png|jpeg|jpg)$/) { |
|
|
# return qq(<a href="$chunk"><img src="$chunk"></a>); |
|
|
# } else { |
|
|
# return qq(<a href="$chunk">$chunk</a>); |
|
|
# } |
|
|
return qq(<<a href="$chunk">$name</a>>); |
|
|
# Walrus mod (3) end |
|
|
} elsif ($chunk =~ m#^urn:[0-9A-Za-z_:;/.-]+#) { |
|
|
return qq|<<a href="/uri-res/N2L?${name}">$name</a>>|; |
|
|
} elsif ($chunk =~ /^mailto:(.*)/) { |
|
|
# return qq(<a href="$chunk">$2</a>); # Walrus del (3) |
|
|
return qq(<<a href="$chunk">$name</a>>); # Walrus add (3) |
|
|
} elsif ($chunk =~ /^$interwiki_definition$/) { |
|
|
# return qq(<span class="InterWiki">$chunk</span>); # Walrus del (3) |
|
|
return qq(<span class="InterWiki">$name</span>); # Walrus add (3) |
|
|
} elsif ($chunk =~ /^$embedded_name$/) { |
|
820 |
return &embedded_to_html($chunk); |
return &embedded_to_html($chunk); |
821 |
} else { |
} else { |
822 |
$chunk = &unarmor_name($chunk); |
$chunk = &unarmor_name($chunk); |
823 |
$chunk = &unescape($chunk); # To treat '&' or '>' or '<' correctly. |
$chunk = &unescape($chunk); # To treat '&' or '>' or '<' correctly. |
824 |
my $cookedchunk = &encode($chunk); |
my $cookedchunk = &encode($chunk); |
825 |
if ($chunk =~ /^$interwiki_name$/) { |
if ($database{$chunk}) { |
|
my ($intername, $localname) = ($1, $2); |
|
|
my $remoteurl = $interwiki{$intername}; |
|
|
if ($remoteurl) { |
|
|
# $remoteurl =~ s/\b(euc|sjis|ykwk|asis)\(\$1\)/&interwiki_convert($1, $localname)/e; # Walrus del (4) |
|
|
$remoteurl =~ s/\b(euc|sjis|ykwk|asis|isbn)\(\$1\)/&interwiki_convert($1, $localname)/e; # Walrus add (4) |
|
|
# return qq(<a href="$remoteurl">$chunk</a>); # Walrus del (3) |
|
|
return qq(<a href="$remoteurl">@{[&escape($name)]}</a>); # Walrus add (3) |
|
|
} else { |
|
|
# return $chunk; # Walrus del (3) |
|
|
return &escape($name); # Walrus add (3) |
|
|
} |
|
|
} elsif ($database{$chunk}) { |
|
826 |
my $subject = &escape(&get_subjectline($chunk, delimiter => '')); |
my $subject = &escape(&get_subjectline($chunk, delimiter => '')); |
827 |
# return qq(<a title="$subject" href="$url_cgi?$cookedchunk">$chunk</a>); # Walrus del (3) |
# return qq(<a title="$subject" href="$url_cgi?$cookedchunk">$chunk</a>); # Walrus del (3) |
828 |
return qq(<a title="$subject" href="$url_cgi?$cookedchunk" class="wiki">@{[&escape($name)]}</a>); # Walrus add (3) |
return qq(<a title="$subject" href="$url_cgi?$cookedchunk" class="wiki">@{[&escape($name)]}</a>); # Walrus add (3) |
1000 |
my ($word) = @_; |
my ($word) = @_; |
1001 |
print <<"EOD"; |
print <<"EOD"; |
1002 |
<form action="$url_cgi" method="get"> |
<form action="$url_cgi" method="get"> |
1003 |
<input type="hidden" name="mycmd" value="search"> |
<input type="hidden" name="mycmd" value="read"> |
1004 |
<input type="text" name="mymsg" value="$word" size="20"> |
<input type="text" name="mypage" value="$word" size="20"> |
1005 |
<input type="submit" value="$resource{searchbutton}"> |
<input type="submit" value="$resource{searchbutton}"> |
1006 |
</form> |
</form> |
1007 |
EOD |
EOD |
1086 |
|
|
1087 |
sub is_editable { |
sub is_editable { |
1088 |
my ($page) = @_; |
my ($page) = @_; |
1089 |
if (&is_bracket_name($page)) { |
if ($fixedpage{$page} || $page =~ /\s/ || $page =~ /^\#/) { |
|
return 0; |
|
|
} elsif ($fixedpage{$page}) { |
|
|
return 0; |
|
|
} elsif ($page =~ /\s/) { |
|
|
return 0; |
|
|
} elsif ($page =~ /^\#/) { |
|
|
return 0; |
|
|
} elsif ($page =~ /^$interwiki_name$/) { |
|
1090 |
return 0; |
return 0; |
1091 |
} else { |
} else { |
1092 |
return 1; |
return 1; |
1096 |
# armor_name: |
# armor_name: |
1097 |
# WikiName -> WikiName |
# WikiName -> WikiName |
1098 |
# not_wiki_name -> [[not_wiki_name]] |
# not_wiki_name -> [[not_wiki_name]] |
1099 |
sub armor_name { |
sub armor_name { qq([[$_[0]]]) } |
|
my ($name) = @_; |
|
|
#if ($name =~ /^$wiki_name$/) { |
|
|
# return $name; |
|
|
#} else { |
|
|
return "[[$name]]"; |
|
|
#} |
|
|
} |
|
1100 |
|
|
1101 |
# unarmor_name: |
# unarmor_name: |
1102 |
# [[bracket_name]] -> bracket_name |
# [[bracket_name]] -> bracket_name |
1110 |
} |
} |
1111 |
} |
} |
1112 |
|
|
|
sub is_bracket_name { |
|
|
my ($name) = @_; |
|
|
if ($name =~ /^$bracket_name$/) { |
|
|
return 1; |
|
|
} else { |
|
|
return 0; |
|
|
} |
|
|
} |
|
|
|
|
1113 |
sub decode { |
sub decode { |
1114 |
my ($s) = @_; |
my ($s) = @_; |
1115 |
$s =~ tr/+/ /; |
$s =~ tr/+/ /; |
1172 |
return "$year-$mon-$day ($weekday) $hour:$min"; |
return "$year-$mon-$day ($weekday) $hour:$min"; |
1173 |
} |
} |
1174 |
|
|
|
# [[YukiWiki http://www.hyuki.com/yukiwiki/wiki.cgi?euc($1)]] |
|
1175 |
sub init_InterWikiName { |
sub init_InterWikiName { |
1176 |
my $content = $database{$InterWikiName}; |
my @content = split /\n/, $database{$InterWikiName}; |
1177 |
while ($content =~ /\[\[(\S+) +(\S+)\]\]/g) { |
for (@content) { |
1178 |
my ($name, $url) = ($1, $2); |
if (/^([^#]\S*)\s+(\S[^\x0A\x0D]+)/) { |
1179 |
$interwiki{$name} = $url; |
$interwiki{$1} = $2; |
1180 |
} |
} |
1181 |
|
} |
1182 |
|
require Message::Util::Formatter; |
1183 |
|
$fmt{interwiki} = Message::Util::Formatter->new; |
1184 |
|
$fmt{interwiki}->{encoded} = sub { |
1185 |
|
my ($o, $p) = @_; |
1186 |
|
if ($o->{except}) { |
1187 |
|
$o->{except} =~ tr/\x00-\x20<>\x23%\x22{|}\x5C^[]`\x7F-\xFF//d; |
1188 |
|
} |
1189 |
|
my $s = &code_convert (\$p->{name}, $o->{charset} || 'iso-2022-7bit'); |
1190 |
|
$s =~ s/([^$o->{except}A-Za-z0-9_-])/sprintf '%02X', unpack 'C', $1/ge; |
1191 |
|
$s; |
1192 |
|
}; |
1193 |
|
$fmt{interwiki}->{ykwk} = sub { ## YukiWiki1 |
1194 |
|
my ($o, $p) = @_; |
1195 |
|
my $s = $p->{name}; |
1196 |
|
$s = qq([[$s]]) if $s !~ /^[A-Z][a-z]+(?:[A-Z][a-z]+)+$/; |
1197 |
|
&encode (&code_convert (\$p->{name}, $o->{charset} || 'shift_jis')); |
1198 |
|
}; |
1199 |
} |
} |
1200 |
|
|
|
sub interwiki_convert { |
|
|
my ($type, $localname) = @_; |
|
|
if ($type eq 'sjis' or $type eq 'euc') { |
|
|
&code_convert(\$localname, $type); |
|
|
return &encode($localname); |
|
|
} elsif ($type eq 'ykwk') { |
|
|
# for YukiWiki1 |
|
|
if ($localname =~ /^$wiki_name$/) { |
|
|
return $localname; |
|
|
} else { |
|
|
&code_convert(\$localname, 'sjis'); |
|
|
return &encode("[[" . $localname . "]]"); |
|
|
} |
|
|
} elsif ($type eq 'asis') { |
|
|
return $localname; |
|
|
# Walrus add (4) start |
|
|
} elsif ($type eq 'isbn') { |
|
|
$localname = join('', ($localname =~ /[0-9x]/g)) if ($localname =~ /^(\d-?){9}[\dx]$/); |
|
|
return $localname; |
|
|
# Walrus add (4) end |
|
|
} else { |
|
|
return $localname; |
|
|
} |
|
|
} |
|
1201 |
|
|
1202 |
sub get_info { |
sub get_info { |
1203 |
my ($page, $key) = @_; |
my ($page, $key) = @_; |
1348 |
} else { ## nested #EMBED |
} else { ## nested #EMBED |
1349 |
$r = &text_to_html ("[INS[\n[[$name]] の埋め込みは (入り組んでいるので) 解決されませんでした。\n]INS]\n", content_format => 'SuikaWiki/0.9'); |
$r = &text_to_html ("[INS[\n[[$name]] の埋め込みは (入り組んでいるので) 解決されませんでした。\n]INS]\n", content_format => 'SuikaWiki/0.9'); |
1350 |
} |
} |
1351 |
return qq(<blockquote title="@{[&escape($name)]}">$r<div class="cite-note">『<cite><a href="$url_cgi?@{[&encode($name)]}" class="wiki">@{[&escape($name)]}</a></cite>』</div></blockquote>); |
return qq(<blockquote title="@{[&escape($name)]}" class="wiki-embed">$r<div class="cite-note">『<cite><a href="$url_cgi?@{[&encode($name)]}" class="wiki">@{[&escape($name)]}</a></cite>』</div></blockquote>); |
1352 |
} elsif ($embedded =~ /^\[\[\#randomlink:(.+)\]\]$/) { |
} elsif ($embedded =~ /^\[\[\#randomlink:(.+)\]\]$/) { |
1353 |
return qq(<a href="$url_cgi?mycmd=RandomJump;x-param=@{[time.[0..9]->[rand 10]]}" class="wiki randomlink">$1</a>); |
return qq(<a href="$url_cgi?mycmd=RandomJump;x-param=@{[time.[0..9]->[rand 10]]}" class="wiki randomlink">$1</a>); |
1354 |
} else { |
} else { |
1393 |
|
|
1394 |
sub code_convert { |
sub code_convert { |
1395 |
my ($contentref, $code) = (shift, shift || $kanjicode); |
my ($contentref, $code) = (shift, shift || $kanjicode); |
1396 |
|
$code = 'jis' if $code =~ /iso/; |
1397 |
|
$code = 'euc' if $code =~ /euc/; |
1398 |
|
$code = 'sjis' if $code =~ /shift/; |
1399 |
|
$code = 'utf8' if $code =~ /utf/; |
1400 |
# &Jcode::convert($contentref, $code); # for Jcode.pm |
# &Jcode::convert($contentref, $code); # for Jcode.pm |
1401 |
&jcode::convert($contentref, $code); # for jcode.pl |
&jcode::convert($contentref, $code); # for jcode.pl |
1402 |
return $$contentref; |
return $$contentref; |