whatpm/Whatpm/HTMLTable.pm

package Whatpm::HTMLTable;
use strict;

## An implementation of "Forming a table" algorithm in HTML5
sub form_table ($$$;$) {
  my (undef, $table_el, $onerror, $must_level) = @_;
  $onerror ||= sub { };
  $must_level ||= 'm';
  
  ## Step 1
  my $x_width = 0;

  ## Step 2
  my $y_height = 0;
  my $y_max_node;

  ## Step 3
  my $pending_tfoot = [];
  
  ## Step 4
  my $table = {
    #caption
    column => [],
    column_group => [],
    row => [], ## NOTE: HTML5 algorithm doesn't associate rows with <tr>s.
    row_group => [],
    cell => [],
  };
  
  my @column_has_anchored_cell;
  my @row_has_anchored_cell;
  my @column_generated_by;
  my @row_generated_by;
  
  ## Step 5
  my @table_child = @{$table_el->child_nodes};
  return $table unless @table_child;

  ## Step 6
  for (0..$#table_child) {
    my $el = $table_child[$_];
    next unless $el->node_type == 1; # ELEMENT_NODE
    next unless $el->manakai_local_name eq 'caption';
    my $nsuri = $el->namespace_uri;
    next unless defined $nsuri;
    next unless $nsuri eq q<http://www.w3.org/1999/xhtml>;
    $table->{caption} = {element => $el};
    splice @table_child, $_, 1, ();
    last;
  }

  my $process_row_group;
  my $end = sub {
    ## Step 19 (End)
    for (@$pending_tfoot) {
      $process_row_group->($_);
    }
    
    ## Step 20
    for (0 .. $x_width - 1) {
      unless ($column_has_anchored_cell[$_]) {
        if ($table->{column}->[$_]) {
          $onerror->(type => 'column with no anchored cell',
                     node => $table->{column}->[$_]->{element},
                     level => $must_level);
        } else {
          $onerror->(type => 'colspan creates column with no anchored cell',
                     node => $column_generated_by[$_],
                    level => $must_level);
        }
        last; # only one error.
      }
    }
    for (0 .. $y_height - 1) {
      unless ($row_has_anchored_cell[$_]) {
        if ($table->{row}->[$_]) {
          $onerror->(type => 'row with no anchored cell',
                     node => $table->{row}->[$_]->{element},
                     level => $must_level);
        } else {
          $onerror->(type => 'rowspan creates row with no anchored cell',
                     node => $row_generated_by[$_],
                     level => $must_level);
        }
        last; # only one error.
      }
    }
    
    ## Step 21
    #return $table;
  }; # $end

  ## Step 7, 8
  my $current_element;
  my $current_ln;
  NEXT_CHILD: {
    $current_element = shift @table_child;
    if (defined $current_element) {
      redo NEXT_CHILD unless $current_element->node_type == 1;
      my $nsuri = $current_element->namespace_uri;
      redo NEXT_CHILD unless defined $nsuri and
        $nsuri eq q<http://www.w3.org/1999/xhtml>;
      $current_ln = $current_element->manakai_local_name;

      redo NEXT_CHILD unless {
        colgroup => 1,
        thead => 1,
        tbody => 1,
        tfoot => 1,
        tr => 1,
      }->{$current_ln};
    } else {
      ## Step 6 2nd paragraph
      $end->();
      return $table;
    }
  } # NEXT_CHILD

  ## Step 9
  while ($current_ln eq 'colgroup') { # Step 9, Step 9.4
    ## Step 9.1: column groups
    my @col = grep {
      $_->node_type == 1 and
      defined $_->namespace_uri and
      $_->namespace_uri eq q<http://www.w3.org/1999/xhtml> and
      $_->manakai_local_name eq 'col'
    } @{$current_element->child_nodes};
    if (@col) {
      ## Step 1
      my $x_start = $x_width;
      
      ## Step 2, 6
      while (@col) {
        my $current_column = shift @col;
        
        ## Step 3: columns
        my $span = 1;
        my $col_span = $current_column->get_attribute_ns (undef, 'span');
        ## Parse non-negative integer
        if (defined $col_span and $col_span =~ /^[\x09-\x0D\x20]*([0-9]+)/) {
          $span = $1 || 1;
        }
        ## ISSUE: If span=0, what is /span/ value?
        
        ## Step 4, 5
        $table->{column}->[++$x_width] = {element => $current_column}
            for 1..$span;
      }
      
      ## Step 7
      my $cg = {element => $current_element,
                x => $x_start, y => 0,
                width => $x_width - $x_start};
      $table->{column_group}->[$_] = $cg for $x_start .. $x_width - 1;
    } else { # no <col> children
      ## Step 1
      my $span = 1;
      my $col_span = $current_element->get_attribute_ns (undef, 'span');
      ## Parse non-negative integer
      if (defined $col_span and $col_span =~ /^[\x09-\x0D\x20]*([0-9]+)/) {
        $span = $1 || 1;
      }
      ## ISSUE: If span=0, what is /span/ value?
      
      ## Step 2
      $x_width += $span;
      
      ## Step 3
      my $cg = {element => $current_element,
                x => $x_width - $span, y => 0,
                width => $span};
      $table->{column_group}->[$_] = $cg for $cg->{x} .. $x_width - 1;
    }
    
    ## Step 9.2, 9.3
    NEXT_CHILD: {
      $current_element = shift @table_child;
      if (defined $current_element) {
        redo NEXT_CHILD unless $current_element->node_type == 1;
        my $nsuri = $current_element->namespace_uri;
        redo NEXT_CHILD unless defined $nsuri and
          $nsuri eq q<http://www.w3.org/1999/xhtml>;
        $current_ln = $current_element->manakai_local_name;
        
        redo NEXT_CHILD unless {
          colgroup => 1,
          thead => 1,
          tbody => 1,
          tfoot => 1,
          tr => 1,
        }->{$current_ln};
      } else {
        ## End of subsection
        
        ## Step 5 of overall steps 2nd paragraph
        $end->();
        return $table;
      }
    } # NEXT_CHILD
  }

  ## Step 10
  my $y_current = 0;

  ## Step 11
  my @downward_growing_cells;

  my $growing_downward_growing_cells = sub {
    for (@downward_growing_cells) {
      for my $x ($_->[1] .. ($_->[1] + $_->[2] - 1)) {
        $table->{cell}->[$x]->[$y_current] = [$_->[0]];
        $_->[0]->{height}++;
      }
    }
  }; # $growing_downward_growing_cells

  my $process_row = sub {
    ## Step 1
    $y_height++ if $y_height == $y_current;
    
    ## Step 2
    my $x_current = 0;

    ## Step 3
    my $tr = shift;
    $table->{row}->[$y_current] = {element => $tr};
    my @tdth = grep {
      $_->node_type == 1 and
      defined $_->namespace_uri and
      $_->namespace_uri eq q<http://www.w3.org/1999/xhtml> and
      {td => 1, th => 1}->{$_->manakai_local_name}
    } @{$tr->child_nodes};
    my $current_cell = shift @tdth;

    ## Step 4
    $growing_downward_growing_cells->();

return unless $current_cell;
## ISSUE: Support for empty <tr></tr> (removed at revision 1376).

    CELL: while (1) {
      ## Step 5: cells
      $x_current++
        while ($x_current < $x_width and
               $table->{cell}->[$x_current]->[$y_current]);

      ## Step 6
      $x_width++ if $x_current == $x_width;

      ## Step 7
      my $colspan = 1;
      my $attr_value = $current_cell->get_attribute_ns (undef, 'colspan');
      if (defined $attr_value and $attr_value =~ /^[\x09-\x0D\x20]*([0-9]+)/) {
        $colspan = $1 || 1;
      }
      
      ## Step 8
      my $rowspan = 1;
      my $attr_value = $current_cell->get_attribute_ns (undef, 'rowspan');
      if (defined $attr_value and $attr_value =~ /^[\x09-\x0D\x20]*([0-9]+)/) {
        $rowspan = $1;
      }
      
      ## Step 9
      my $cell_grows_downward;
      if ($rowspan == 0) {
        $cell_grows_downward = 1;
        $rowspan = 1;
      }
      
      ## Step 10
      if ($x_width < $x_current + $colspan) { 
        @column_generated_by[$_] = $current_cell
          for $x_width .. $x_current + $colspan - 1;
        $x_width = $x_current + $colspan;
      }
      
      ## Step 11
      if ($y_height < $y_current + $rowspan) {
        @row_generated_by[$_] = $current_cell
            for $y_height .. $y_current + $rowspan - 1;
        $y_height = $y_current + $rowspan;
        $y_max_node = $current_cell;
      }
      
      ## Step 12
      my $cell = {
                  is_header => ($current_cell->manakai_local_name eq 'th'),
                  element => $current_cell,
                  x => $x_current, y => $y_current,
                  width => $colspan, height => $rowspan,
                 };
      $column_has_anchored_cell[$x_current] = 1;
      $row_has_anchored_cell[$y_current] = 1;
      for my $x ($x_current .. ($x_current + $colspan - 1)) {
        for my $y ($y_current .. ($y_current + $rowspan - 1)) {
          unless ($table->{cell}->[$x]->[$y]) {
            $table->{cell}->[$x]->[$y] = [$cell];
          } else {
            $onerror->(type => "cell overlapping:$x:$y", node => $current_cell,
                       level => $must_level);
            push @{$table->{cell}->[$x]->[$y]}, $cell;
          }
        }
      }
      
      ## Step 13
      if ($cell_grows_downward) {
        push @downward_growing_cells, [$cell, $x_current, $colspan];
      }
      
      ## Step 14
      $x_current += $colspan;

      ## Step 15-17
      $current_cell = shift @tdth;
      if (defined $current_cell) {
        ## Step 16-17
        #
      } else {
        ## Step 15
        $y_current++;
        last CELL;
      }
    } # CELL
  }; # $process_row

  $process_row_group = sub ($) {
    ## Step 1
    my $y_start = $y_height;

    ## Step 2
    for (grep {
      $_->node_type == 1 and
      defined $_->namespace_uri and
      $_->namespace_uri eq q<http://www.w3.org/1999/xhtml> and
      $_->manakai_local_name eq 'tr'
    } @{$_[0]->child_nodes}) {
      $process_row->($_);
    }

    ## Step 3
    if ($y_height > $y_start) {
      my $rg = {element => $current_element, ## ISSUE: "element being processed"?
                x => 0, y => $y_start,
                height => $y_height - $y_start};
      $table->{row_group}->[$_] = $rg for $y_start .. $y_height - 1;
    }

    ## Step 4
    ## Ending a row group
      ## Step 1
      while ($y_current < $y_height) {
        ## Step 1
        $growing_downward_growing_cells->();

        ## Step 2
        $y_current++;
      }
      ## Step 2
      @downward_growing_cells = ();
  }; # $process_row_group

  ## Step 12: rows
  unshift @table_child, $current_element;
  ROWS: {
    NEXT_CHILD: {
      $current_element = shift @table_child;
      if (defined $current_element) {
        redo NEXT_CHILD unless $current_element->node_type == 1;
        my $nsuri = $current_element->namespace_uri;
        redo NEXT_CHILD unless defined $nsuri and
          $nsuri eq q<http://www.w3.org/1999/xhtml>;
        $current_ln = $current_element->manakai_local_name;
      
        redo NEXT_CHILD unless {
          thead => 1,
          tbody => 1,
          tfoot => 1,
          tr => 1,
        }->{$current_ln};
      } else {
        ## Step 6 2nd paragraph
        $end->();
        return $table;
      }
    } # NEXT_CHILD

    ## Step 13
    if ($current_ln eq 'tr') {
      $process_row->($current_element);
      # advance (done at the first of ROWS)
      redo ROWS;
    }

    ## Step 14
    ## Ending a row group
      ## Step 1
      while ($y_current < $y_height) {
        ## Step 1
        $growing_downward_growing_cells->();

        ## Step 2
        $y_current++;
      }
      ## Step 2
      @downward_growing_cells = ();

    ## Step 15
    if ($current_ln eq 'tfoot') {
      push @$pending_tfoot, $current_element;
      # advance (done at the top of ROWS)
      redo ROWS;
    }

    ## Step 16
    # thead or tbody
    $process_row_group->($current_element);

    ## Step 17
    # Advance (done at the top of ROWS).

    ## Step 18
    redo ROWS;
  } # ROWS

  $end->();
  return $table;
} # form_table

