--- suikawiki/script/wiki.cgi 2002/11/13 08:28:15 1.30 +++ suikawiki/script/wiki.cgi 2002/11/14 10:22:19 1.31 @@ -1,5 +1,4 @@ #!/usr/bin/perl -#!perl # # wiki.cgi - This is YukiWiki, yet another Wiki clone. # @@ -10,33 +9,7 @@ # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # -############################## -# # 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]]のように登録。 -# -#======================================= # Walrus add (debug) start my $walrus_log; @@ -113,12 +86,9 @@ my $NAME_OF_WikiPageLicense = 'WikiPageLicense'; my $AdminSpecialPage = 'Admin Special Page'; # must include spaces. ############################## -# 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) my $bracket_name = '\[\[(\S+?)\]\]'; my $embedded_name = '\[\[(#\S+?)\]\]'; -my $interwiki_definition = '\[\[(\S+?)\ (\S+?)\]\]'; -my $interwiki_name = 'i:([^:]+):([^:].*)'; +my %fmt; ## formatter objects ############################## my $embed_comment = '[[#comment]]'; my $embed_rcomment = '[[#rcomment]]'; @@ -559,8 +529,8 @@ my ($page, $lm) = @_; $walrus_log = ($walrus_debugging) ? &text_to_html("----\n$walrus_log") : ''; # Walrus add (debug) # Walrus mod (1) start - my $cvslog1 = q$Revision: 1.30 $; - my $cvslog2 = q$Date: 2002/11/13 08:28:15 $; + my $cvslog1 = q$Revision: 1.31 $; + my $cvslog2 = q$Date: 2002/11/14 10:22:19 $; print_navigate_links ($page); print <<"EOD"; @{[ $lm ? qq(
Last modified: $lm
) : '' ]} @@ -766,23 +736,23 @@ $line =~ s%\[Q\[([^]]+)\](?: \[<([\x21-\x5A\x5E-\x7E]+)>\])?\]%「$1」%g; $line =~ s|'''([^']+)'''|$1|g; $line =~ s|''([^']+)''|$1|g; - $line =~ s! - ( - (?:<(?:mailto|http|https|ftp|urn|news):[\x21-\x7E]*)> - | - (?:$bracket_name)) # [[likethis]], [[#comment]], [[Friend:remotelink]] + $line =~ s{ + ((?:$bracket_name)) # [[likethis]], [[#comment]], [[Friend:remotelink]] |\[\[([^[]+?)]>>([0-9]+)] # [[WikiName]>>1] |>>([0-9]+) - ! - my ($l, $page,$anchor, $anum) = ($1, $3,$4, 0+$5); + |<([A-Za-z0-9%]+:(?:(?!>).)+)> + }{ + my ($l, $page,$anchor, $anum, $uri) = ($1, $3,$4, 0+$5, $6); if ($l) { &make_link($l) } elsif (defined $page) { &make_wikilink ($page, anchor => 0+$anchor); } elsif ($anum) { qq(>>$anum); + } elsif ($uri) { + &make_urilink ($uri); } - !gex; + }gex; return $line; } @@ -801,57 +771,58 @@ } } +sub make_urilink ($;%) { + require URI; + my $uri = shift; + if ($uri =~ s/^IW://) { ## InterWiki (not URI) + $uri = &unescape ($uri); + if ($uri =~ /^([^\x00-\x2F\x3A-\x40\x5B-\x60\x7B-\x7F]+|"(?:\\.|[^"\\])+"):([^\x00-\x2F\x3A-\x40\x5B-\x60\x7B-\x7F]+|"(?:\\.|[^"\\])+")$/) { + my ($site, $name) = ($1, $2); + for ($site, $name) { + if (s/^"//) { s/"$//; s/\\(.)/$1/g } + } + if ($interwiki{$site}) { + my $uri = &escape ($fmt{interwiki}->replace ($interwiki{$site} => {site => $site, name => $name})); + $site = &escape ($site); $name = &escape ($name); + qq(<$name>); + } else { + qq(<未登録の InterWikiName: @{[&escape ($site)]}>); + } + } else { + qq(<不正な InterWikiName: @{[&escape($uri)]}>); + } + } elsif ($uri =~ /^urn:/) { ## URN + my $uri2 = &escape (URI->new ('/uri-res/N2L?'.&unescape ($uri), 'http')->canonical); + qq(<$uri>); + } elsif ($uri =~ s/^MAIL://) { ## mail address (not URI) + my $uri2 = &escape (URI->new ('mailto:'.&unescape ($uri))->canonical); + qq(<$uri>); + } elsif ($uri =~ s/^IMG(?:\([^)]+\))?://) { ## image (not URI itself) + my $uri2 = &escape (URI->new (&unescape ($uri))->canonical); + qq(); + } else { ## misc. URI + CGI::Carp::warningsToBrowser (0); + my $uri2 = &escape (URI->new (&unescape ($uri))->canonical); + CGI::Carp::warningsToBrowser (1); + qq(<$uri>); + } +} + +## to be obsoleted sub make_link { my $chunk = shift; # Walrus add (3) start $chunk =~ s/^<(.*)>$/$1/; 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() ; - } $name = &unarmor_name($name); # Walrus add (3) end - if ($chunk =~ /^(http|https|ftp|news):/) { - # Walrus mod (3) start -# if ($use_autoimg and $chunk =~ /\.(gif|png|jpeg|jpg)$/) { -# return qq(); -# } else { -# return qq($chunk); -# } - return qq(<$name>); - # Walrus mod (3) end - } elsif ($chunk =~ m#^urn:[0-9A-Za-z_:;/.-]+#) { - return qq|<$name>|; - } elsif ($chunk =~ /^mailto:(.*)/) { -# return qq($2); # Walrus del (3) - return qq(<$name>); # Walrus add (3) - } elsif ($chunk =~ /^$interwiki_definition$/) { -# return qq($chunk); # Walrus del (3) - return qq($name); # Walrus add (3) - } elsif ($chunk =~ /^$embedded_name$/) { + if ($chunk =~ /^$embedded_name$/) { return &embedded_to_html($chunk); } else { $chunk = &unarmor_name($chunk); $chunk = &unescape($chunk); # To treat '&' or '>' or '<' correctly. my $cookedchunk = &encode($chunk); - if ($chunk =~ /^$interwiki_name$/) { - 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($chunk); # Walrus del (3) - return qq(@{[&escape($name)]}); # Walrus add (3) - } else { -# return $chunk; # Walrus del (3) - return &escape($name); # Walrus add (3) - } - } elsif ($database{$chunk}) { + if ($database{$chunk}) { my $subject = &escape(&get_subjectline($chunk, delimiter => '')); # return qq($chunk); # Walrus del (3) return qq(@{[&escape($name)]}); # Walrus add (3) @@ -1029,8 +1000,8 @@ my ($word) = @_; print <<"EOD";
- - + +
EOD @@ -1115,15 +1086,7 @@ sub is_editable { my ($page) = @_; - if (&is_bracket_name($page)) { - return 0; - } elsif ($fixedpage{$page}) { - return 0; - } elsif ($page =~ /\s/) { - return 0; - } elsif ($page =~ /^\#/) { - return 0; - } elsif ($page =~ /^$interwiki_name$/) { + if ($fixedpage{$page} || $page =~ /\s/ || $page =~ /^\#/) { return 0; } else { return 1; @@ -1133,14 +1096,7 @@ # armor_name: # WikiName -> WikiName # not_wiki_name -> [[not_wiki_name]] -sub armor_name { - my ($name) = @_; - #if ($name =~ /^$wiki_name$/) { - # return $name; - #} else { - return "[[$name]]"; - #} -} +sub armor_name { qq([[$_[0]]]) } # unarmor_name: # [[bracket_name]] -> bracket_name @@ -1154,15 +1110,6 @@ } } -sub is_bracket_name { - my ($name) = @_; - if ($name =~ /^$bracket_name$/) { - return 1; - } else { - return 0; - } -} - sub decode { my ($s) = @_; $s =~ tr/+/ /; @@ -1225,39 +1172,32 @@ return "$year-$mon-$day ($weekday) $hour:$min"; } -# [[YukiWiki http://www.hyuki.com/yukiwiki/wiki.cgi?euc($1)]] sub init_InterWikiName { - my $content = $database{$InterWikiName}; - while ($content =~ /\[\[(\S+) +(\S+)\]\]/g) { - my ($name, $url) = ($1, $2); - $interwiki{$name} = $url; + my @content = split /\n/, $database{$InterWikiName}; + for (@content) { + if (/^([^#]\S*)\s+(\S[^\x0A\x0D]+)/) { + $interwiki{$1} = $2; } + } + require Message::Util::Formatter; + $fmt{interwiki} = Message::Util::Formatter->new; + $fmt{interwiki}->{encoded} = sub { + my ($o, $p) = @_; + if ($o->{except}) { + $o->{except} =~ tr/\x00-\x20<>\x23%\x22{|}\x5C^[]`\x7F-\xFF//d; + } + my $s = &code_convert (\$p->{name}, $o->{charset} || 'iso-2022-7bit'); + $s =~ s/([^$o->{except}A-Za-z0-9_-])/sprintf '%02X', unpack 'C', $1/ge; + $s; + }; + $fmt{interwiki}->{ykwk} = sub { ## YukiWiki1 + my ($o, $p) = @_; + my $s = $p->{name}; + $s = qq([[$s]]) if $s !~ /^[A-Z][a-z]+(?:[A-Z][a-z]+)+$/; + &encode (&code_convert (\$p->{name}, $o->{charset} || 'shift_jis')); + }; } -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; - } -} sub get_info { my ($page, $key) = @_; @@ -1408,7 +1348,7 @@ } else { ## nested #EMBED $r = &text_to_html ("[INS[\n[[$name]] の埋め込みは (入り組んでいるので) 解決されませんでした。\n]INS]\n", content_format => 'SuikaWiki/0.9'); } - return qq(
$r
『@{[&escape($name)]}』
); + return qq(
$r
『@{[&escape($name)]}』
); } elsif ($embedded =~ /^\[\[\#randomlink:(.+)\]\]$/) { return qq($1); } else { @@ -1453,6 +1393,10 @@ sub code_convert { my ($contentref, $code) = (shift, shift || $kanjicode); + $code = 'jis' if $code =~ /iso/; + $code = 'euc' if $code =~ /euc/; + $code = 'sjis' if $code =~ /shift/; + $code = 'utf8' if $code =~ /utf/; # &Jcode::convert($contentref, $code); # for Jcode.pm &jcode::convert($contentref, $code); # for jcode.pl return $$contentref;