/[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.16 by wakaba, Sat Oct 25 02:22:06 2003 UTC revision 1.17 by wakaba, Sat Oct 25 06:38:18 2003 UTC
# Line 20  sub _do_view_msg (%) { Line 20  sub _do_view_msg (%) {
20    require SuikaWiki::View;    require SuikaWiki::View;
21    my %option = @_;    my %option = @_;
22    my $o = $option{-o} || bless {param => \%main::form, page => $option{-page},    my $o = $option{-o} || bless {param => \%main::form, page => $option{-page},
23                                  &_compatible_options ()}, 'SuikaWiki::Plugin';                                  }, 'SuikaWiki::Plugin';
24    $o->{toc} = [];    $o->{toc} = [];
25    $o->{condition} = \%option;   ## This parameter really used??    $o->{condition} = \%option;   ## This parameter really used??
26    my $view_def = SuikaWiki::View->definition ($option{-view});    my $view_def = SuikaWiki::View->definition ($option{-view});
# Line 43  sub _do_view_msg (%) { Line 43  sub _do_view_msg (%) {
43    print $s;    print $s;
44  }  }
45    
 =pod  
   
 # [move to SuikaWiki::Plugin::WikiAdmin]  
 sub do_adminchangepassword {  
     if ($main::form{mynewpassword} ne $main::form{mynewpassword2}) {  
         &_do_view_msg (-view => '-error', -page => $main::form{mypage},  
                        error_message => &Resource ('Error:PasswordMismatch'));  
         return;  
     }  
     my ($validpassword_crypt) = $main::database->meta (AdminPassword => $PageName{AdminSpecialPage});  
     if ($validpassword_crypt) {  
         if (not &valid_password($main::form{myoldpassword})) {  
             &_do_view_msg (-view => '-error', -page => $main::form{mypage},  
                            error_message => &Resource ('Error:PasswordIsIncorrect'));  
             return;  
         }  
     }  
     my ($sec, $min, $hour, $day, $mon, $year, $weekday) = localtime(time);  
     my (@token) = ('0'..'9', 'A'..'Z', 'a'..'z');  
     my $salt1 = $token[(time | $$) % scalar(@token)];  
     my $salt2 = $token[($sec + $min*60 + $hour*60*60) % scalar(@token)];  
     my $crypted = crypt($main::form{mynewpassword}, "$salt1$salt2");  
     $main::database->meta (AdminPassword => $main::PageName{AdminSpecialPage} => $crypted);  
       
     &_do_view_msg (-view => '-wrote', -page => $main::form{mypage});  
 }  
   
 =cut  
   
 # [move to SuikaWiki::WikiDB]  
 sub valid_password ($) {  
   return 0;  
 #    my ($validpassword_crypt) = $main::database->meta (AdminPassword => $PageName{AdminSpecialPage});  
 #    return crypt (shift, $validpassword_crypt) eq $validpassword_crypt ? 1 : 0;  
 }  
   
 ## [obsolete] BugTrack  
 sub _http_see_other (%) {  
   my %o = @_;  
   $o{page} = join '//', @{$o{page}} if ref $o{page};  
   $o{uri} ||= SuikaWiki::Plugin->_uri_wiki_page ($o{page}, absolute => 1);  
   if ($o{alternate_view} && ($main::ENV{SERVER_PROTOCOL} eq 'HTTP/1.0')  
    && !($main::UA =~ m#M(?:ozilla|icrosoft Internet Explorer)#)) {  
     &_do_view_msg (-view => $o{alternate_view}, -page => $o{page}, -goto => $o{uri}, -o => $o{o});  
   } else {  
     require SuikaWiki::Output::HTTP;  
     my $output = SuikaWiki::Output::HTTP->new (wiki => $WIKI);  
     $output->set_redirect (uri => $o{uri}, status_code => 303);  
     $output->output (output => 'http-cgi');  
   }  
   exit;  
 }  
   
46  # temp  # temp
47    sub valid_password ($) { 0 }
48  sub is_editable { 1 }  sub is_editable { 1 }
49    
 sub _compatible_options () {  
   (use_anchor_name => ($main::UA =~ m#Mozilla/[1-4]\.|Microsoft Internet Explorer# ? 1 : 0));  
 }  
   
   
   
 sub print_header ($;%) {  
     my ($page, %option) = @_;  
     if ($main::ENV{HTTP_IF_MODIFIED_SINCE} && $option{-last_modified}) {  
       ## TODO: use Message::Field::Date  
       if ($option{-view}->properties->{if}->{modified_since}  
        && $main::ENV{HTTP_IF_MODIFIED_SINCE} =~ /([0-9]{1,2})\s*([A-Za-z]{3})\s*([0-9]{2,4})\s*([0-9]{2}):([0-9]{2}):([0-9]{2})\s*[Gg][Mm][Tt]/) {  
           require Time::Local;  
           my ($d, $M, $y, $h, $m, $s) = ($1, $2, $3, $4, $5, $6);  
           $M = {jan=>0,feb=>1,mar=>2,apr=>3,may=>4,jun=>5,jul=>6,aug=>7,sep=>8,oct=>9,nov=>10,dec=>11}->{lc $M};  
           #$y += 1900 if $y < 100;      ## BUG: don't conform HTTP spec  
           my $t = Time::Local::timegm_nocheck ($s, $m, $h, $d, $M, $y);  
           if ($option{-last_modified} <= $t) {  
             print "Status: 304 Not Modified\n\n";  
             exit;  
           }  
       }  
     }  
     #my $UA = SuikaWiki::Plugin->user_agent_names;  
     $option{o}->{-header}->{class}->{frozen} = 1 if &main::is_frozen ($page);  
     $option{o}->{-header}->{class}->{'wiki-page-obsoleted'} = 1 if $option{-magic} =~ /obsoleted="yes"/;  
     $option{o}->{-header}->{additional_html_element} ||= SuikaWiki::Markup::XML->new (type => '#fragment');  
     #print "Vary: Negotiate,User-Agent,Accept-Language,Accept\n";  
     if ($option{-goto}) {  
       if ($main::UA =~ m#Opera|MSIE 2\.#) {  
         ## WARNING: This code may output unsafe HTML document if $option{-goto} is unclean.  
         $option{-goto} =~ tr/;/&/ if $main::UA =~ m#Opera#;  
         print qq{Refresh: 0; url=$option{-goto}\n};  
         for ($option{o}->{-header}->{additional_html_element}->append_new_node  
                 (namespace_uri => $NS_XHTML1, local_name => 'meta')) {  
           $_->set_attribute ('http-equiv' => 'refresh');  
           $_->set_attribute (content => "0; url=$option{-goto}");  
           $_->option (use_EmptyElemTag => 1);  
         }  
       } else {  
         $option{-goto} =~ tr/;/&/ if $main::UA =~ m#Mozilla/[1-4]\.#;  
         print qq{Refresh: 0; url="$option{-goto}"\n};  
         for ($option{o}->{-header}->{additional_html_element}->append_new_node  
                 (namespace_uri => $NS_XHTML1, local_name => 'meta')) {  
           $_->set_attribute ('http-equiv' => 'refresh');  
           $_->set_attribute (content => qq(0; url="$option{-goto}"));  
           $_->option (use_EmptyElemTag => 1);  
         }  
       }  
     }  
     print qq{Last-Modified: @{[scalar gmtime $option{-last_modified}]}\n}  
       if $option{-last_modified};  
     if ($option{-expires} != -1) {  
       if (defined $option{-expires}) {  ## TODO: Don't use asctime  
         print qq{Expires: @{[scalar gmtime (time + $option{-expires})]}\n};  
       } elsif ($option{-media}->{expires} != -1) {  
         print qq{Expires: @{[scalar gmtime (time + $option{-media}->{expires})]}\n};  
       }  
     }  
     if ($option{-media}->{charset} && $main::UA =~ m#Mozilla/[12]\.#) {  
     ## UAs don't support official charset names but do non-official names  
       my $ct = qq{$option{-media}->{type}; charset=@{[ &main::get_charset_name ($main::kanjicode, compatible => 1) ]}};  
       print qq{Content-Type: $ct\n};  
       for ($option{o}->{-header}->{additional_html_element}->append_new_node  
                 (namespace_uri => $NS_XHTML1, local_name => 'meta')) {  
         $_->set_attribute ('http-equiv' => 'content-type');  
         $_->set_attribute (content => $ct);  
       }  
     } elsif (!$option{-media}->{charset} || $main::UA =~ m#Infomosaic|Mozilla/0\.#) {  
     ## Media types or UAs don't support charset parameter in HTTP header  
       print qq{Content-Type: $option{-media}->{type}\n};  
       if ($option{-media}->{charset}) {  
         for ($option{o}->{-header}->{additional_html_element}->append_new_node  
                   (namespace_uri => $NS_XHTML1, local_name => 'meta')) {  
           $_->set_attribute ('http-equiv' => 'content-type');  
           $_->set_attribute (content => qq($option{-media}->{type}; charset=).main::get_charset_name ($main::kanjicode, compatible => 1));  
         }  
       }  
     } else {  
     ## Modern UAs and Media types with charset parameter  
       my $type = $option{-media}->{type};  
       $type = 'application/xml' if ($type =~ m!^application/rdf\+xml$!) && ($main::UA =~ m#Gecko#);  
       print qq{Content-Type: $type; charset=@{[&main::get_charset_name ($main::kanjicode)]}\n};  
       ## meta element is not needed  
     }  
   
 }  
   
 sub get_charset_name ($;%) {  
     my ($charset, %option) = (lc shift, @_);  
     if ($charset =~ 'euc') {  
         $charset = $option{compatible} ? 'x-euc-jp' : 'euc-jp';  
     } elsif ($charset =~ 'sjis' || $charset =~ 'shift') {  
         $charset = $option{compatible} ? 'x-sjis' : 'shift_jis';  
     } elsif ($charset =~ 'jis') {  
         $charset = 'iso-2022-jp';  
     }  
     $charset;  
 }  
   
50  # [move to SuikaWiki::WikiDB]  # [move to SuikaWiki::WikiDB]
51  sub frozen_reject {  sub frozen_reject {
52      my ($isfrozen) = $main::database->meta (IsFrozen => $main::form{mypage});      my ($isfrozen) = $main::database->meta (IsFrozen => $main::form{mypage});
# Line 414  sub EXISTS ($$) { Line 262  sub EXISTS ($$) {
262  package main;  package main;
263    push @{$WIKI->{event}->{setting_initial_variables}}, sub {    push @{$WIKI->{event}->{setting_initial_variables}}, sub {
264      my $wiki = shift;      my $wiki = shift;
265      $wiki->{implementation_version} = 'pl'.$VERSION;      $wiki->{implementation_version} = 'sw'.$VERSION;
266            
267      ## Error output      ## Error output
268      require SuikaWiki::Output::CGICarp;      require SuikaWiki::Output::CGICarp;
Legend:
Removed from v.1.16  
changed lines
  Added in v.1.17
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24