/[pub]/suikawiki/script/wiki.cgi
Suika

Diff of /suikawiki/script/wiki.cgi

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

revision 1.41 by wakaba, Wed Dec 25 02:04:11 2002 UTC revision 1.42 by wakaba, Mon Dec 30 03:20:06 2002 UTC
# Line 16  use Fcntl; Line 16  use Fcntl;
16  # my $modifier_dbtype = 'dbmopen';      # Fast, not available on some server, page size limited.  # my $modifier_dbtype = 'dbmopen';      # Fast, not available on some server, page size limited.
17  my $modifier_dbtype = 'YukiWikiDB';     # Slow, available on all environment.  my $modifier_dbtype = 'YukiWikiDB';     # Slow, available on all environment.
18  my $modifier_dir_data = './wikidata'; # Your data directory.  my $modifier_dir_data = './wikidata'; # Your data directory.
19  our $url_cgi = '/~wakaba/-temp/wiki/wiki';      ## MUST be started by '/'  our $url_cgi = '/~wakaba/-temp/wiki/wiki';
20  ##############################          ## - MUST be started by '/'
21  #          ## - MUST NOT include [&<>"] and/or non-URI characters
 # You MAY modify following variables.  
 #  
 $SuikaWiki::Plugin::plugin_directory = q(./SuikaWiki/Plugin/);  
 my $file_touch = "$modifier_dir_data/touched.txt";  
