#!/usr/bin/perl use strict; use lib qw[/home/httpd/html/www/markup/html/whatpm /home/wakaba/public_html/-temp/wiki/lib]; use SuikaWiki::Input::HTTP; ## TODO: Use some better CGI module my $http = SuikaWiki::Input::HTTP->new; ## TODO: _charset_ my $mode = $http->meta_variable ('PATH_INFO'); ## TODO: decode unreserved characters if ($mode eq '/html' or $mode eq '/test') { require Encode; require What::HTML; require What::NanoDOM; my $s = $http->parameter ('s'); if (length $s > 1000_000) { print STDOUT "Status: 400 Document Too Long\nContent-Type: text/plain; charset=us-ascii\n\nToo long"; exit; } $s = Encode::decode ('utf-8', $s); print STDOUT "Content-Type: text/plain; charset=utf-8\n\n"; print STDOUT "#errors\n"; my $onerror = sub { print STDOUT "0,0,", $_[0], "\n"; }; my $doc = What::HTML->parse_string ($s => What::NanoDOM::Document->new, $onerror); print "#document\n"; my $out; if ($mode eq '/html') { $out = What::HTML->get_inner_html ($doc); } else { # test $out = test_serialize ($doc); } print STDOUT Encode::encode ('utf-8', $$out); } else { print STDOUT "Status: 404 Not Found\nContent-Type: text/plain; charset=us-ascii\n\n404"; } exit; sub test_serialize ($) { my $node = shift; my $r = ''; my @node = map { [$_, ''] } @{$node->child_nodes}; while (@node) { my $child = shift @node; my $nt = $child->[0]->node_type; if ($nt == $child->[0]->ELEMENT_NODE) { $r .= '| ' . $child->[1] . '<' . $child->[0]->tag_name . ">\x0A"; ## ISSUE: case? for my $attr (sort {$a->[0] cmp $b->[0]} map { [$_->name, $_->value] } @{$child->[0]->attributes}) { $r .= '| ' . $child->[1] . ' ' . $attr->[0] . '="'; ## ISSUE: case? $r .= $attr->[1] . '"' . "\x0A"; } unshift @node, map { [$_, $child->[1] . ' '] } @{$child->[0]->child_nodes}; } elsif ($nt == $child->[0]->TEXT_NODE) { $r .= '| ' . $child->[1] . '"' . $child->[0]->data . '"' . "\x0A"; } elsif ($nt == $child->[0]->COMMENT_NODE) { $r .= '| ' . $child->[1] . '\x0A"; } elsif ($nt == $child->[0]->DOCUMENT_TYPE_NODE) { $r .= '| ' . $child->[1] . '[0]->name . ">\x0A"; } else { $r .= '| ' . $child->[1] . $child->[0]->node_type . "\x0A"; # error } } return \$r; } # test_serialize