/[pub]/suikawiki/script/lib/suikawiki.pl
Suika

Diff of /suikawiki/script/lib/suikawiki.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.5 by wakaba, Wed May 7 08:57:34 2003 UTC revision 1.6 by wakaba, Sat May 10 05:58:49 2003 UTC
# Line 16  our %embed_command = ( Line 16  our %embed_command = (
16  our ($modifier_dbtype,$url_cgi,%uri,%PathTo);  our ($modifier_dbtype,$url_cgi,%uri,%PathTo);
17  our (%PageName,$kanjicode,$lang);  our (%PageName,$kanjicode,$lang);
18    
19  my %form;  our %form;
20  our %database;  our %database;
21  our $database = bless {}, 'wiki::dummy';  our $database = bless {}, 'wiki::dummy';
22  our %interwiki;  our %interwiki;
# Line 38  sub main { Line 38  sub main {
38      $UA = $main::ENV{HTTP_USER_AGENT};      $UA = $main::ENV{HTTP_USER_AGENT};
39      &open_db;      &open_db;
40      &init_form;      &init_form;
41        for (@{$SuikaWiki::Plugin::On{WikiDatabaseLoaded}||[]}) {
42          &{$_};
43        }
44      if ($command_do{$form{mycmd}}) {      if ($command_do{$form{mycmd}}) {
45          &{$command_do{$form{mycmd}}};          &{$command_do{$form{mycmd}}};
46      } else {      } else {
# Line 49  sub main { Line 52  sub main {
52  sub do_view {  sub do_view {
53    my $content = $database{$form{mypage}};    my $content = $database{$form{mypage}};
54    my $lm = $database->mtime ($form{mypage});    my $lm = $database->mtime ($form{mypage});
   wiki::referer::add ($form{mypage}, $ENV{HTTP_REFERER});  
   wiki::useragent::add ($ENV{HTTP_USER_AGENT});  
55    &load_formatter ('view');    &load_formatter ('view');
56      my $view = $form{mycmd};      my $view = $form{mycmd};
57      if ($view eq 'edit') {      if ($view eq 'edit') {
# Line 714  sub _rfc3339_date ($) { Line 715  sub _rfc3339_date ($) {
715    sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00', $time[5]+1900,$time[4]+1,@time[3,2,1,0];    sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00', $time[5]+1900,$time[4]+1,@time[3,2,1,0];
716  }  }
717    
 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 ($) { split /"/, $main::database->meta (Referer => $_[0]) }  
 sub set ($%) {  
   my $page = shift;  
   my $list = shift;  
   $main::database->meta (Referer => $page => join '"', %$list);  
 }  
   
 sub get_dont_record () {  
   map {s/\$/\\\$/g; s/\@/\\\@/g; $_}  
   grep !/^#/,  
   split /[\x0D\x0A]+/, $main::database{RefererDontRecord};  
 }  
 sub get_site_name () {  
   my @lines = grep /[^#]/, split /[\x0D\x0A]+/, $main::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;  
     push @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 {$list{$b}<=>$list{$a}||$a cmp $b} keys %list) {  
     my $title;  
     for my $item (@name) {  
       if ($uri =~ /$item->[0]/) {  
         $title = $uri;  
         eval qq{\$title =~ s/^.*$item->[0].*\$/$item->[1]/e}  
           or die $@ ;#. qq{\$title =~ s/^.*$item->[0].*\$/$item->[1]/e};  
         last;  
       }  
     }  
     my $euri = main::escape ($uri);  
     if ($title) {  
       $r .= qq(<li>{$list{$uri}} <a href="$euri" title="URI: &lt;$euri&gt;">@{[main::escape ($title)]}</a></li>\n);  
     } else {  
       $r .= qq(<li>{$list{$uri}} &lt;<a href="$euri">$euri</a>&gt;</li>\n);  
     }  
   }  
   $r ? qq(<ul>$r</ul>\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);  
 }  
   
 package wiki::useragent;  
 our $UseLog;  
   
 sub add ($) {  
   my $s = shift;  
   return unless length $s;  
   return unless $UseLog;  
   $s =~ s/([^\x20-\x24\x26-\x7E])/sprintf '%%%02X', unpack 'C', $1/ge;  
   my %ua;  
   for (split /\n/, $main::database{$main::PageName{UserAgentList}}) {  
     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::database->STORE ($main::PageName{UserAgentList} => $s, -touch => 0);  
 }  
   
718    
719  package wiki::dummy;  package wiki::dummy;
720  sub mtime (@) {undef}  sub mtime (@) {undef}
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24