22  our %uri;  our %uri;
23  $uri{stylesheet} = $url_cgi.'?mycmd=TEXT_CSS;mypage=WikiHTMLStyle';  $uri{wiki} = $url_cgi;
24  $uri{cvs_wikipage} = '/gate/cvs/wakaba/suikawiki/wiki/';  $uri{cvs_wikipage} = '/gate/cvs/wakaba/suikawiki/wiki/';
25    $SuikaWiki::Plugin::plugin_directory = q(./SuikaWiki/Plugin/);
26    my $file_touch = "$modifier_dir_data/touched.txt";
27  ##############################  ##############################
28  #  #
29  # You MAY, but do NOT NEED modify following variables.  # You MAY, but do NOT NEED modify following variables.
# Line 42  my $CreatePage = 'CreatePage'; Line 40  my $CreatePage = 'CreatePage';
40  my $ErrorPage = 'ErrorPage';  my $ErrorPage = 'ErrorPage';
41  my $RssPage = 'RssPage';  my $RssPage = 'RssPage';
42  my $AdminSpecialPage = 'Admin Special Page'; # must include spaces.  my $AdminSpecialPage = 'Admin Special Page'; # must include spaces.
43    my %PageName = (
44      DefaultStyleForHTML   => 'WikiHTMLStyle',
45    );
46  ##############################  ##############################
47  my %fmt;        ## formatter objects  my %fmt;        ## formatter objects
48  my %embed_command = (  my %embed_command = (
# Line 56  my $kanjicode = 'euc'; Line 57  my $kanjicode = 'euc';
57  my $lang = 'ja';  my $lang = 'ja';
58  my %fixedpage = (  my %fixedpage = (
59      $IndexPage => 1,      $IndexPage => 1,
     $CreatePage => 1,  
60      $ErrorPage => 1,      $ErrorPage => 1,
61      $RssPage => 1,      $RssPage => 1,
62      RecentChanges => 1,      RecentChanges => 1,
     $SearchPage => 1,  
63      AdminChangePassword => 1,      AdminChangePassword => 1,
64      CompletedSuccessfully => 1,      CompletedSuccessfully => 1,
65      WikiUserAgentList => 1,      WikiUserAgentList => 1,
     WikiPluginInfo    => 1,  
66  );  );
67  my %form;  my %form;
68  my %database;  my %database;
# Line 74  my %interwiki; Line 72  my %interwiki;
72  ##############################  ##############################
73  my %page_command = (  my %page_command = (
74      $IndexPage => 'index',      $IndexPage => 'index',
     $SearchPage => 'searchform',  
     $CreatePage => 'create',  
75      $RssPage => 'rss',      $RssPage => 'rss',
76      AdminChangePassword => 'adminchangepasswordform',      AdminChangePassword => 'adminchangepasswordform',
     WikiPluginInfo       => 'x_WikiPluginInfo',  
77  );  );
78  my %command_do = (  my %command_do = (
79      read => \&do_read,      read => \&do_read,
# Line 90  my %command_do = ( Line 85  my %command_do = (
85      write => \&do_write,      write => \&do_write,
86      index => \&do_index,      index => \&do_index,
87      searchform => \&do_searchform,      searchform => \&do_searchform,
     search => \&do_search,  
     create => \&do_create,  
     createresult => \&do_createresult,  
88      comment => \&do_comment,      comment => \&do_comment,
89      RandomJump  => \&do_random_jump,      RandomJump  => \&do_random_jump,
90      rss => \&do_rss,      rss => \&do_rss,
91      diff => \&do_diff,      diff => \&do_diff,
92      wikiform    => \&do_wikiform,      wikiform    => \&do_wikiform,
     x_WikiPluginInfo    => \&do_wikiplugininfo,  
93      map => \&do_map,      map => \&do_map,
94  );  );
95  my $UA = '';  ## User agent name  my $UA = '';  ## User agent name
# Line 112  sub main { Line 103  sub main {
103      if ($command_do{$form{mycmd}}) {      if ($command_do{$form{mycmd}}) {
104          &{$command_do{$form{mycmd}}};          &{$command_do{$form{mycmd}}};
105      } else {      } else {
106          &{$command_do{$form{read}}};          &{$command_do{read}};
107      }      }
108      &close_db;      &close_db;
109  }  }
# Line 137  sub do_read { Line 128  sub do_read {
128      $cf = $1 if $content =~ s#^(?:/\*\s*|[\#<]\?)?([A-Z][A-Za-z0-9-]+/[0-9.]+(?:[^0-9.\x0D\x0A][^\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;
129      if ($cf =~ m!^(?:\#\?)?SuikaWiki/0.9(?:$|\s)!) {      if ($cf =~ m!^(?:\#\?)?SuikaWiki/0.9(?:$|\s)!) {
130      #print gmtime."Header...\n";      #print gmtime."Header...\n";
131        &print_header ($form{mypage}, -last_modified => $lm,        &print_header ($form{mypage}, -last_modified => $lm, -expires => time + 120,
132          -content_format => $cf, -noindex => $cf =~ /obsoleted="yes"/);          -content_format => $cf, -noindex => ($cf =~ /obsoleted="yes"/ ? 1 : 0));
133          #print "\n". gmtime."Body...\n";          #print "\n". gmtime."Body...\n";
134        &print_content ($content, content_format => $cf, last_modified => $lm,        &print_content ($content, content_format => $cf, last_modified => $lm,
135          -toc => \@toc);          -toc => \@toc);
136        print &text_to_html (q([[#comment]])) if $cf !~ /obsoleted="yes"/ && !$fixedpage{$form{mypage}};        print &text_to_html (q([[#comment]])) if $cf !~ /obsoleted="yes"/ && !$fixedpage{$form{mypage}};
137      } else {      } else {
138        &print_header($form{mypage}, -last_modified => $lm);        &print_header($form{mypage}, -expires => time + 120, -last_modified => $lm);
139        print "<pre>@{[&escape($content)]}</pre>";        print "<pre>@{[&escape($content)]}</pre>";
140      }      }
141      if ($c) {      if ($c) {
# Line 167  sub do_output_css { Line 158  sub do_output_css {
158      my $lm = gmtime &get_info($form{mypage}, $info_LastModified);      my $lm = gmtime &get_info($form{mypage}, $info_LastModified);
159      print "Content-Type: text/css; charset=@{[&get_charset_name($kanjicode)]}\n";      print "Content-Type: text/css; charset=@{[&get_charset_name($kanjicode)]}\n";
160      print "Last-Modified: $lm\n";      print "Last-Modified: $lm\n";
161        print "Expires: @{[scalar gmtime time+3600]}\n";    ## TODO: don't use asctime
162      print "\n";      print "\n";
163      print $content;      print $content;
164    } else {    } else {
# Line 188  sub id_and_name ($) { Line 180  sub id_and_name ($) {
180    
181  sub do_edit {  sub do_edit {
182      my ($page) = &unarmor_name(&armor_name($form{mypage}));      my ($page) = &unarmor_name(&armor_name($form{mypage}));
     &print_header($page, -noindex => 1);  
183      if (not &is_editable($page)) {      if (not &is_editable($page)) {
184            &print_header($page, -noindex => 1);
185          &print_message(&Resource('Error:ThisPageIsUneditable'));          &print_message(&Resource('Error:ThisPageIsUneditable'));
186      } elsif (&is_frozen($page)) {      } elsif (&is_frozen($page)) {
187            &print_header($page, -noindex => 1);
188          &print_message(&Resource('Error:ThisPageIsUneditable'));          &print_message(&Resource('Error:ThisPageIsUneditable'));
189      } else {      } else {
190            &print_header($page, -noindex => 1, -expires => time+60);
191          &print_editform($database{$page}, &get_info($page, $info_LastModified), admin=>0);          &print_editform($database{$page}, &get_info($page, $info_LastModified), admin=>0);
192      }      }
193      wiki::referer::add ($form{mypage}, $ENV{HTTP_REFERER});      wiki::referer::add ($form{mypage}, $ENV{HTTP_REFERER});
# Line 335  sub do_write { Line 329  sub do_write {
329      }      }
330  }  }
331    
 sub do_searchform {  
     &print_header($SearchPage);  
     &print_searchform("");  
     &print_footer($SearchPage);  
 }  
   
 sub do_search {  
     my $word = $form{mymsg};  
     &print_header($SearchPage);  
     &print_searchform(&escape($word));  
     print scalar get_search_result ($word, -output_not_found => 1, -match_myself => 1);  
     &print_footer($SearchPage);  
 }  
   
332  sub get_search_result ($;%) {  sub get_search_result ($;%) {
333    my $word = lc shift;    my $word = lc shift;
334    my %option = @_;    my %option = @_;
# Line 372  sub get_search_result ($;%) { Line 352  sub get_search_result ($;%) {
352    wantarray? ($r, scalar @r): $r;    wantarray? ($r, scalar @r): $r;
353  }  }
354    
 sub do_create {  
     &print_header($CreatePage);  
     print <<"EOD";  
 <form action="$url_cgi" method="post">  
     <input type="hidden" name="mycmd" value="edit">  
     <strong>@{[&Resource('InputPageNameEdited',escape=>1)]}</strong><br>  
     <input type="text" name="mypage" value="" size="20">  
     <input type="submit" value="@{[&Resource('WikiForm:Create',escape=>1)]}"><br>  
 </form>  
 EOD  
     &print_footer($CreatePage);  
 }  
   
355  sub do_random_jump {  sub do_random_jump {
356    my @list = keys %database;    my @list = keys %database;
357    my $name = &encode ($list[rand @list]);    my $name = &encode ($list[rand @list]);
# Line 421  sub print_header ($;%) { Line 388  sub print_header ($;%) {
388        }        }
389      }      }
390      print qq{Last-Modified: @{[scalar gmtime $option{-last_modified}]}\n} if $option{-last_modified};      print qq{Last-Modified: @{[scalar gmtime $option{-last_modified}]}\n} if $option{-last_modified};
391        if ($option{-expires}) {
392          print qq{Expires: @{[scalar gmtime $option{-expires}]}\n};
393        }
394      if ($UA =~ m#Mozilla/2#) {      if ($UA =~ m#Mozilla/2#) {
395          my $ct = qq{text/html; charset=@{[&get_charset_name($kanjicode,compatible=>1)]}};          my $ct = qq{text/html; charset=@{[&get_charset_name($kanjicode,compatible=>1)]}};
396          print qq{Content-Type: $ct\n};          print qq{Content-Type: $ct\n};
# Line 431  sub print_header ($;%) { Line 401  sub print_header ($;%) {
401          print qq{Content-Type: text/html; charset=@{[&get_charset_name($kanjicode)]}\n};          print qq{Content-Type: text/html; charset=@{[&get_charset_name($kanjicode)]}\n};
402      }      }
403      push @head, qq(<title>@{[&escape($page)]}</title>);      push @head, qq(<title>@{[&escape($page)]}</title>);
404      push @head, qq(<link rel="stylesheet" type="text/css" href="@{[&escape($uri{stylesheet})]}")      if ($UA !~ m#Mozilla/[1-4]\.# || $UA =~ m#MSIE (?:[4-9]\.|\d\d)#) {
405        if $UA !~ m#Mozilla/[1-4]\.# || $UA =~ m#MSIE (?:[4-9]\.|\d\d)#;        push @head, qq(<link rel="stylesheet" type="text/css" href="@{[&escape($uri{wiki}.'?mycmd=TEXT_CSS;mypage='.&encode($PageName{DefaultStyleForHTML}).';x-lm='.&get_info($PageName{DefaultStyleForHTML}, $info_LastModified))]}");
406        }
407      push @head, q(<meta name="ROBOTS" content="NOINDEX">) if $option{-noindex};      push @head, q(<meta name="ROBOTS" content="NOINDEX">) if $option{-noindex};
408      my ($Links, $links) = &make_navigate_links ($page);      my ($Links, $links) = &make_navigate_links ($page);
409      #print $Links;      ## Link: fields      #print $Links;      ## Link: fields
# Line 759  sub make_wikilink ($%) { Line 730  sub make_wikilink ($%) {
730        return qq(<a title="$subject" href="$url_cgi?@{[&encode($name)]}" class="wiki">$ename</a>);        return qq(<a title="$subject" href="$url_cgi?@{[&encode($name)]}" class="wiki">$ename</a>);
731      }      }
732    } else {    } else {
733      return qq(<a title="@{[&Resource('JumpAndEditWikiPage',escape=>1)]}" href="$url_cgi?mycmd=edit;mypage=@{[&escape($name)]}" class="wiki not-exist">$ename<span class="mark">@{[&Resource('JumpAndEditWikiPageMark',escape=>1)]}</span></a>);      return qq(<a title="@{[&Resource('JumpAndEditWikiPage',escape=>1)]}" href="$url_cgi?@{[&escape($name)]}" class="wiki not-exist">$ename<span class="mark">@{[&Resource('JumpAndEditWikiPageMark',escape=>1)]}</span></a>);
734    }    }
735  }  }
736    
# Line 817  sub make_custom_form ($$$$) { Line 788  sub make_custom_form ($$$$) {
788              $option = &unescape ($option);              $option = &unescape ($option);
789              $option =~ s/\\(.)/$1/g;              $option =~ s/\\(.)/$1/g;
790              $fmt{form_option}->replace ($option, $param);              $fmt{form_option}->replace ($option, $param);
791              $definition .= ' %submit;' if $definition !~ /%submit/ && !$param->{output}->{nosubmit};              $param->{output}->{form} = 1 unless defined $param->{output}->{form};
792                $definition .= ' %submit;' if $definition !~ /%submit/ && !$param->{output}->{nosubmit} && $param->{output}->{form};
793              my $target_page = $param->{output}->{page} || $form{mypage};              my $target_page = $param->{output}->{page} || $form{mypage};
794              $param->{form_disabled} = 1 if $fixedpage{$target_page};              $param->{form_disabled} = 1 if $fixedpage{$target_page};
795              my $target_form = $param->{output}->{id};              my $target_form = $param->{output}->{id};
796              my $r = <<EOH;              my $r = '';
797                $r = <<EOH if $param->{output}->{form};
798  <form method="post" action="$url_cgi" id="wikiform-$FormIndex" class="wikiform">  <form method="post" action="$url_cgi" id="wikiform-$FormIndex" class="wikiform">
799    <input type="hidden" name="mycmd" value="@{[$param->{form_disabled}?'read':'wikiform']}">    <input type="hidden" name="mycmd" value="@{[$param->{form_disabled}?'read':'wikiform']}">
800    <input type="hidden" name="mypage" value="@{[&escape($target_page)]}">    <input type="hidden" name="mypage" value="@{[&escape($target_page)]}">
# Line 831  sub make_custom_form ($$$$) { Line 804  sub make_custom_form ($$$$) {
804  EOH  EOH
805              $r .= qq(<a name="wikiform-$FormIndex"></a>) if $UA =~ m#Mozilla/[12]\.#;              $r .= qq(<a name="wikiform-$FormIndex"></a>) if $UA =~ m#Mozilla/[12]\.#;
806              $r .= $fmt{form_input}->replace ($definition, $param);              $r .= $fmt{form_input}->replace ($definition, $param);
807              $r .= <<EOH;              $r .= "</form>\n" if $param->{output}->{form};
 </form>  
 EOH  
