--- suikawiki/script/wiki.cgi 2002/09/28 10:54:27 1.26 +++ suikawiki/script/wiki.cgi 2002/10/07 12:50:51 1.27 @@ -70,9 +70,9 @@ # my $modifier_sendmail = '/usr/sbin/sendmail -t -n'; # Your sendmail. my $modifier_sendmail = ''; # If you don't need mail notification. my $modifier_dir_data = './wikidata'; # Your data directory. -my $modifier_rss_title = "WalWiki $walversion"; +my $modifier_rss_title = "SuikaWiki $walversion"; my $modifier_rss_link = 'http://suika.fam.cx/~wakaba/-temp/wiki2/wiki'; # Blank is not allowed. -my $modifier_rss_description = 'This is WalWiki, yet another Wiki clone based on YukiWiki'; +my $modifier_rss_description = 'This is SuikaWiki'; ############################## # # You MAY modify following variables. @@ -205,12 +205,18 @@ } sub do_read { - &print_header($form{mypage}); my $content = $database{$form{mypage}}; + my $lm = &get_info($form{mypage}, $info_LastModified); + &print_header($form{mypage}, -last_modified => $lm); + wiki::referer::add ($form{mypage}, $ENV{HTTP_REFERER}); my $cf = 'SuikaWiki/0.9'; - $cf = $1 if $content =~ s#^(?:/\*\s*|\#\?)?([A-Z][A-Za-z0-9-]+/[0-9.]+(?:\s[^\x0D\x0A]+)?)[\x0D\x0A]+##s; + ## Should be support at least: + ## - '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; if ($cf =~ m#^SuikaWiki/0.9(?:$|\s)#) { - &print_content($content, $cf); + &print_content($content, content_format => $cf, last_modified => $lm); print &text_to_html (q([[#comment]])); } else { print "
@{[&escape($content)]}
"; @@ -220,7 +226,11 @@ print q{

