test/html-whatpm/table.cgi

#!/usr/bin/perl
use strict;

use lib qw[/home/httpd/html/www/markup/html/whatpm
           /home/wakaba/public_html/-temp/wiki/lib];
use CGI::Carp qw[fatalsToBrowser];

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 '/table') {
  require Encode;
  require Whatpm::HTML;
  require Whatpm::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);
  my $doc = Whatpm::HTML->parse_string
      ($s => Whatpm::NanoDOM::Document->new);

  my @table_el;
  my @node = @{$doc->child_nodes};
  while (@node) {
    my $node = shift @node;
    if ($node->node_type == 1) {
      if ($node->namespace_uri eq q<http://www.w3.org/1999/xhtml> and
          $node->manakai_local_name eq 'table') {
        push @table_el, $node;
      }
    }
    push @node, @{$node->child_nodes};
  }
  
  print STDOUT "Content-Type: text/html; charset=utf-8\n\n";
  
  use JSON;
  require Whatpm::HTMLTable;

  print STDOUT '<!DOCTYPE html>
<html lang="en">
<head>
<title>HTML5 Table Structure Viewer</title>
<!--[if IE]><script type="text/javascript" src="../excanvas.js"></script><![endif]-->
<script src="../table-script.js" type="text/javascript"></script>
</head>
<body>
<noscript><p>How great if there were no script at all!</p></noscript>
';

  my $i = 0;
  for my $table_el (@table_el) {
    $i++; print STDOUT "<h1>Table $i</h1>\n";

    my $table = Whatpm::HTMLTable->form_table ($table_el);
    Whatpm::HTMLTable->assign_header ($table);

    delete $table->{element};

    for (@{$table->{column_group}}, @{$table->{column}}, $table->{caption},
         @{$table->{row}}) {
      next unless $_;
      delete $_->{element};
    }
    
    for (@{$table->{row_group}}) {
      next unless $_;
      next unless $_->{element};
      $_->{type} = $_->{element}->manakai_local_name;
      delete $_->{element};
    }
    
    for (@{$table->{cell}}) {
      next unless $_;
      for (@{$_}) {
        next unless $_;
        for (@$_) {
          $_->{id} = ''.$_->{element} if defined $_->{element};
          delete $_->{element};
          $_->{is_header} = $_->{is_header} ? 1 : 0;
        }
      }
    }

    print STDOUT '<script type="text/javascript"> 
  tableToCanvas (
';
    print STDOUT objToJson ($table);
    print STDOUT ', document.body, "");
</script>';
  }

  print STDOUT '</body></html>';
} else {
  print STDOUT "Status: 404 Not Found\nContent-Type: text/plain; charset=us-ascii\n\n404";
}

exit;

=head1 AUTHOR

Wakaba <w@suika.fam.cx>.

=head1 LICENSE

Copyright 2007-2008 Wakaba <w@suika.fam.cx>

This library is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.

=cut

## $Date: 2008/05/06 07:50:28 $
1	wakaba	1.1	#!/usr/bin/perl
2			use strict;
3
4			use lib qw[/home/httpd/html/www/markup/html/whatpm
5			/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
9
10			my $http = SuikaWiki::Input::HTTP->new;
11
12			## TODO: _charset_
13
14			my $mode = $http->meta_variable ('PATH_INFO');
15			## TODO: decode unreserved characters
16
17			if ($mode eq '/table') {
18			require Encode;
19			require Whatpm::HTML;
20			require Whatpm::NanoDOM;
21
22			my $s = $http->parameter ('s');
23			if (length $s > 1000_000) {
24			print STDOUT "Status: 400 Document Too Long\nContent-Type: text/plain; charset=us-ascii\n\nToo long";
25			exit;
26			}
27
28			$s = Encode::decode ('utf-8', $s);
29			my $doc = Whatpm::HTML->parse_string
30			($s => Whatpm::NanoDOM::Document->new);
31
32			my @table_el;
33			my @node = @{$doc->child_nodes};
34			while (@node) {
35			my $node = shift @node;
36			if ($node->node_type == 1) {
37			if ($node->namespace_uri eq q<http://www.w3.org/1999/xhtml> and
38			$node->manakai_local_name eq 'table') {
39			push @table_el, $node;
40			}
41			}
42			push @node, @{$node->child_nodes};
43			}
44
45			print STDOUT "Content-Type: text/html; charset=utf-8\n\n";
46
47			use JSON;
48			require Whatpm::HTMLTable;
49
50			print STDOUT '<!DOCTYPE html>
51			<html lang="en">
52			<head>
53			<title>HTML5 Table Structure Viewer</title>
54	wakaba	1.2	<!--[if IE]><script type="text/javascript" src="../excanvas.js"></script><![endif]-->
55	wakaba	1.1	<script src="../table-script.js" type="text/javascript"></script>
56			</head>
57			<body>
58	wakaba	1.2	<noscript><p>How great if there were no script at all!</p></noscript>
59	wakaba	1.1	';
60
61			my $i = 0;
62			for my $table_el (@table_el) {
63			$i++; print STDOUT "<h1>Table $i</h1>\n";
64
65			my $table = Whatpm::HTMLTable->form_table ($table_el);
66	wakaba	1.6	Whatpm::HTMLTable->assign_header ($table);
67	wakaba	1.1
68	wakaba	1.7	delete $table->{element};
69
70	wakaba	1.6	for (@{$table->{column_group}}, @{$table->{column}}, $table->{caption},
71			@{$table->{row}}) {
72	wakaba	1.1	next unless $_;
73			delete $_->{element};
74			}
75
76			for (@{$table->{row_group}}) {
77			next unless $_;
78			next unless $_->{element};
79			$_->{type} = $_->{element}->manakai_local_name;
80			delete $_->{element};
81			}
82
83			for (@{$table->{cell}}) {
84			next unless $_;
85			for (@{$_}) {
86			next unless $_;
87			for (@$_) {
88	wakaba	1.6	$_->{id} = ''.$_->{element} if defined $_->{element};
89	wakaba	1.1	delete $_->{element};
90	wakaba	1.4	$_->{is_header} = $_->{is_header} ? 1 : 0;
91	wakaba	1.1	}
92			}
93			}
94
95	wakaba	1.2	print STDOUT '<script type="text/javascript">
96	wakaba	1.1	tableToCanvas (
97			';
98			print STDOUT objToJson ($table);
99	wakaba	1.5	print STDOUT ', document.body, "");
100	wakaba	1.1	</script>';
101			}
102
103			print STDOUT '</body></html>';
104			} else {
105			print STDOUT "Status: 404 Not Found\nContent-Type: text/plain; charset=us-ascii\n\n404";
106			}
107
108			exit;
109
110			=head1 AUTHOR
111
112			Wakaba <w@suika.fam.cx>.
113
114			=head1 LICENSE
115
116	wakaba	1.5	Copyright 2007-2008 Wakaba <w@suika.fam.cx>
117	wakaba	1.1
118			This library is free software; you can redistribute it
119			and/or modify it under the same terms as Perl itself.
120
121			=cut
122
123	wakaba	1.7	## $Date: 2008/05/06 07:50:28 $