/[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.4 by wakaba, Tue Apr 29 10:41:07 2003 UTC revision 1.5 by wakaba, Wed May 7 08:57:34 2003 UTC
# Line 19  our (%PageName,$kanjicode,$lang); Line 19  our (%PageName,$kanjicode,$lang);
19  my %form;  my %form;
20  our %database;  our %database;
21  our $database = bless {}, 'wiki::dummy';  our $database = bless {}, 'wiki::dummy';
22  my %interwiki;  our %interwiki;
23  my %command_do = (  my %command_do = (
24      default => \&do_view,      default => \&do_view,
25      adminchangepassword => \&do_adminchangepassword,      adminchangepassword => \&do_adminchangepassword,
# Line 31  my %command_do = ( Line 31  my %command_do = (
31  );  );
32  our $UA = '';  ## User agent name  our $UA = '';  ## User agent name
33  $| = 1;  $| = 1;
34    my $HAS_XML = SuikaWiki::Plugin->feature ('SuikaWiki::Markup::XML');
35    my $NS_XHTML1 = 'http://www.w3.org/1999/xhtml';
36    
37  sub main {  sub main {
38      $UA = $main::ENV{HTTP_USER_AGENT};      $UA = $main::ENV{HTTP_USER_AGENT};
# Line 268  sub print_header ($;%) { Line 270  sub print_header ($;%) {
270          $type = 'application/xml' if ($type =~ m!^application/(?:rdf|rss)\+xml$!) && ($UA =~ m#Gecko#);          $type = 'application/xml' if ($type =~ m!^application/(?:rdf|rss)\+xml$!) && ($UA =~ m#Gecko#);
271          print qq{Content-Type: $type; charset=@{[&get_charset_name($kanjicode)]}\n};          print qq{Content-Type: $type; charset=@{[&get_charset_name($kanjicode)]}\n};
272      }      }
273        #if ($main::ENV{HTTP_IF_MODIFIED_SINCE}) {
274          ## TODO: IMS support
275        #}
276        
277      ## TODO: more Vary: support      ## TODO: more Vary: support
278      print <<"EOD";      print <<"EOD";
279  Vary: User-Agent,Accept-Language  Vary: Negotiate,User-Agent,Accept-Language
280  Content-Style-Type: text/css  Content-Style-Type: text/css
281    
282  EOD  EOD
# Line 324  sub convert_format ($$$;%) { Line 330  sub convert_format ($$$;%) {
330    }    }
331  }  }
332    
 sub make_wikilink ($%) {  
   my ($name, %option) = @_;  
   my $ename = &escape (length $option{label} ? $option{label} : $name);  
   $option{latest} = $option{latest} ? qq(mycmd=default;x-param=@{[time.[0..9]->[rand 10]]};mypage=) : '';  
     
   ## Namespace  
   #if ($SuikaWiki::Name::Space::VERSION) {  
     $name = SuikaWiki::Name::Space::normalize_name (    ## Foo// + .//Bar -> Foo////Bar  
               SuikaWiki::Name::Space::resolve_relative_name (  
                 SuikaWiki::Name::Space::normalize_name ($option{base}, -might_be_ns_path => 1)  
                   =>  
                 SuikaWiki::Name::Space::normalize_name ($name)));  
   #}  
   $name ||= $PageName{FrontPage};  
     
   if ($database{$name}) {  
     my $subject = &escape ($name.&get_subjectline ($name));  
     if ($option{anchor}) {  
       return qq(<a title="$subject" href="$uri{wiki}?$option{latest}@{[&encode($name)]}#anchor-$option{anchor}" class="wiki">$ename&gt;&gt;$option{anchor}</a>);  
     } else {  
       return qq(<a title="$subject" href="$uri{wiki}?$option{latest}@{[&encode($name)]}" class="wiki">$ename</a>);  
     }  
   } else {  
     return qq(<a title="@{[&escape($name).&Resource('Title-Summary Delimiter',escape=>1).&Resource('JumpAndEditWikiPage',escape=>1)]}" href="$uri{wiki}?$option{latest}@{[&encode($name)]}" class="wiki not-exist">$ename<span class="mark">@{[&Resource('JumpAndEditWikiPageMark',escape=>1)]}</span></a>);  
   }  
 }  
   
 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 }  
       }  
       &init_InterWikiName () unless $interwiki{'[[]]'};  
       if ($interwiki{$site}) {  
         &load_formatter ('interwiki');  
         my $uri = &escape ($fmt{interwiki}->replace ($interwiki{$site} => {site => $site, name => $name}));  
         $site = &escape ($site); $name = &escape ($name);  
         qq(&lt;<a href="$uri" class="out-of-wiki interwiki" title="$name ($site); URI: &lt;$uri&gt;"><span class="interwiki-site">$site:</span><span class="interwiki-name">$name</span></a>&gt;);  
       } else {  
         qq(&lt;@{[&Resource('Error:UnknownInterWikiName=',escape=>1)]}@{[&escape ($site)]}&gt;);  
       }  
     } else {  
       qq(&lt;@{[&Resource('Error:InvalidInterWiki=',escape=>1)]}@{[&escape($uri)]}&gt;);  
     }  
   } elsif ($uri =~ /^urn:/) {   ## URN  
     my $uri2 = &escape (URI->new ('/uri-res/N2L?'.&unescape ($uri), 'http')->canonical);  
     qq(&lt;<a href="$uri2" title="URI: &lt;$uri&gt; (via &lt;$uri2&gt;)" class="out-of-wiki urn">$uri</a>&gt;);  
   } elsif ($uri =~ s/^MAIL://) {        ## mail address (not URI)  
     my $uri2 = &escape (URI->new ('mailto:'.&unescape ($uri))->canonical);  
     qq(&lt;<a href="$uri2" class="out-of-wiki mail">$uri</a>&gt;);  
   } elsif ($uri =~ s/^IMG(?:\([^)]+\))?://) {   ## image (not URI itself)  
     my $uri2 = &escape (URI->new (&unescape ($uri))->canonical);  
     qq(<img src="$uri2" alt="" title="URI: &lt;$uri2&gt;" class="out-of-wiki">);  
   } else {      ## misc. URI  
     CGI::Carp::warningsToBrowser (0);  
     my $uri2 = &escape (URI->new (&unescape ($uri))->canonical);  
     CGI::Carp::warningsToBrowser (1);  
     qq(&lt;<a href="$uri2" title="URI: &lt;$uri2&gt;" class="out-of-wiki">$uri</a>&gt;);  
   }  
 }  
   
