--- suikawiki/script/wiki.cgi 2002/11/14 10:22:19 1.31 +++ suikawiki/script/wiki.cgi 2002/12/01 04:32:50 1.32 @@ -26,7 +26,7 @@ use Yuki::YukiWikiDB; use AnyDBM_File; require 'jcode.pl'; -# use Jcode; +require Jcode; use Fcntl; my $version = '2.0.beta1.2002-05-29'; my $walversion; @@ -116,6 +116,7 @@ $AdminChangePassword => 1, $CompletedSuccessfully => 1, #$FrontPage => 1, + WikiUserAgentList => 1, ); my %form; my %database; @@ -158,11 +159,13 @@ my $walversion = '2.0.beta1.wal.1'; # Walrus add (1) ############################## # &test_convert; +my $UA = ''; &main; exit(0); ############################## sub main { + $UA = $main::ENV{HTTP_USER_AGENT}; &init_resource; &open_db; &init_form; @@ -179,6 +182,7 @@ my $content = $database{$form{mypage}}; my $lm = &get_info($form{mypage}, $info_LastModified); wiki::referer::add ($form{mypage}, $ENV{HTTP_REFERER}); + wiki::useragent::add ($ENV{HTTP_USER_AGENT}); my ($r, $c) = get_search_result ($form{mypage}); my $rl = wiki::referer::list_html ($form{mypage}); my @toc; @@ -189,23 +193,23 @@ ## - 'SuikaWiki/0.9' CRLF ## - 'H2H/' ("0.9" / "1.0" / "1.1") CRLF ## - "/*" WSP* 'W3C-CSS/' ("1.0" / "2.0") "*/" CRLF - $cf = $1 if $content =~ s#^(?:/\*\s*|[\#<]\?)?([A-Z][A-Za-z0-9-]+/[0-9.]+(?:[^0-9.][^\x0D\x0A]*)?)[\x0D\x0A]+##s; + $cf = $1 if $content =~ s#^(?:/\*\s*|[\#<]\?)?([A-Z][A-Za-z0-9-]+/[0-9.]+(?:[^0-9.\x0D\x0A][^\x0D\x0A]*)?)[\x0D\x0A]+##s; if ($cf =~ m!^(?:\#\?)?SuikaWiki/0.9(?:$|\s)!) { &print_header ($form{mypage}, -last_modified => $lm, -content_format => $cf, -noindex => $cf =~ /obsoleted="yes"/); &print_content ($content, content_format => $cf, last_modified => $lm, -toc => \@toc); - print &text_to_html (q([[#comment]])) unless $cf =~ /obsoleted="yes"/; + print &text_to_html (q([[#comment]])) if $cf !~ /obsoleted="yes"/ && !$fixedpage{$form{mypage}}; } else { &print_header($form{mypage}, -last_modified => $lm); print "
@{[&escape($content)]}
"; } if ($c) { - print q{