See also

}; print $r; } - &print_footer($form{mypage}); + my $r = wiki::referer::list_html ($form{mypage}); + if ($r) { + print qq(

»²ΎΘΈ΅

\n$r
\n); + } + &print_footer($form{mypage}, $lm); } sub do_output_css { @@ -342,7 +352,7 @@ &update_recent_changes; } &set_info($form{mypage}, $info_IsFrozen, 0 + $form{myfrozen}); - &print_header($CompletedSuccessfully, -goto => $url_cgi.'?'.&encode($form{mypage})); + &print_header($CompletedSuccessfully, -goto => $url_cgi.'?'.&encode($form{mypage}).($form{comment_index}?"#x-comment-$form{comment_index}":'')); &print_message($resource{saved}); &print_content("$resource{continuereading} @{[&armor_name($form{mypage})]}"); &print_footer($CompletedSuccessfully); @@ -384,7 +394,7 @@ || index ($page, $word) > 0 || index ($word, $page) > 0 ) { - $r .= qq(
  • @{[&escape($page)]}@{[&escape(&get_subjectline($page))]}
    • ); + $r .= qq(
  • @{[&escape($page)]} @{[&escape(&get_subjectline($page))]}
    • ); $counter++; } } @@ -425,15 +435,14 @@ exit(0); } -sub print_header { - my ($page,%option) = @_; +sub print_header ($;%) { + my ($page, %option) = @_; my $bodyclass = "normal"; if (&is_frozen($page) and $form{mycmd} =~ /^(read|write)$/) { $bodyclass = "frozen"; } - if ($option{-goto}) { - print qq{Refresh: 0; url="$option{-goto}"\n}; - } + print qq{Refresh: 0; url="$option{-goto}"\n} if $option{-goto}; + print qq{Last-Modified: $option{-last_modified}\n} if $option{-last_modified}; my $cookedpage = &encode($page); my $escapedpage = &escape($page); print <<"EOD"; @@ -456,9 +465,8 @@ EOD &print_navigate_links ($page); print <@{[&escape($page)]}@{[&escape(&get_subjectline($page))]} +

    @{[&escape($page)]} + @{[&escape(&get_subjectline($page))]}

    EOD } @@ -501,12 +509,13 @@ } sub print_footer { - my ($page) = @_; + my ($page, $lm) = @_; $walrus_log = ($walrus_debugging) ? &text_to_html("----\n$walrus_log") : ''; # Walrus add (debug) # Walrus mod (1) start - my $cvslog = '$Revision: 1.26 $ $Date: 2002/09/28 10:54:27 $'; + my $cvslog = '$Revision: 1.27 $ $Date: 2002/10/07 12:50:51 $'; print_navigate_links ($page); print <<"EOD"; +@{[ $lm ? qq(
    Last modified: $lm
    ) : '' ]}

    WalWiki $walversion © 2000-2002 by Makio Tsukamoto.
    @@ -562,7 +571,7 @@ } sub print_content ($;$) { - my ($rawcontent, $format) = @_; + my ($rawcontent, %option) = @_; print &text_to_html($rawcontent, toc=>1); } @@ -659,7 +668,8 @@ } } push(@result, splice(@saved)); - + + my $toc = ''; if ($option{toc}) { # Convert @toc (table of contents) to HTML. # This part is taken from Makio Tsukamoto's WalWiki. @@ -671,10 +681,10 @@ } } push(@tocresult, splice(@tocsaved)); - return join("\n", @tocresult, @result); - } else { - return join("\n", @result); + $toc = join("\n", @tocresult); + $toc = $toc ? qq(

    $toc
    ) : ''; } + return $toc . join("\n", @result); } sub back_push { @@ -863,7 +873,7 @@ my $subject = $database{$page}; $subject =~ s#^SuikaWiki/0.9[^\x0D\x0A]*[\x0D\x0A]+##s; $subject =~ s/\r?\n.*//s; - return "$delim$subject"; + return "$delim$subject".$option{tail}; } } @@ -1226,7 +1236,7 @@ #} else { # $content =~ s/(\Q$embed_rcomment\E)/$1\n- $datestr$namestr$form{mymsg}/; #} - my $i = 0; my $o = 0; + my $i = 1; my $o = 0; $content =~ s{(\Q$embed_comment\E|\Q$embed_rcomment\E)}{ my $embed = $1; if ($i == $form{comment_index}) { @@ -1251,18 +1261,18 @@ } } -my $_O_COMMENT_INDEX = 0; +my $CommentIndex = 0; sub embedded_to_html { my ($embedded) = @_; if ($embedded eq $embed_comment or $embedded eq $embed_rcomment) { my $lastmodified = &get_info($form{mypage}, $info_LastModified); return <<"EOD"; -
    + - + $embed_comment_Name_Prompt @@ -1317,9 +1327,9 @@ # Walrus add (5) end sub code_convert { - my ($contentref, $kanjicode) = @_; -# &Jcode::convert($contentref, $kanjicode); # for Jcode.pm - &jcode::convert($contentref, $kanjicode); # for jcode.pl + my ($contentref, $code) = (shift, shift || $kanjicode); +# &Jcode::convert($contentref, $code); # for Jcode.pm + &jcode::convert($contentref, $code); # for jcode.pl return $$contentref; } @@ -1458,6 +1468,87 @@ } } +sub __get_database ($) { $database{ $_[0] } } + +package wiki::referer; +sub add ($$) { + my $page = shift; + my $uri = shift; + unless (ref $uri) { + require URI; + $uri = URI->new ($uri); + ## Some schemes do not have query part. + eval q{ $uri->query (undef) if $uri->query =~ /^[0-9]{6,8}$/ }; + $uri->fragment (undef); + } + $uri = $uri->canonical; + return unless $uri; + for my $regex (&get_dont_record) { + return if $uri =~ /$regex/; + } + my %list = get ($page); + $list{ $uri }++; + set ($page, \%list); +} +sub get ($) { + my $page = shift; + split /"/, main::get_info ($page, 'Referer'); +} +sub set ($%) { + my $page = shift; + my $list = shift; + main::set_info ($page, Referer => join '"', %$list); +} + +sub get_dont_record () { + map {s/\$/\\\$/g; s/\@/\\\@/g; $_} + grep !/^#/, + split /[\x0D\x0A]+/, &main::__get_database ('RefererDontRecord'); +} +sub get_site_name () { + my @lines = grep /[^#]/, split /[\x0D\x0A]+/, &main::__get_database('RefererSiteName'); + my %item; + for (@lines) { + next if /^#/; + my ($uri, $name) = split /\s+/, $_, 2; + $uri =~ s/\$/\\\$/g; $uri =~ s/\@/\\\@/g; $uri =~ s/\//\\\//g; + $name =~ s![()/\\]!\\$1!g; $name =~ s/\$([0-9]+)/).__decode (\${$1}).q(/g; + $item{$uri} = qq(q($name)); + } + %item; +} + +sub list_html ($) { + my $page = shift; + my %list = get ($page); + my $r = ''; + my %name = get_site_name; + for my $uri (sort keys %list) { + my $title; + for my $regex (keys %name) { + if ($uri =~ /$regex/) { + $title = $uri; + eval qq{\$title =~ s/^.*$regex.*\$/$name{$regex}/e} or die $@; + last; + } + } + my $euri = main::escape ($uri); + if ($title) { + $r .= qq(
  • [$list{$uri}] @{[main::escape ($title)]}
    • \n); + } else { + $r .= qq(
  • [$list{$uri}] <$euri>
    • \n); + } + } + $r ? qq(
      $r
    \n) : ''; +} + +sub __decode ($) { + my $s = shift; + $s =~ tr/+/ /; + $s =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/chr hex $1/ge; + main::code_convert (\$s); +} + 1; __END__ =head1 NAME