/[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.2 by wakaba, Tue May 1 10:27:06 2007 UTC revision 1.5 by wakaba, Fri May 25 14:24:31 2007 UTC
# Line 3  use strict; Line 3  use strict;
3    
4  use lib qw[/home/httpd/html/www/markup/html/whatpm  use lib qw[/home/httpd/html/www/markup/html/whatpm
5             /home/wakaba/public_html/-temp/wiki/lib];             /home/wakaba/public_html/-temp/wiki/lib];
6    use CGI::Carp qw[fatalsToBrowser];
7    
8  use SuikaWiki::Input::HTTP; ## TODO: Use some better CGI module  use SuikaWiki::Input::HTTP; ## TODO: Use some better CGI module
9    
# Line 15  my $mode = $http->meta_variable ('PATH_I Line 16  my $mode = $http->meta_variable ('PATH_I
16    
17  if ($mode eq '/html' or $mode eq '/test') {  if ($mode eq '/html' or $mode eq '/test') {
18    require Encode;    require Encode;
19    require What::HTML;    require Whatpm::HTML;
20    require What::NanoDOM;    require Whatpm::NanoDOM;
21    
22    my $s = $http->parameter ('s');    my $s = $http->parameter ('s');
23    if (length $s > 1000_000) {    if (length $s > 1000_000) {
# Line 31  if ($mode eq '/html' or $mode eq '/test' Line 32  if ($mode eq '/html' or $mode eq '/test'
32    print STDOUT "#errors\n";    print STDOUT "#errors\n";
33    
34    my $onerror = sub {    my $onerror = sub {
35      print STDOUT "0,0,", $_[0], "\n";      my (%opt) = @_;
36        print STDOUT "$opt{line},$opt{column},$opt{type}\n";
37    };    };
38    
39    my $doc = What::HTML->parse_string    my $doc = Whatpm::HTML->parse_string
40        ($s => What::NanoDOM::Document->new, $onerror);        ($s => Whatpm::NanoDOM::Document->new, $onerror);
41    
42    print "#document\n";    print "#document\n";
43    
44    my $out;    my $out;
45    if ($mode eq '/html') {    if ($mode eq '/html') {
46      $out = What::HTML->get_inner_html ($doc);      $out = Whatpm::HTML->get_inner_html ($doc);
47    } else { # test    } else { # test
48      $out = test_serialize ($doc);      $out = test_serialize ($doc);
49    }    }
50    print STDOUT Encode::encode ('utf-8', $$out);    print STDOUT Encode::encode ('utf-8', $$out);
51      print STDOUT "\n";
52    
53      if ($http->parameter ('dom5')) {
54        require Whatpm::ContentChecker;
55        print STDOUT "#domerrors\n";
56        my $docel = $doc->document_element;
57        my $docel_nsuri = $docel->namespace_uri;
58        if (defined $docel_nsuri and
59            $docel_nsuri eq q<http://www.w3.org/1999/xhtml> and
60            $docel->manakai_local_name eq 'html') {
61          #
62        } else {
63          print STDOUT get_node_path ($docel) . ";element not allowed\n";
64        }
65        my $cc = Whatpm::ContentChecker->new;
66        $cc->check_element ($docel, sub {
67          my %opt = @_;
68          print STDOUT get_node_path ($opt{node}) . ';' . $opt{type} . "\n";
69        });
70      }
71  } else {  } else {
72    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";
73  }  }
# Line 84  sub test_serialize ($) { Line 106  sub test_serialize ($) {
106        
107    return \$r;    return \$r;
108  } # test_serialize  } # test_serialize
109    
110    sub get_node_path ($) {
111      my $node = shift;
112      my @r;
113      while (defined $node) {
114        my $rs;
115        if ($node->node_type == 1) {
116          $rs = $node->manakai_local_name;
117          $node = $node->parent_node;
118        } elsif ($node->node_type == 2) {
119          $rs = '@' . $node->manakai_local_name;
120          $node = $node->owner_element;
121        } elsif ($node->node_type == 3) {
122          $rs = '"' . $node->data . '"';
123          $node = $node->parent_node;
124        } elsif ($node->node_type == 9) {
125          $rs = '';
126          $node = $node->parent_node;
127        } else {
128          $rs = '#' . $node->node_type;
129          $node = $node->parent_node;
130        }
131        unshift @r, $rs;
132      }
133      return join '/', @r;
134    } # get_node_path
135    
136    =head1 AUTHOR
137    
138    Wakaba <w@suika.fam.cx>.
139    
140    =head1 LICENSE
141    
142    Copyright 2007 Wakaba <w@suika.fam.cx>
143    
144    This library is free software; you can redistribute it
145    and/or modify it under the same terms as Perl itself.
146    
147    =cut
148    
149    ## $Date$
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.5
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24