See also

}; + print qq{

See also

}; print $r; } if ($rl) { - print qq(

参照元

\n$rl
\n); + print qq(

参照元

\n$rl
\n); } &print_footer($form{mypage}, $lm); } @@ -226,6 +230,15 @@ } } +sub id_and_name ($) { + my $name = shift; + if ($UA =~ m#Mozilla/2#) { + qq{id="$name"> 1); @@ -237,6 +250,7 @@ &print_editform($database{$page}, &get_info($page, $info_LastModified), admin=>0); } wiki::referer::add ($form{mypage}, $ENV{HTTP_REFERER}); + wiki::useragent::add ($ENV{HTTP_USER_AGENT}); my ($r, $c) = get_search_result ($form{mypage}); my $rl = wiki::referer::list_html ($form{mypage}); if ($c) { @@ -341,7 +355,7 @@ &update_recent_changes; } &set_info($form{mypage}, $info_IsFrozen, 0 + $form{myfrozen}); - &print_header($CompletedSuccessfully, -noindex => 1, -goto => $url_cgi.'?'.&encode($form{mypage}).($form{__comment_anchor_index}?"#anchor-$form{__comment_anchor_index}":'')); + &print_header($CompletedSuccessfully, -noindex => 1, -goto => $url_cgi.'?mycmd=read;mypage='.&encode($form{mypage}).qq(;x-param=@{[time.[0..9]->[rand 10]]}).($form{__comment_anchor_index}?"#anchor-$form{__comment_anchor_index}":'')); &print_message($resource{saved}); &print_content("$resource{continuereading} @{[&armor_name($form{mypage})]}"); &print_footer($CompletedSuccessfully); @@ -373,7 +387,7 @@ } sub get_search_result ($;%) { - my $word = shift; + my $word = lc shift; my %option = @_; my @r; foreach my $page (keys %database) { @@ -382,17 +396,17 @@ my $cf = 'SuikaWiki/0.9'; $cf = $1 if $content =~ s/^\#\?([^\x0A\x0D]+)//s; next if $cf =~ /obsoleted="yes"/; - if (index ($page, $word) > -1) { - my $c = $content =~ s/\Q$word\E/$word/g; + if (index (lc $page, $word) > -1) { + my $c = $content =~ s/\Q$word\E//gi; push @r, [$page, $c+20]; - } elsif (index ($word, $page) > -1) { - my $c = $content =~ s/\Q$word\E/$word/g; + } elsif (index ($word, lc $page) > -1) { + my $c = $content =~ s/\Q$word\E//gi; push @r, [$page, $c+10]; - } elsif (my $c = $content =~ s/\Q$word\E/$word/g) { + } elsif (my $c = $content =~ s/\Q$word\E//gi) { push @r, [$page, $c]; } } - my $em = sub { my $s = shift; $s =~ s#(\Q$word\E)#$1#g; $s }; + my $em = sub { my $s = shift; $s =~ s#(\Q$word\E)#$1#gi; $s }; my $r = join "\n", map {qq(
  • [$_->[1]] @{[&$em(&escape($_->[0]))]} @{[&$em(&escape(&get_subjectline($_->[0])))]}
    • )} sort {$b->[1] <=> $a->[1] || $a->[0] cmp $b->[0]} @r; $r = qq|| if $r; get_message ($resource{notfound}) if @r == 0 && $option{-output_not_found}; @@ -446,12 +460,26 @@ $bodyclass = "frozen"; } $bodyclass .= " wiki-page-obsoleted" if $option{-content_format} =~ /obsoleted="yes"/; - print qq{Refresh: 0; url="$option{-goto}"\n} if $option{-goto}; + if ($option{-goto}) { + if ($UA =~ m#Mozilla/2|Opera#) { + $option{-goto} =~ tr/;/&/; + print qq{Refresh: 0; url=$option{-goto}\n}; + } else { + print qq{Refresh: 0; url="$option{-goto}"\n}; + } + } print qq{Last-Modified: $option{-last_modified}\n} if $option{-last_modified}; + my $meta_ct = ''; + if ($UA =~ m#Mozilla/2#) { + $meta_ct = qq{text/html; charset=@{[&x_charset($charset)]}}; + print qq{Content-Type: $meta_ct\n}; + $meta_ct = qq{}; + } else { + print qq{Content-Type: text/html; charset=$charset\n}; + } my $cookedpage = &encode($page); my $escapedpage = &escape($page); print <<"EOD"; -Content-type: text/html; charset=$charset Content-Language: $lang Content-Style-Type: text/css @@ -461,6 +489,7 @@ "http://www.w3.org/TR/html4/loose.dtd"> + RUBY --> + $meta_ct $escapedpage @@ -476,6 +505,16 @@ EOD } +sub x_charset ($) { + my $charset = lc shift; + if ($charset eq 'euc-jp') { + $charset = 'x-euc-jp'; + } elsif ($charset eq 'shift_jis') { + $charset = 'x-sjis'; + } + $charset; +} + sub print_navigate_links (@) { my ($page) = @_; my $editable = 0; @@ -501,6 +540,7 @@ qq(編集 | ) : qq() ]} + 表示 | @{[ $admineditable ? qq($resource{diffbutton} | ) : qq() @@ -529,8 +569,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.31 $; - my $cvslog2 = q$Date: 2002/11/14 10:22:19 $; + my $cvslog1 = q$Revision: 1.32 $; + my $cvslog2 = q$Date: 2002/12/01 04:32:50 $; print_navigate_links ($page); print <<"EOD"; @{[ $lm ? qq(
    Last modified: $lm
    ) : '' ]} @@ -727,7 +767,7 @@ sub inline { my ($line) = @_; $line = &escape($line); - $line =~ s{\[(INS|DEL|SUP|SUB|VAR|CODE|KBD)(?:\(([A-Za-z0-9\x20-]+)\))?\[(.+?)\]\]}{<@{[lc $1]}@{[$2 ? qq( class="$2") : '']}>$3}g; + $line =~ s{\[(INS|DEL|SUP|SUB|VAR|CODE|KBD|SAMP|DFN)(?:\(([A-Za-z0-9\x20-]+)\))?\[(.+?)\]\]}{<@{[lc $1]}@{[$2 ? qq( class="$2") : '']}>$3}g; $line =~ s:\[(WEAK)\[(.+?)\]\]:$2:g; $line =~ s:\[ABBR\[([^]]+)\] \[([^]]+)\]\]:$1:g; $line =~ s:\[RUBYB\[([^]]+)\] \[([^]]+)\] \[([^]]+)\]\]:$1($2) ($3) :g; @@ -784,7 +824,7 @@ if ($interwiki{$site}) { my $uri = &escape ($fmt{interwiki}->replace ($interwiki{$site} => {site => $site, name => $name})); $site = &escape ($site); $name = &escape ($name); - qq(<$name>); + qq(<$site:$name>); } else { qq(<未登録の InterWikiName: @{[&escape ($site)]}>); } @@ -851,8 +891,10 @@ $form{$var} = param($var); } } - if ($main::ENV{QUERY_STRING} && $main::ENV{QUERY_STRING} !~ /[&;]/) { + $form{mypage} = &code_convert(\$form{mypage}, $kanjicode); + if ($main::ENV{QUERY_STRING} && $main::ENV{QUERY_STRING} !~ /[&;=]/) { my $query = &decode($main::ENV{QUERY_STRING}); + $query = &code_convert(\$query, $kanjicode); if ($page_command{$query}) { $form{mycmd} = $page_command{$query}; $form{mypage} = $query; @@ -862,6 +904,7 @@ } } $form{mypage} ||= 'HomePage'; + $form{mycmd} ||= 'read'; # mypreview_edit -> do_edit, with preview. # mypreview_adminedit -> do_adminedit, with preview. @@ -896,7 +939,7 @@ unshift @updates, $update; } splice(@updates, $maxrecent + 1); - $database{$RecentChanges} = join("\n", @updates); + $database{$RecentChanges} = "#?SuikaWiki/0.9\n" . join("\n", @updates); if ($file_touch) { open(FILE, "> $file_touch"); print FILE localtime() . "\n"; @@ -1184,10 +1227,10 @@ $fmt{interwiki}->{encoded} = sub { my ($o, $p) = @_; if ($o->{except}) { - $o->{except} =~ tr/\x00-\x20<>\x23%\x22{|}\x5C^[]`\x7F-\xFF//d; + $o->{except} =~ tr/\x00-\x20\x22\x23%\x2D<>^[\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 =~ s/([^$o->{except}A-Za-z0-9_-])/sprintf '%%%02X', unpack 'C', $1/ge; $s; }; $fmt{interwiki}->{ykwk} = sub { ## YukiWiki1 @@ -1397,8 +1440,9 @@ $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 + &Jcode::convert($contentref, $code); # for Jcode.pm +# &jcode::convert($contentref, $code); # for jcode.pl + &jcode::tr ($contentref, "\xA3\xB0-\xA3\xB9\xA3\xC1-\xA3\xDA\xA3\xE1-\xA3\xFA\xA1\xF5\xA1\xA4\xA1\xA5\xA1\xA7\xA1\xA8\xA1\xA9\xA1\xAA\xA1\xAE\xA1\xB0\xA1\xB2\xA1\xBF\xA1\xC3\xA1\xCA\xA1\xCB\xA1\xCE\xA1\xCF\xA1\xD0\xA1\xD1\xA1\xDC\xA1\xF0\xA1\xF3\xA1\xF4\xA1\xF6\xA1\xF7\xA1\xE1\xA2\xAF\xA2\xB0\xA2\xB2\xA2\xB1\xA1\xE4\xA1\xE3\xA1\xC0\xA1\xA1" => q(0-9A-Za-z&,.:;?!`^_/|()[]{}+$%#*@='"~-><\ )) if $code eq 'euc'; return $$contentref; } @@ -1538,6 +1582,7 @@ } sub __get_database ($) { $database{ $_[0] } } +sub __set_database ($$) { $database{ $_[0] } = $_[1] } package wiki::referer; sub add ($$) { @@ -1619,6 +1664,28 @@ main::code_convert (\$s); } +package wiki::useragent; + +sub add ($) { + my $s = shift; + return unless length $s; + $s =~ s/([\x00-\x08\x0A-\x1F\x25\x7F-\xFF])/sprintf '%%%02X', unpack 'C', $1/g; + my %ua; + for (split /\n/, &main::__get_database('WikiUserAgentList')) { + if (/^-\[(\d+)\] (.+)$/) { + my ($t, $n) = ($1, $2); + $n =~ tr/\x0A\x0D//d; + $ua{$n} = $t; + } + } + $ua{$s}++; + my $s = qq(#?SuikaWiki/0.9\n); + for (sort {$ua{$a} <=> $ua{$b}} keys %ua) { + $s .= sprintf qq(-[%d] %s\n), $ua{$_}, $_; + } + &main::__set_database ('WikiUserAgentList' => $s); +} + 1; __END__ =head1 NAME