808              $r;              $r;
809         } else {  ## No input-interface WikiForm         } else {  ## No input-interface WikiForm
810             qq(<a id="wikiform-$FormIndex" name="wikiform-$FormIndex"><!-- #form --></a>);             qq(<a id="wikiform-$FormIndex" name="wikiform-$FormIndex"><!-- #form --></a>);
# Line 855  sub init_form { Line 826  sub init_form {
826        read STDIN, $query, $main::ENV{CONTENT_LENGTH};        read STDIN, $query, $main::ENV{CONTENT_LENGTH};
827      }      }
828      $query .= ($query ? ';' : '') . $main::ENV{QUERY_STRING};      $query .= ($query ? ';' : '') . $main::ENV{QUERY_STRING};
829      if ($main::ENV{QUERY_STRING} && $main::ENV{QUERY_STRING} !~ /[&;=]/) {      if ($main::ENV{REQUEST_METHOD} ne 'POST' && $main::ENV{QUERY_STRING} && $main::ENV{QUERY_STRING} !~ /[&;=]/) {
830        my $query = &decode($main::ENV{QUERY_STRING});        my $query = &decode($main::ENV{QUERY_STRING});
831        $query = &code_convert(\$query, $kanjicode);        $query = &code_convert(\$query, $kanjicode);
832        if ($page_command{$query}) {        if ($page_command{$query}) {
# Line 993  sub close_diff { Line 964  sub close_diff {
964      }      }
965  }  }
966    
 sub print_searchform {  
     my ($word) = @_;  
     print <<"EOD";  
 <form action="$url_cgi" method="get">  
     <input type="hidden" name="mycmd" value="read">  
     <input type="text" name="mypage" value="$word" size="20">  
     <input type="submit" value="@{[&Resource('WikiForm:Search',escape=>1)]}">  
 </form>  
 EOD  
 }  
   