333  {my %FormIndex;  {my %FormIndex;
334  sub make_custom_form ($$$$%) {  sub make_custom_form ($$$$%) {
335      my ($wfname, $definition, $template, $foption, $option) = @_;      my ($wfname, $definition, $template, $foption, $option) = @_;
# Line 436  sub init_form { Line 376  sub init_form {
376      ## TODO: Support multipart/form-data      ## TODO: Support multipart/form-data
377      my $query = '';      my $query = '';
378      if (uc $main::ENV{REQUEST_METHOD} eq 'POST') {      if (uc $main::ENV{REQUEST_METHOD} eq 'POST') {
379        read STDIN, $query, $main::ENV{CONTENT_LENGTH};        if (lc ($main::ENV{CONTENT_TYPE}) eq 'application/x-www-form-urlencoded'
380           || lc ($main::ENV{CONTENT_TYPE}) eq 'application/sgml-form-urlencoded') {
381            read STDIN, $query, $main::ENV{CONTENT_LENGTH};
382          } else {
383            $form{mycmd} = '___unsupported_media_type___';
384            $form{mypage} = $PageName{FrontPage};
385            return;
386          }
387      }      }
388      $query .= ($query ? ';' : '') . $main::ENV{QUERY_STRING};      $query .= ($query ? ';' : '') . $main::ENV{QUERY_STRING};
389      if ($main::ENV{REQUEST_METHOD} ne 'POST' && $main::ENV{QUERY_STRING} && $main::ENV{QUERY_STRING} !~ /[&;=]/) {      if ($main::ENV{REQUEST_METHOD} ne 'POST' && $main::ENV{QUERY_STRING} && $main::ENV{QUERY_STRING} !~ /[&;=]/) {
# Line 615  sub get_now { Line 562  sub get_now {
562      return "$year-$mon-$day $hour:$min";      return "$year-$mon-$day $hour:$min";
563  }  }
564    
 sub init_InterWikiName {  
   my @content = split /\n/, $database{InterWikiName};  
   for (@content) {  
     if (/^([^#]\S*)\s+(\S[^\x0A\x0D]+)/) {  
       $interwiki{$1} = $2;  
     }  
   }  
   $interwiki{'[[]]'} = 1;       ## dummy  
 }  
   
565  sub frozen_reject {  sub frozen_reject {
566      my ($isfrozen) = $database->meta (IsFrozen => $form{mypage});      my ($isfrozen) = $database->meta (IsFrozen => $form{mypage});
567      my ($willbefrozen) = $form{myfrozen};      my ($willbefrozen) = $form{myfrozen};
# Line 692  sub get_new_anchor_index ($) { Line 629  sub get_new_anchor_index ($) {
629  }  }
630    
631  sub load_formatter (@) {  sub load_formatter (@) {
   my $x = SuikaWiki::Plugin->feature ('SuikaWiki::Markup::XML');  
632      for my $t (@_) {      for my $t (@_) {
633          unless ($fmt{$t}) {          unless ($fmt{$t}) {
634              require Message::Util::Formatter;              require Message::Util::Formatter;
# Line 700  sub load_formatter (@) { Line 636  sub load_formatter (@) {
636              for (@{$SuikaWiki::Plugin::List{'wiki'.$t}||[]}) {              for (@{$SuikaWiki::Plugin::List{'wiki'.$t}||[]}) {
637                  $_->load_formatter ($fmt{$t}, type => 'wiki'.$t);                  $_->load_formatter ($fmt{$t}, type => 'wiki'.$t);
638              }              }
639              $fmt{$t}->option (return_class => 'SuikaWiki::Markup::XML') if $x;              $fmt{$t}->option (return_class => 'SuikaWiki::Markup::XML') if $HAS_XML;
640          }          }
641      }      }
642  }  }
# Line 778  sub _rfc3339_date ($) { Line 714  sub _rfc3339_date ($) {
714    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];
715  }  }
716    
 my %_Resource;  
 sub Resource ($;%) {  
   my ($s, %o) = @_;  
   unless (defined $_Resource{$s}) {  
     $_Resource{$_[0]} = &wiki::resource::get ($s, $_Resource{__option});  
   }  
   $o{escape} ? &escape ($_Resource{$s}) : $_Resource{$s};  
 }  
   
717  package wiki::referer;  package wiki::referer;
718  sub add ($$) {  sub add ($$) {
719    my $page = shift;    my $page = shift;
# Line 871  sub add ($) { Line 798  sub add ($) {
798    my $s = shift;    my $s = shift;
799    return unless length $s;    return unless length $s;
800    return unless $UseLog;    return unless $UseLog;
801    $s =~ s/([\x00-\x08\x0A-\x1F\x25\x7F-\xFF])/sprintf '%%%02X', unpack 'C', $1/ge;    $s =~ s/([^\x20-\x24\x26-\x7E])/sprintf '%%%02X', unpack 'C', $1/ge;
802    my %ua;    my %ua;
803    for (split /\n/, $main::database{$main::PageName{UserAgentList}}) {    for (split /\n/, $main::database{$main::PageName{UserAgentList}}) {
804      if (/^-\[(\d+)\] (.+)$/) {      if (/^-\[(\d+)\] (.+)$/) {
# Line 888  sub add ($) { Line 815  sub add ($) {
815    $main::database->STORE ($main::PageName{UserAgentList} => $s, -touch => 0);    $main::database->STORE ($main::PageName{UserAgentList} => $s, -touch => 0);
816  }  }
817    
 package wiki::suikawikiconst;  
   
 sub to_hash ($;$) {  
   my $page = shift;  
   my $h = shift || {};  
   my $val;  
   for my $line (split /\n/, $page) {  
     next if $line =~ /^#/;  
     $line =~ tr/\x0A\x0D//d;  
     if ($val && $line =~ s/^\s+\\?//) {  
       $h->{$val} .= length $h->{$val} ? "\n" . $line : $line;  
     } elsif ($line =~ /^(.+):/) {  
       $val = $1; $h->{$val} = '';  
     }  
   }  
   $h;  
 }  
818    
819  package wiki::dummy;  package wiki::dummy;
820  sub mtime (@) {undef}  sub mtime (@) {undef}
821  sub meta (@) {undef}  sub meta (@) {undef}
822  sub Yuki::YukiWikiDB2::meta (@) {undef}  sub Yuki::YukiWikiDB2::meta (@) {undef}
823    
 package SuikaWiki::Plugin;  
 sub escape ($$) { main::escape ($_[1]) }  
 sub unescape ($$) { main::unescape ($_[1]) }  
 sub encode ($$) { main::encode ($_[1]) }  
 sub decode ($$) { main::decode ($_[1]) }  
 sub __get_datetime ($) { main::get_now () }  
 sub resource ($$;%) { shift; &main::Resource (@_) }  
 sub uri ($$) { $main::uri{$_[1]} }  
 sub user_agent_names ($) { $main::UA }  
 sub _path_to ($$) { $main::PathTo{$_[1]} }  
   
 sub formatter ($$) {  
   &main::load_formatter ($_[1]);  
   $main::fmt{$_[1]};  
 }  
 sub format_converter ($$$) {  
   &main::load_formatter ('format');  
   $main::fmt{format}->{($_[1]=~/([A-Za-z0-9]\S+)/?$1:'SuikaWiki/0.9').'_to_'.$_[2]}  
   || $main::fmt{format}->{($_[1]=~/([A-Za-z0-9](?:(?!\/)\S)+)/?$1:'SuikaWiki').'_to_'.$_[2]};  
 }  
 sub formatter_replace_if_not_parsed_yet ($$$$;$) {  
   my ($o, $context, $p, $attr_name, $option) = @_;  
   &main::load_formatter ($context);  
   if ((ref $p->{$attr_name} && $p->{$attr_name}->flag ('parsed'))  
    || (!ref $p->{$attr_name} && index ($p->{-option}->{$attr_name}, 'p') > -1)) {  
     $p->{$attr_name};   ## Already parsed  
   } else {  
     $main::fmt{$context}->replace ($p->{$attr_name}, $o, {formatter => $main::fmt{$context}});  
   }  
 }  
   
 sub cache ($$) {  
   our %Cache;  
   my (undef, $name, %option) = @_;  
   unless (ref $Cache{$name}) {  
     my %cache;  
     tie (%cache, 'Yuki::YukiWikiCache', -file => $main::PathTo{CachePrefix}.$name, %option);  
     $Cache{$name} = \%cache;  
   }  
   $Cache{$name};  
 }  
 sub _database ($) { $main::database }  
 sub _database_exist ($$) { exists $main::database{$_[1]} }  
 sub _html_wikilink ($$%) { shift; &main::make_wikilink (@_) }  
 sub _uri_wiki_page ($$%) {  
   my (undef, $page, %option) = @_;  
   $option{mode} ||= 'read';  
   length $page ? undef : ($page = $main::PageName{FrontPage});  
   $option{href} = $main::uri{wiki}.'?';  
   if ($option{up_to_date} || $option{mode} ne 'read' || $option{add_param}) {  
     $option{href} .= qq(mypage=@{[&main::encode($page)]};mycmd=@{[&main::encode($option{mode})]});  
     $option{href} .= ';'.$option{add_param} if $option{add_param};  
     $option{href} .= ';x-d='.time if $option{up_to_date};  
     $option{href} .= ';x-lm='.($main::database->mtime ($page)||0) if $option{with_lm};  
   } else {  
     $option{href} .= &main::encode ($page);  
   }  
   $option{href};  
 }  
   
   
 package wiki::conneg;  
   
 ## BUG: this parser isn't strict.  
 sub get_accept_lang (;$) {  
   my $alang = shift || $main::ENV{HTTP_ACCEPT_LANGUAGE};  
   my %alang = (ja => 0.0002, en => 0.0001);  
   if ($main::UA =~ m#Mozilla/0\.#) {  
     $alang{ja} = 0.00001;  
   }  
   my $i = 0.1;  
   for (split /\s*,\s*/, $alang) {  
     tr/\x09\x0A\x0D\x20//d;  
     if (/((?:(?!;q=).)+)(?:;q="?([0-9.]+)"?)?/) {  
       my $l = lc $1; $l =~ tr/\x22\x5C//d;  
       $alang{$l} = (defined $2 ? $2 : 1.000)*1000;  
       $alang{$l} += $i unless $alang{$l} == 0;  
       $i -= 0.001;  
     }  
   }  
   \%alang;  
 }  
   
 package wiki::resource;  
   
 sub get ($;\%) {  
   my ($resname, $option) = @_;  
   $option->{accept_language} ||= &wiki::conneg::get_accept_lang ();  
   $option->{resource} ||= {};  
   my $v;  
   for my $lang (sort {$option->{accept_language}->{$b} <=> $option->{accept_language}->{$a}} grep {$option->{accept_language}->{$_}!=0} keys %{$option->{accept_language}}) {  
     while (length $lang) {  
       unless ($option->{accept_language}->{defined $option->{accept_language}->{$lang} ? $lang : '*'} == 0) {  
         $option->{resource}->{$lang} ||= &wiki::suikawikiconst::to_hash ($main::database{$main::PageName{ResourceNS}.$lang});  
         $v = $option->{resource}->{$lang}->{$resname};  
         last if defined $v;  
       }  
       $lang =~ s/[^+-]*$//; $lang =~ s/[+-]$//;  
     }  
     last if defined $v;  
   }  
   defined $v ? $v : $resname;  
 }  
   
824  package main;  package main;
825  &SuikaWiki::Plugin::import_plugins ();  &SuikaWiki::Plugin::import_plugins ();
826  &main ();  &main ();
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24