## TODO: Implement scope="" algorithm

1;
## $Date: 2008/05/05 08:00:25 $
1	wakaba	1.1	package Whatpm::HTMLTable;
2			use strict;
3
4			## An implementation of "Forming a table" algorithm in HTML5
5	wakaba	1.9	sub form_table ($$$;$) {
6			my (undef, $table_el, $onerror, $must_level) = @_;
7	wakaba	1.2	$onerror \|\|= sub { };
8	wakaba	1.9	$must_level \|\|= 'm';
9	wakaba	1.1
10			## Step 1
11	wakaba	1.7	my $x_width = 0;
12	wakaba	1.1
13			## Step 2
14	wakaba	1.7	my $y_height = 0;
15	wakaba	1.1	my $y_max_node;
16	wakaba	1.8
17			## Step 3
18			my $pending_tfoot = [];
19	wakaba	1.1
20	wakaba	1.8	## Step 4
21	wakaba	1.1	my $table = {
22			#caption
23			column => [],
24			column_group => [],
25	wakaba	1.9	row => [], ## NOTE: HTML5 algorithm doesn't associate rows with <tr>s.
26	wakaba	1.1	row_group => [],
27			cell => [],
28			};
29
30	wakaba	1.9	my @column_has_anchored_cell;
31			my @row_has_anchored_cell;
32	wakaba	1.1	my @column_generated_by;
33	wakaba	1.9	my @row_generated_by;
34
35			## Step 5
36			my @table_child = @{$table_el->child_nodes};
37			return $table unless @table_child;
38
39	wakaba	1.10	## Step 6
40			for (0..$#table_child) {
41			my $el = $table_child[$_];
42			next unless $el->node_type == 1; # ELEMENT_NODE
43			next unless $el->manakai_local_name eq 'caption';
44			my $nsuri = $el->namespace_uri;
45			next unless defined $nsuri;
46			next unless $nsuri eq q<http://www.w3.org/1999/xhtml>;
47			$table->{caption} = {element => $el};
48			splice @table_child, $_, 1, ();
49			last;
50			}
51
52	wakaba	1.9	my $process_row_group;
53			my $end = sub {
54	wakaba	1.10	## Step 19 (End)
55	wakaba	1.9	for (@$pending_tfoot) {
56			$process_row_group->($_);
57			}
58
59	wakaba	1.10	## Step 20
60	wakaba	1.7	for (0 .. $x_width - 1) {
61	wakaba	1.9	unless ($column_has_anchored_cell[$_]) {
62	wakaba	1.1	if ($table->{column}->[$_]) {
63			$onerror->(type => 'column with no anchored cell',
64	wakaba	1.9	node => $table->{column}->[$_]->{element},
65			level => $must_level);
66	wakaba	1.1	} else {
67	wakaba	1.4	$onerror->(type => 'colspan creates column with no anchored cell',
68	wakaba	1.9	node => $column_generated_by[$_],
69			level => $must_level);
70	wakaba	1.1	}
71	wakaba	1.9	last; # only one error.
72	wakaba	1.1	}
73			}
74	wakaba	1.9	for (0 .. $y_height - 1) {
75			unless ($row_has_anchored_cell[$_]) {
76			if ($table->{row}->[$_]) {
77			$onerror->(type => 'row with no anchored cell',
78			node => $table->{row}->[$_]->{element},
79			level => $must_level);
80			} else {
81			$onerror->(type => 'rowspan creates row with no anchored cell',
82			node => $row_generated_by[$_],
83			level => $must_level);
84			}
85			last; # only one error.
86			}
87			}
88
89	wakaba	1.10	## Step 21
90	wakaba	1.9	#return $table;
91			}; # $end
92	wakaba	1.1
93	wakaba	1.10	## Step 7, 8
94	wakaba	1.1	my $current_element;
95			my $current_ln;
96			NEXT_CHILD: {
97			$current_element = shift @table_child;
98			if (defined $current_element) {
99			redo NEXT_CHILD unless $current_element->node_type == 1;
100			my $nsuri = $current_element->namespace_uri;
101			redo NEXT_CHILD unless defined $nsuri and
102			$nsuri eq q<http://www.w3.org/1999/xhtml>;
103			$current_ln = $current_element->manakai_local_name;
104
105			redo NEXT_CHILD unless {
106			colgroup => 1,
107			thead => 1,
108			tbody => 1,
109			tfoot => 1,
110			tr => 1,
111			}->{$current_ln};
112			} else {
113	wakaba	1.8	## Step 6 2nd paragraph
114	wakaba	1.9	$end->();
115			return $table;
116	wakaba	1.1	}
117			} # NEXT_CHILD
118
119	wakaba	1.10	## Step 9
120			while ($current_ln eq 'colgroup') { # Step 9, Step 9.4
121			## Step 9.1: column groups
122	wakaba	1.1	my @col = grep {
123			$_->node_type == 1 and
124			defined $_->namespace_uri and
125			$_->namespace_uri eq q<http://www.w3.org/1999/xhtml> and
126			$_->manakai_local_name eq 'col'
127			} @{$current_element->child_nodes};
128			if (@col) {
129			## Step 1
130	wakaba	1.7	my $x_start = $x_width;
131	wakaba	1.1
132			## Step 2, 6
133			while (@col) {
134			my $current_column = shift @col;
135
136			## Step 3: columns
137			my $span = 1;
138			my $col_span = $current_column->get_attribute_ns (undef, 'span');
139			## Parse non-negative integer
140			if (defined $col_span and $col_span =~ /^[\x09-\x0D\x20]*([0-9]+)/) {
141			$span = $1 \|\| 1;
142			}
143			## ISSUE: If span=0, what is /span/ value?
144
145			## Step 4, 5
146	wakaba	1.7	$table->{column}->[++$x_width] = {element => $current_column}
147			for 1..$span;
148	wakaba	1.1	}
149
150			## Step 7
151			my $cg = {element => $current_element,
152	wakaba	1.7	x => $x_start, y => 0,
153			width => $x_width - $x_start};
154			$table->{column_group}->[$_] = $cg for $x_start .. $x_width - 1;
155	wakaba	1.1	} else { # no <col> children
156			## Step 1
157			my $span = 1;
158			my $col_span = $current_element->get_attribute_ns (undef, 'span');
159			## Parse non-negative integer
160			if (defined $col_span and $col_span =~ /^[\x09-\x0D\x20]*([0-9]+)/) {
161			$span = $1 \|\| 1;
162			}
163			## ISSUE: If span=0, what is /span/ value?
164
165			## Step 2
166	wakaba	1.7	$x_width += $span;
167	wakaba	1.1
168			## Step 3
169			my $cg = {element => $current_element,
170	wakaba	1.7	x => $x_width - $span, y => 0,
171	wakaba	1.1	width => $span};
172	wakaba	1.7	$table->{column_group}->[$_] = $cg for $cg->{x} .. $x_width - 1;
173	wakaba	1.1	}
174
175	wakaba	1.10	## Step 9.2, 9.3
176	wakaba	1.1	NEXT_CHILD: {
177			$current_element = shift @table_child;
178			if (defined $current_element) {
179			redo NEXT_CHILD unless $current_element->node_type == 1;
180			my $nsuri = $current_element->namespace_uri;
181			redo NEXT_CHILD unless defined $nsuri and
182			$nsuri eq q<http://www.w3.org/1999/xhtml>;
183			$current_ln = $current_element->manakai_local_name;
184
185			redo NEXT_CHILD unless {
186			colgroup => 1,
187			thead => 1,
188			tbody => 1,
189			tfoot => 1,
190			tr => 1,
191			}->{$current_ln};
192			} else {
193			## End of subsection
194	wakaba	1.9
195	wakaba	1.1	## Step 5 of overall steps 2nd paragraph
196	wakaba	1.9	$end->();
197			return $table;
198	wakaba	1.1	}
199			} # NEXT_CHILD
200			}
201
202	wakaba	1.10	## Step 10
203	wakaba	1.1	my $y_current = 0;
204
205	wakaba	1.10	## Step 11
206	wakaba	1.1	my @downward_growing_cells;
207
208			my $growing_downward_growing_cells = sub {
209			for (@downward_growing_cells) {
210			for my $x ($_->[1] .. ($_->[1] + $_->[2] - 1)) {
211			$table->{cell}->[$x]->[$y_current] = [$_->[0]];
212			$_->[0]->{height}++;
213			}
214			}
215			}; # $growing_downward_growing_cells
216
217			my $process_row = sub {
218			## Step 1
219	wakaba	1.7	$y_height++ if $y_height == $y_current;
220	wakaba	1.1
221			## Step 2
222	wakaba	1.7	my $x_current = 0;
223
224	wakaba	1.1	## Step 3
225			my $tr = shift;
226	wakaba	1.9	$table->{row}->[$y_current] = {element => $tr};
227	wakaba	1.1	my @tdth = grep {
228			$_->node_type == 1 and
229			defined $_->namespace_uri and
230			$_->namespace_uri eq q<http://www.w3.org/1999/xhtml> and
231			{td => 1, th => 1}->{$_->manakai_local_name}
232			} @{$tr->child_nodes};
233	wakaba	1.7	my $current_cell = shift @tdth;
234
235			## Step 4
236			$growing_downward_growing_cells->();
237	wakaba	1.1
238	wakaba	1.9	return unless $current_cell;
239			## ISSUE: Support for empty <tr></tr> (removed at revision 1376).
240
241	wakaba	1.7	CELL: while (1) {
242			## Step 5: cells
243	wakaba	1.1	$x_current++
244	wakaba	1.7	while ($x_current < $x_width and
245	wakaba	1.1	$table->{cell}->[$x_current]->[$y_current]);
246
247	wakaba	1.7	## Step 6
248			$x_width++ if $x_current == $x_width;
249
250	wakaba	1.1	## Step 7
251			my $colspan = 1;
252			my $attr_value = $current_cell->get_attribute_ns (undef, 'colspan');
253			if (defined $attr_value and $attr_value =~ /^[\x09-\x0D\x20]*([0-9]+)/) {
254			$colspan = $1 \|\| 1;
255			}
256
257	wakaba	1.7	## Step 8
258	wakaba	1.1	my $rowspan = 1;
259			my $attr_value = $current_cell->get_attribute_ns (undef, 'rowspan');
260			if (defined $attr_value and $attr_value =~ /^[\x09-\x0D\x20]*([0-9]+)/) {
261			$rowspan = $1;
262			}
263
264	wakaba	1.7	## Step 9
265	wakaba	1.1	my $cell_grows_downward;
266			if ($rowspan == 0) {
267			$cell_grows_downward = 1;
268			$rowspan = 1;
269			}
270
271	wakaba	1.7	## Step 10
272			if ($x_width < $x_current + $colspan) {
273	wakaba	1.1	@column_generated_by[$_] = $current_cell
274	wakaba	1.7	for $x_width .. $x_current + $colspan - 1;
275			$x_width = $x_current + $colspan;
276	wakaba	1.1	}
277
278	wakaba	1.7	## Step 11
279			if ($y_height < $y_current + $rowspan) {
280	wakaba	1.9	@row_generated_by[$_] = $current_cell
281			for $y_height .. $y_current + $rowspan - 1;
282	wakaba	1.7	$y_height = $y_current + $rowspan;
283	wakaba	1.1	$y_max_node = $current_cell;
284			}
285
286	wakaba	1.7	## Step 12
287	wakaba	1.1	my $cell = {
288	wakaba	1.2	is_header => ($current_cell->manakai_local_name eq 'th'),
289	wakaba	1.1	element => $current_cell,
290			x => $x_current, y => $y_current,
291			width => $colspan, height => $rowspan,
292			};
293	wakaba	1.9	$column_has_anchored_cell[$x_current] = 1;
294			$row_has_anchored_cell[$y_current] = 1;
295	wakaba	1.1	for my $x ($x_current .. ($x_current + $colspan - 1)) {
296			for my $y ($y_current .. ($y_current + $rowspan - 1)) {
297			unless ($table->{cell}->[$x]->[$y]) {
298			$table->{cell}->[$x]->[$y] = [$cell];
299			} else {
300	wakaba	1.9	$onerror->(type => "cell overlapping:$x:$y", node => $current_cell,
301			level => $must_level);
302	wakaba	1.1	push @{$table->{cell}->[$x]->[$y]}, $cell;
303			}
304			}
305			}
306
307	wakaba	1.7	## Step 13
308	wakaba	1.1	if ($cell_grows_downward) {
309			push @downward_growing_cells, [$cell, $x_current, $colspan];
310			}
311
312	wakaba	1.7	## Step 14
313	wakaba	1.1	$x_current += $colspan;
314	wakaba	1.7
315			## Step 15-17
316			$current_cell = shift @tdth;
317			if (defined $current_cell) {
318			## Step 16-17
319			#
320			} else {
321			## Step 15
322			$y_current++;
323			last CELL;
324			}
325			} # CELL
326	wakaba	1.1	}; # $process_row
327
328	wakaba	1.9	$process_row_group = sub ($) {
329	wakaba	1.8	## Step 1
330			my $y_start = $y_height;
331
332			## Step 2
333			for (grep {
334			$_->node_type == 1 and
335			defined $_->namespace_uri and
336			$_->namespace_uri eq q<http://www.w3.org/1999/xhtml> and
337			$_->manakai_local_name eq 'tr'
338			} @{$_[0]->child_nodes}) {
339			$process_row->($_);
340			}
341
342			## Step 3
343			if ($y_height > $y_start) {
344			my $rg = {element => $current_element, ## ISSUE: "element being processed"?
345			x => 0, y => $y_start,
346			height => $y_height - $y_start};
347			$table->{row_group}->[$_] = $rg for $y_start .. $y_height - 1;
348			}
349
350			## Step 4
351			## Ending a row group
352			## Step 1
353			while ($y_current < $y_height) {
354			## Step 1
355			$growing_downward_growing_cells->();
356
357			## Step 2
358			$y_current++;
359			}
360	wakaba	1.9	## Step 2
361	wakaba	1.8	@downward_growing_cells = ();
362			}; # $process_row_group
363
364	wakaba	1.10	## Step 12: rows
365	wakaba	1.1	unshift @table_child, $current_element;
366			ROWS: {
367			NEXT_CHILD: {
368			$current_element = shift @table_child;
369			if (defined $current_element) {
370			redo NEXT_CHILD unless $current_element->node_type == 1;
371			my $nsuri = $current_element->namespace_uri;
372			redo NEXT_CHILD unless defined $nsuri and
373			$nsuri eq q<http://www.w3.org/1999/xhtml>;
374			$current_ln = $current_element->manakai_local_name;
375
376			redo NEXT_CHILD unless {
377			thead => 1,
378			tbody => 1,
379			tfoot => 1,
380			tr => 1,
381			}->{$current_ln};
382			} else {
383	wakaba	1.8	## Step 6 2nd paragraph
384	wakaba	1.9	$end->();
385			return $table;
386	wakaba	1.1	}
387			} # NEXT_CHILD
388
389	wakaba	1.10	## Step 13
390	wakaba	1.1	if ($current_ln eq 'tr') {
391			$process_row->($current_element);
392	wakaba	1.8	# advance (done at the first of ROWS)
393	wakaba	1.1	redo ROWS;
394			}
395
396	wakaba	1.10	## Step 14
397	wakaba	1.1	## Ending a row group
398			## Step 1
399	wakaba	1.7	while ($y_current < $y_height) {
400	wakaba	1.1	## Step 1
401	wakaba	1.9	$growing_downward_growing_cells->();
402
403			## Step 2
404	wakaba	1.1	$y_current++;
405			}
406	wakaba	1.9	## Step 2
407	wakaba	1.1	@downward_growing_cells = ();
408
409	wakaba	1.10	## Step 15
410	wakaba	1.8	if ($current_ln eq 'tfoot') {
411			push @$pending_tfoot, $current_element;
412			# advance (done at the top of ROWS)
413			redo ROWS;
414	wakaba	1.1	}
415
416	wakaba	1.10	## Step 16
417	wakaba	1.8	# thead or tbody
418			$process_row_group->($current_element);
419	wakaba	1.1
420	wakaba	1.10	## Step 17
421	wakaba	1.8	# Advance (done at the top of ROWS).
422	wakaba	1.1
423	wakaba	1.10	## Step 18
424	wakaba	1.8	redo ROWS;
425	wakaba	1.1	} # ROWS
426	wakaba	1.8
427	wakaba	1.9	$end->();
428	wakaba	1.8	return $table;
429	wakaba	1.1	} # form_table
430
431			## TODO: Implement scope="" algorithm
432
433			1;
434	wakaba	1.10	## $Date: 2008/05/05 08:00:25 $