967  sub print_editform {  sub print_editform {
968      my ($mymsg, $lastmodified, %mode) = @_;      my ($mymsg, $lastmodified, %mode) = @_;
969      my $frozen = &is_frozen($form{mypage});      my $frozen = &is_frozen($form{mypage});
# Line 1499  sub is_exist_page { Line 1459  sub is_exist_page {
1459  sub __get_database ($) { $database{ $_[0] } }  sub __get_database ($) { $database{ $_[0] } }
1460  sub __set_database ($$) { $database{ $_[0] } = $_[1] }  sub __set_database ($$) { $database{ $_[0] } = $_[1] }
1461    
 sub do_wikiplugininfo {  
     &print_header (q(WikiPluginInfo));  
     print text_to_html (&SuikaWiki::Plugin::make_info_page);  
     &print_footer (q(WikiPluginInfo));  
 }  
   
1462  sub do_map {  sub do_map {
1463      my $page = $form{mypage};      my $page = $form{mypage};
1464      &print_header ($page);      &print_header ($page);
# Line 1665  sub unescape ($$) { main::unescape ($_[1 Line 1619  sub unescape ($$) { main::unescape ($_[1
1619  sub encode ($$) { main::encode ($_[1]) }  sub encode ($$) { main::encode ($_[1]) }
1620  sub decode ($$) { main::decode ($_[1]) }  sub decode ($$) { main::decode ($_[1]) }
1621  sub __get_datetime ($) { main::get_now () }  sub __get_datetime ($) { main::get_now () }
1622    sub resource ($$;%) { shift; &main::Resource (@_) }
1623    sub uri ($$) { $main::uri{$_[1]} }
1624    
1625  sub regist ($@) {  sub regist ($@) {
1626      my $pack = shift;      my $pack = shift;
# Line 1683  sub import_plugins () { Line 1639  sub import_plugins () {
1639      }      }
1640  }  }
1641    
 sub make_info_page () {  
     my $r = <<EOH;  
 EOH  
     unless ($List{_all}) {  
         $r .= qq('''No plugin is installed!'''\n);  
     } else {  
         my $index = 0;  
         for my $package (sort @{$List{_all}}) {  
             $index++;  
             my $prop = $package->property ();  
             $r .= <<EOH;  
 *$package  
   
 [$index] '''$prop->{name}''' (Version $prop->{version})  
 <$prop->{uri}>  
   
 Provide:  
 @{[do{my $t = ''; for my $f (@{$prop->{provide}||[]}) {  
     $t .= qq(-''$f''\n);  
     for (sort grep m#^\Q$f\E/#, keys %{$prop->{partinfo}}) {  
          $t .= qq(--''$_'' -- $prop->{partinfo}->{$_}\n);  
     }  
 }$t}]}  
   
 EOH  
         }  
     }  
     $r;  
 }  
   
1642  &import_plugins ();  &import_plugins ();
1643    
1644  package wiki::conneg;  package wiki::conneg;
Legend:
Removed from v.1.41  
changed lines
  Added in v.1.42
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24