/[suikacvs]/test/html-webhacc/cc.cgi
Suika

Diff of /test/html-webhacc/cc.cgi

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

revision 1.58 by wakaba, Mon Jul 21 09:40:59 2008 UTC revision 1.59 by wakaba, Mon Jul 21 12:56:33 2008 UTC
# Line 20  use CGI::Carp qw[fatalsToBrowser]; Line 20  use CGI::Carp qw[fatalsToBrowser];
20      $out->http_error (404);      $out->http_error (404);
21      exit;      exit;
22    }    }
     
   load_text_catalog ('en'); ## TODO: conneg  
23    
24      ## TODO: We need real conneg support...
25      my $primary_language = 'en';
26      if ($ENV{HTTP_ACCEPT_LANGUAGE} =~ /ja/) {
27        $primary_language = 'ja';
28      }
29      $out->load_text_catalog ($primary_language);
30      
31    $out->set_flush;    $out->set_flush;
32    $out->http_header;    $out->http_header;
33    $out->html_header;    $out->html_header;
# Line 118  sub check_and_print ($$$) { Line 123  sub check_and_print ($$$) {
123    $out->input ($original_input);    $out->input ($original_input);
124  } # check_and_print  } # check_and_print
125    
   
 {  
   my $Msg = {};  
   
 sub load_text_catalog ($) {  
 #  my $self = shift;  
   my $lang = shift; # MUST be a canonical lang name  
   open my $file, '<:utf8', "cc-msg.$lang.txt"  
       or die "$0: cc-msg.$lang.txt: $!";  
   while (<$file>) {  
     if (s/^([^;]+);([^;]*);//) {  
       my ($type, $cls, $msg) = ($1, $2, $_);  
       $msg =~ tr/\x0D\x0A//d;  
       $Msg->{$type} = [$cls, $msg];  
     }  
   }  
 } # load_text_catalog  
   
 sub get_text ($;$$) {  
 #  my $self = shift;  
   my ($type, $level, $node) = @_;  
   $type = $level . ':' . $type if defined $level;  
   $level = 'm' unless defined $level;  
   my @arg;  
   {  
     if (defined $Msg->{$type}) {  
       my $msg = $Msg->{$type}->[1];  
       $msg =~ s{<var>\$([0-9]+)</var>}{  
         defined $arg[$1] ? ($arg[$1]) : '(undef)';  
       }ge;                 ##BUG: ^ must be escaped  
       $msg =~ s{<var>{\@([A-Za-z0-9:_.-]+)}</var>}{  
         UNIVERSAL::can ($node, 'get_attribute_ns')  
             ?  ($node->get_attribute_ns (undef, $1)) : ''  
       }ge; ## BUG: ^ must be escaped  
       $msg =~ s{<var>{\@}</var>}{        ## BUG: v must be escaped  
         UNIVERSAL::can ($node, 'value') ? ($node->value) : ''  
       }ge;  
       $msg =~ s{<var>{local-name}</var>}{  
         UNIVERSAL::can ($node, 'manakai_local_name')  
           ? ($node->manakai_local_name) : ''  
       }ge;  ## BUG: ^ must be escaped  
       $msg =~ s{<var>{element-local-name}</var>}{  
         (UNIVERSAL::can ($node, 'owner_element') and  
          $node->owner_element)  
           ?  ($node->owner_element->manakai_local_name)  
           : '' ## BUG: ^ must be escaped  
       }ge;  
       return ($type, 'level-' . $level . ' ' . $Msg->{$type}->[0], $msg);  
     } elsif ($type =~ s/:([^:]*)$//) {  
       unshift @arg, $1;  
       redo;  
     }  
   }  
   return ($type, 'level-'.$level, ($_[0]));  
                                  ## BUG: ^ must be escaped  
 } # get_text  
   
 }  
   
126  sub get_input_document ($) {  sub get_input_document ($) {
127    my $http = shift;    my $http = shift;
128    
Legend:
Removed from v.1.58  
changed lines
  Added in v.1.59
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24