/[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.7 by wakaba, Mon May 28 14:04:57 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    use Time::HiRes qw/time/;
8    
9  use SuikaWiki::Input::HTTP; ## TODO: Use some better CGI module  use SuikaWiki::Input::HTTP; ## TODO: Use some better CGI module
10    
# Line 15  my $mode = $http->meta_variable ('PATH_I Line 17  my $mode = $http->meta_variable ('PATH_I
17    
18  if ($mode eq '/html' or $mode eq '/test') {  if ($mode eq '/html' or $mode eq '/test') {
19    require Encode;    require Encode;
20    require What::HTML;    require Whatpm::HTML;
21    require What::NanoDOM;    require Whatpm::NanoDOM;
22    
23    my $s = $http->parameter ('s');    my $s = $http->parameter ('s');
24    if (length $s > 1000_000) {    if (length $s > 1000_000) {
# Line 24  if ($mode eq '/html' or $mode eq '/test' Line 26  if ($mode eq '/html' or $mode eq '/test'
26      exit;      exit;
27    }    }
28    
29      my $time1 = time;
30    $s = Encode::decode ('utf-8', $s);    $s = Encode::decode ('utf-8', $s);
31      my $time2 = time;
32      my %time = (decode => $time2 - $time1);
33      my $char_length = length $s;
34      
35    print STDOUT "Content-Type: text/plain; charset=utf-8\n\n";    print STDOUT "Content-Type: text/plain; charset=utf-8\n\n";
36    
37    print STDOUT "#errors\n";    print STDOUT "#errors\n";
38    
39    my $onerror = sub {    my $onerror = sub {
40      print STDOUT "0,0,", $_[0], "\n";      my (%opt) = @_;
41        print STDOUT "$opt{line},$opt{column},$opt{type}\n";
42    };    };
43    
44    my $doc = What::HTML->parse_string    $time1 = time;
45        ($s => What::NanoDOM::Document->new, $onerror);    my $doc = Whatpm::HTML->parse_string
46          ($s => Whatpm::NanoDOM::Document->new, $onerror);
47      $time2 = time;
48      $time{parse} = $time2 - $time1;
49    
50    print "#document\n";    print "#document\n";
51    
52    my $out;    my $out;
53      $time1 = time;
54    if ($mode eq '/html') {    if ($mode eq '/html') {
55      $out = What::HTML->get_inner_html ($doc);      $out = Whatpm::HTML->get_inner_html ($doc);
56    } else { # test    } else { # test
57      $out = test_serialize ($doc);      $out = test_serialize ($doc);
58    }    }
59      $time2 = time;
60      $time{serialize} = $time2 - $time1;
61    print STDOUT Encode::encode ('utf-8', $$out);    print STDOUT Encode::encode ('utf-8', $$out);
62      print STDOUT "\n";
63    
64      if ($http->parameter ('dom5')) {
65        require Whatpm::ContentChecker;
66        print STDOUT "#domerrors\n";
67        $time1 = time;
68        Whatpm::ContentChecker->check_document ($doc, sub {
69          my %opt = @_;
70          print STDOUT get_node_path ($opt{node}) . ';' . $opt{type} . "\n";
71        });
72        $time2 = time;
73        $time{check} = $time2 - $time1;
74      }
75    
76      print STDOUT "#log\n";
77      print STDOUT "byte->char\t", $time{decode}, "s\n";
78      print STDOUT "html5->dom5\t", $time{parse}, "s\n";
79      print STDOUT "dom5->serialize\t", $time{serialize}, "s\n";
80      print STDOUT "dom5 check\t", $time{check}, "s\n" if defined $time{check};
81      for (qw/decode parse serialize check/) {
82        next unless defined $time{$_};
83        open my $file, '>>', ".$_.txt" or die ".$_.txt: $!";
84        print $file $char_length, "\t", $time{$_}, "\n";
85      }
86  } else {  } else {
87    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";
88  }  }
# Line 84  sub test_serialize ($) { Line 121  sub test_serialize ($) {
121        
122    return \$r;    return \$r;
123  } # test_serialize  } # test_serialize
124    
125    sub get_node_path ($) {
126      my $node = shift;
127      my @r;
128      while (defined $node) {
129        my $rs;
130        if ($node->node_type == 1) {
131          $rs = $node->manakai_local_name;
132          $node = $node->parent_node;
133        } elsif ($node->node_type == 2) {
134          $rs = '@' . $node->manakai_local_name;
135          $node = $node->owner_element;
136        } elsif ($node->node_type == 3) {
137          $rs = '"' . $node->data . '"';
138          $node = $node->parent_node;
139        } elsif ($node->node_type == 9) {
140          $rs = '';
141          $node = $node->parent_node;
142        } else {
143          $rs = '#' . $node->node_type;
144          $node = $node->parent_node;
145        }
146        unshift @r, $rs;
147      }
148      return join '/', @r;
149    } # get_node_path
150    
151    =head1 AUTHOR
152    
153    Wakaba <w@suika.fam.cx>.
154    
155    =head1 LICENSE
156    
157    Copyright 2007 Wakaba <w@suika.fam.cx>
158    
159    This library is free software; you can redistribute it
160    and/or modify it under the same terms as Perl itself.
161    
162    =cut
163    
164    ## $Date$
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.7
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24