/[suikacvs]/test/html-whatpm/parser.cgi
Suika

Diff of /test/html-whatpm/parser.cgi

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

revision 1.1 by wakaba, Tue May 1 09:25:31 2007 UTC revision 1.2 by wakaba, Tue May 1 10:27:06 2007 UTC
# Line 1  Line 1 
1  #!/usr/bin/perl  #!/usr/bin/perl
2  use strict;  use strict;
3    
4  use lib qw[.. /home/wakaba/public_html/-temp/wiki/lib];  use lib qw[/home/httpd/html/www/markup/html/whatpm
5               /home/wakaba/public_html/-temp/wiki/lib];
6    
7  use SuikaWiki::Input::HTTP; ## TODO: Use some better CGI module  use SuikaWiki::Input::HTTP; ## TODO: Use some better CGI module
8    
# Line 12  my $http = SuikaWiki::Input::HTTP->new; Line 13  my $http = SuikaWiki::Input::HTTP->new;
13  my $mode = $http->meta_variable ('PATH_INFO');  my $mode = $http->meta_variable ('PATH_INFO');
14  ## TODO: decode unreserved characters  ## TODO: decode unreserved characters
15    
16  if ($mode eq '/html' or $mode eq '/error-and-html') {  if ($mode eq '/html' or $mode eq '/test') {
17    require Encode;    require Encode;
18    require What::HTML;    require What::HTML;
19    require What::NanoDOM;    require What::NanoDOM;
# Line 27  if ($mode eq '/html' or $mode eq '/error Line 28  if ($mode eq '/html' or $mode eq '/error
28    
29    print STDOUT "Content-Type: text/plain; charset=utf-8\n\n";    print STDOUT "Content-Type: text/plain; charset=utf-8\n\n";
30    
31    my $onerror = $mode eq '/error-and-html' ? sub {    print STDOUT "#errors\n";
32    
33      my $onerror = sub {
34      print STDOUT "0,0,", $_[0], "\n";      print STDOUT "0,0,", $_[0], "\n";
35    } : sub { };    };
36    
37    my $doc = What::HTML->parse_string    my $doc = What::HTML->parse_string
38        ($s => What::NanoDOM::Document->new, $onerror);        ($s => What::NanoDOM::Document->new, $onerror);
39    
40    if ($mode eq '/error-and-html') {    print "#document\n";
     print "--\n";  
   }  
41    
42    my $html = What::HTML->get_inner_html ($doc);    my $out;
43    print STDOUT Encode::encode ('utf-8', $$html);    if ($mode eq '/html') {
44        $out = What::HTML->get_inner_html ($doc);
45      } else { # test
46        $out = test_serialize ($doc);
47      }
48      print STDOUT Encode::encode ('utf-8', $$out);
49  } else {  } else {
50    print STDOUT "Status: 404 Not Found\nContent-Type: text/plain; charset=us-ascii\n\n404";    print STDOUT "Status: 404 Not Found\nContent-Type: text/plain; charset=us-ascii\n\n404";
51  }  }
52    
53    exit;
54    
55    sub test_serialize ($) {
56      my $node = shift;
57      my $r = '';
58    
59      my @node = map { [$_, ''] } @{$node->child_nodes};
60      while (@node) {
61        my $child = shift @node;
62        my $nt = $child->[0]->node_type;
63        if ($nt == $child->[0]->ELEMENT_NODE) {
64          $r .= '| ' . $child->[1] . '<' . $child->[0]->tag_name . ">\x0A"; ## ISSUE: case?
65    
66          for my $attr (sort {$a->[0] cmp $b->[0]} map { [$_->name, $_->value] }
67                        @{$child->[0]->attributes}) {
68            $r .= '| ' . $child->[1] . '  ' . $attr->[0] . '="'; ## ISSUE: case?
69            $r .= $attr->[1] . '"' . "\x0A";
70          }
71          
72          unshift @node,
73            map { [$_, $child->[1] . '  '] } @{$child->[0]->child_nodes};
74        } elsif ($nt == $child->[0]->TEXT_NODE) {
75          $r .= '| ' . $child->[1] . '"' . $child->[0]->data . '"' . "\x0A";
76        } elsif ($nt == $child->[0]->COMMENT_NODE) {
77          $r .= '| ' . $child->[1] . '<!-- ' . $child->[0]->data . " -->\x0A";
78        } elsif ($nt == $child->[0]->DOCUMENT_TYPE_NODE) {
79          $r .= '| ' . $child->[1] . '<!DOCTYPE ' . $child->[0]->name . ">\x0A";
80        } else {
81          $r .= '| ' . $child->[1] . $child->[0]->node_type . "\x0A"; # error
82        }
83      }
84      
85      return \$r;
86    } # test_serialize
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24