[LON-CAPA-cvs] cvs: loncom /xml lontable.pm lontable.test
foxr
foxr@source.lon-capa.org
Tue, 09 Dec 2008 11:50:09 -0000
This is a MIME encoded message
--foxr1228823409
Content-Type: text/plain
foxr Tue Dec 9 11:50:09 2008 EDT
Modified files:
/loncom/xml lontable.pm lontable.test
Log:
Many more tests.. not 100% handling the spans correctly yet.
--foxr1228823409
Content-Type: text/plain
Content-Disposition: attachment; filename="foxr-20081209115009.txt"
Index: loncom/xml/lontable.pm
diff -u loncom/xml/lontable.pm:1.4 loncom/xml/lontable.pm:1.5
--- loncom/xml/lontable.pm:1.4 Tue Dec 2 11:57:25 2008
+++ loncom/xml/lontable.pm Tue Dec 9 11:50:08 2008
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Generating TeX tables.
#
-# $Id: lontable.pm,v 1.4 2008/12/02 11:57:25 foxr Exp $
+# $Id: lontable.pm,v 1.5 2008/12/09 11:50:08 foxr Exp $
#
#
# Copyright Michigan State University Board of Trustees
@@ -39,7 +39,7 @@
# This module is a support packkage that helps londefdef generate
# LaTeX tables using the LaTeX::Table package. A prerequisite is that
-# the print generator must have added the following to the LaTeX header:
+# the print generator must have added the following to the LaTeX
#
# \usepackage{xtab}
# \usepackage{booktabs}
@@ -278,9 +278,9 @@
my ($self, $new_value) = @_;
if (defined($new_value)) {
- $self->{alignment} = $new_value;
+ $self->{'alignment'} = $new_value;
}
- return $self->{alignment};
+ return $self->{'alignment'};
}
=pod
@@ -303,9 +303,9 @@
my ($self, $new_value) = @_;
if (defined($new_value)) {
- $self->{outer_border} = $new_value;
+ $self->{'outer_border'} = $new_value;
}
- return $self->{outer_border};
+ return $self->{'outer_border'};
}
@@ -329,9 +329,9 @@
my ($self, $new_value) = @_;
if (defined($new_value)) {
- $self->{inner_border} = $new_value;
+ $self->{'inner_border'} = $new_value;
}
- return $self->{inner_border};
+ return $self->{'inner_border'};
}
=pod
@@ -353,10 +353,10 @@
my ($self, $new_value) = @_;
if (defined($new_value)) {
- $self->{caption} = $new_value;
+ $self->{'caption'} = $new_value;
}
- return $self->{caption};
+ return $self->{'caption'};
}
=pod
@@ -378,9 +378,9 @@
my ($self, $new_value) = @_;
if (defined($new_value)) {
- $self->{theme} = $new_value;
+ $self->{'theme'} = $new_value;
}
- return $self->{theme};
+ return $self->{'theme'};
}
=pod
@@ -412,9 +412,9 @@
=cut
sub start_row {
- my ($self, %config) = @_;
+ my ($self, $config) = @_;
- if ($self->{row_open}) {
+ if ($self->{'row_open'}) {
$self->end_row();
}
my $row_hash = {
@@ -425,16 +425,17 @@
# Override the defaults if the config hash is present:
- if (defined(%config)) {
- foreach my $key (keys %config) {
- $row_hash->{$key} = $config{$key};
+ if (defined($config)) {
+ foreach my $key (keys %$config) {
+ $row_hash->{$key} = $config->{$key};
}
}
+
- my $rows = $self->{rows};
+ my $rows = $self->{'rows'};
push(@$rows, $row_hash);
- $self->{row_open} = 1; # Row is now open and ready for business.
+ $self->{"row_open"} = 1; # Row is now open and ready for business.
}
=pod
@@ -453,13 +454,13 @@
sub end_row {
my ($self) = @_;
- if ($self->{row_open}) {
+ if ($self->{'row_open'}) {
# Mostly we need to determine if this row has the maximum
# cell count of any row in existence in the table:
- my $row = $self->{rows}[-1];
- my $cells = $row->{cells};
+ my $row = $self->{'rows'}[-1];
+ my $cells = $row->{'cells'};
my $raw_cell_count = scalar(@$cells);
# Need to iterate through the columns as
@@ -467,13 +468,13 @@
#
my $cell_count = 0;
for (my $i =0; $i < $raw_cell_count; $i++) {
- $cell_count = $cell_count + $cells->[$i]->{colspan};
+ $cell_count = $cell_count + $cells->[$i]->{'colspan'};
}
- if ($cell_count > $self->{column_count}) {
- $self->{column_count} = $cell_count;
+ if ($cell_count > $self->{'column_count'}) {
+ $self->{'column_count'} = $cell_count;
}
- $self->{row_open} = 0;;
+ $self->{'row_open'} = 0;;
}
}
@@ -509,11 +510,11 @@
sub configure_row {
my ($self, $config) = @_;
- if (!$self->{row_open}) {
+ if (!$self->{'row_open'}) {
$self->start_row();
}
- my $row = $self->{rows}[-1];
+ my $row = $self->{'rows'}[-1];
foreach my $config_item (keys %$config) {
$row->{$config_item} = $config->{$config_item};
}
@@ -568,12 +569,12 @@
# If a row is not open, we must open it:
- if (!$self->{row_open}) {
+ if (!$self->{'row_open'}) {
$self->start_row();
}
- my $current_row = $self->{rows}->[-1];
- my $current_cells = $current_row->{cells};
+ my $current_row = $self->{'rows'}->[-1];
+ my $current_cells = $current_row->{'cells'};
# The way we handle row spans is to insert additional
# blank cells as needed to reach this column. Each
@@ -582,18 +583,25 @@
# and handled when the table's LaTeX is generated.
# There must be at least two rows in the row table to need to do this:
- my $row_count = scalar(@$self->{rows});
+ my $rows = $self->{'rows'};
+ my $row_count = scalar(@$rows);
if ($row_count > 1) {
- my $prior_row = $self->{rows}->[-2];
- my $curr_colcount = scaler(@$current_row->{cells});
- my $prior_colcount = scaler(@$prior_row->{cells});
+ my $prior_row = $rows->[-2];
+ my $cells = $current_row->{'cells'};
+ my $prior_cells = $prior_row->{'cells'};
+ my $curr_colcount = scalar(@$cells);
+
+ my $prior_colcount = scalar(@$prior_cells);
while (($curr_colcount < $prior_colcount) &&
- $prior_row->{cells}->[$curr_colcount]->{rowspan} > 1) {
- my %cell = $prior_row->{cells}->[$curr_colcount];
- %cell->{rowspan}--;
- %cell->{contents} = "";
+ $prior_cells->[$curr_colcount]->{'rowspan'} > 1) {
+ my %cell;
+ my $prior_cell = $prior_cells->[$curr_colcount];
+ %cell = %$prior_cell;
+ $cell{'rowspan'}--;
+ $cell{'contents'} = "";
push(@$current_cells, \%cell);
+ $curr_colcount += $prior_cells->[$curr_colcount]->{'colspan'}; # could be a colspan too.
}
}
#
@@ -613,7 +621,7 @@
push(@$current_cells, $cell);
}
-# The following method allows for testability.
+# The following methods allow for testability.
sub get_object_attribute {
@@ -621,7 +629,11 @@
return $self->{$attribute};
}
-
+sub get_row {
+ my ($self, $row) = @_;
+ my $rows = $self->{'rows'}; # ref to an array....
+ return $rows->[$row]; # ref to the row hash for the selected row.
+}
# Mandatory initialization.
BEGIN{
}
Index: loncom/xml/lontable.test
diff -u loncom/xml/lontable.test:1.1 loncom/xml/lontable.test:1.2
--- loncom/xml/lontable.test:1.1 Tue Dec 2 11:57:25 2008
+++ loncom/xml/lontable.test Tue Dec 9 11:50:08 2008
@@ -3,7 +3,7 @@
# The LearningOnline Network with CAPA
# Generating TeX tables.
#
-# $Id: lontable.test,v 1.1 2008/12/02 11:57:25 foxr Exp $
+# $Id: lontable.test,v 1.2 2008/12/09 11:50:08 foxr Exp $
#
#
# Copyright Michigan State University Board of Trustees
@@ -52,7 +52,7 @@
use strict;
use lontable;
-use Test::More tests=>18;
+use Test::More tests=>88;
#------------------- Default Construction tests: ---------------------------------
# Tests the getter forms of the configuration methods too:
@@ -74,7 +74,7 @@
#--------------- Configured construction tests -----------------------------------
#
-my $testobject = new Apache::lontable({alignment => 'right',
+$testobject = new Apache::lontable({alignment => 'right',
outer_border => 1,
inner_border => 1,
caption => 'Test caption',
@@ -92,6 +92,8 @@
# Table of methods to test...
+$testobject = new Apache::lontable();
+
my @configmethods = ('alignment', 'table_border', 'cell_border', 'caption', 'theme');
# Table of parameters for each method and expected results from the getter
@@ -104,3 +106,211 @@
ok($testobject->$method() eq $values[$i], "Global Config: Testing $method as a setter");
$i++;
}
+
+#--------------- Test row management --------------------------------------
+
+# start row adds a row to the table; in default config unless overridden.
+
+$testobject = new Apache::lontable();
+
+$testobject->start_row(); # Unconfigured row.
+ok($testobject->get_object_attribute('row_open') == 1, "One row added");
+$rows = $testobject->get_object_attribute('rows');
+ok(scalar(@$rows) == 1, ' only one row');
+my $row = $rows->[0];
+my $cells = $row->{'cells'};
+ok($row->{'default_halign'} eq 'left', "default row halign");
+ok($row->{'default_valign'} eq 'top', 'default row valign');
+ok(scalar(@$cells) == 0, 'Initial cell count');
+
+# Start row with row open makes a second row:
+
+$testobject->start_row();
+ok($testobject->get_object_attribute('row_open') == 1, "Two rows.. still open");
+$rows = $testobject->get_object_attribute('rows');
+ok(scalar(@$rows) == 2, 'two rows now');
+
+# Creating row with configuration:
+
+$testobject->start_row({'default_halign' => "center",
+ 'default_valign' => 'bottom'});
+$rows = $testobject->get_object_attribute('rows');
+$row = $rows->[-1]; # Last row should be configured:
+ok($row->{'default_halign'} eq 'center', "Overridden horiz align");
+ok($row->{'default_valign'} eq 'bottom', 'Overridden vert. align');
+
+# end row says no row is open..we'll need to look at it again when we
+# start adding cells, as it also manages the max cell count.
+
+$testobject->end_row();
+ok($testobject->get_object_attribute('row_open') == 0, "Row closed");
+
+
+#-------------------- Cell management -------------------------------
+
+$testobject = new Apache::lontable();
+$testobject->start_row();
+$testobject->add_cell("cell 0");
+$testobject->add_cell("cell 1");
+$testobject->end_row();
+
+# At this point we should have one row (that's already been tested).
+# we should have max cell count of 2
+# we should be able to see the cells we added with default values.
+
+ok($testobject->get_object_attribute('column_count') == 2, 'max cells ok');
+$rows = $testobject->get_object_attribute('rows');
+$row = $rows->[0];
+my $cols = $row->{'cells'}; # Reference to cell array
+ok(scalar(@$cols) == 2, ' correct cell count');
+my $cell = $cols->[0];
+ok($cell->{'contents'} eq 'cell 0', 'Correct cell 0 contents');
+ok($cell->{'rowspan'} == 1, 'Correct cell 0 rowspan');
+ok($cell->{'colspan'} == 1, 'Correct cell 0 colspan');
+$cell = $cols->[1];
+ok($cell->{'contents'} eq 'cell 1', 'correct cell 1 contents');
+ok($cell->{'rowspan'} == 1, 'correct cell 1 rowspan');
+ok($cell->{'colspan'} == 1, 'correct cell 1 column span');
+
+# Add a second row that has 3 columns and some rowspans.
+# - column_count -> 3
+# - the cells should have the correct rowspans/colspans.
+
+$testobject->start_row();
+$testobject->add_cell("row2 cell 0",
+ {'rowspan' => 2});
+$testobject->add_cell('row2 cell 1',
+ {'rowspan' => 3});
+$testobject->add_cell('row 2 cell 3');
+$testobject->end_row();
+
+$row = $rows->[1];
+$cols = $row->{'cells'};
+ok(scalar(@$cols) == 3, 'correct columnm count');
+ok($testobject->get_object_attribute('column_count') == 3, 'max cols ok');
+
+$cell = $cols->[0];
+ok($cell->{'contents'} eq 'row2 cell 0', 'Contents 2,0');
+ok($cell->{'rowspan'} == 2, 'rowspand 2,0');
+ok($cell->{'colspan'} == 1, 'colspan 2,0');
+
+$cell = $cols->[1];
+ok($cell->{'contents'} eq 'row2 cell 1', 'Contents 2,1');
+ok($cell->{'rowspan'} == 3, 'rowspand 2,1');
+ok($cell->{'colspan'} == 1, 'colspan 2,2');
+
+$cell = $cols->[2];
+ok($cell->{'contents'} eq 'row 2 cell 3', "Contents 2,2");
+ok($cell->{'rowspan'} == 1, "Rowspan 2,2");
+ok($cell->{'colspan'} == 1, 'Colspan 2,2');
+
+#--------------------------- Test colspans with row spans. ----------------------
+#
+# Make a table that looks like:
+#
+# +-------------------------+---------------------+
+# | Spans 2 cols, 3 rows| spans 2 cols 1 row |
+# | +-----------+---------+
+# | | span 1,1 | span 1 1|
+# | +-----------+---------+
+# | |2rows 1col | span 1 1|
+# +----------+--------------+ +---------+
+# | Span 1 1 | span 1 1 | |span 1 1 |
+# +----------+---------+----+-----------+---------+
+
+
+$testobject = new Apache::lontable();
+
+$testobject->start_row();
+$testobject->add_cell('2 cols 3 rows', {rowspan => 3, colspan => 2});
+$testobject->add_cell('2 cols 1 row', {colspan => 2});
+$testobject->end_row();
+
+$testobject->start_row();
+$testobject->add_cell('ordinary cell');
+$testobject->add_cell('ordinary cell');
+$testobject->end_row();
+
+$testobject->start_row();
+$testobject->add_cell('2 rows 1 col', {rowspan => 2});
+$testobject->add_cell('ordinary cell');
+$testobject->end_row();
+
+$testobject->start_row();
+$testobject->add_cell('ordinary cell');
+$testobject->add_cell('ordinary cell');
+$testobject->add_cell('ordinary cell');
+$testobject->end_row();
+
+# First of all the table should have figured out tere are 4 cols and 4 rows:
+
+ok($testobject->get_object_attribute('column_count') == 4, 'col count with spans');
+
+# First row should be trivial 2 cells with the spans described.
+
+my $row = $testobject->get_row(0);
+my $cells = $row->{'cells'}; # Refs an array of cells.
+ok(scalar(@$cells) == 2, ' 2 cell hashes in the row 0');
+ok($cells->[0]->{'rowspan'} == 3, '1,1 rowspan');
+ok($cells->[0]->{'colspan'} == 2, '1,1 colspan');
+ok($cells->[0]->{'contents'} eq '2 cols 3 rows', '1,1 contents');
+ok($cells->[1]->{'rowspan'} == 1, '1 2 rowspan');
+ok($cells->[1]->{'colspan'} == 2, '1 2 colspan');
+ok($cells->[1]->{'contents'} eq '2 cols 1 row', '1 2 contents');
+
+# Second row, the first cell should carry down an empty cell from the row
+# above it (first cell), same colspan, rowspan of 2 now, then there should
+# be two ordinary cells:
+
+$row = $testobject->get_row(1);
+$cells = $row->{'cells'};
+ok(scalar(@$cells) == 3, ' 3 cell hashes in row 1');
+ok($cells->[0]->{'rowspan'} == 2, '2,1 rowspan carried from above');
+ok($cells->[0]->{'colspan'} == 2, '2,1 colspan carried from above');
+ok($cells->[0]->{'contents'} eq '', '2,1 should be empty');
+ok($cells->[1]->{'rowspan'} == 1, '2,2 rowspan');
+ok($cells->[1]->{'colspan'} == 1, '2,2 colspan');
+ok($cells->[1]->{'contents'} eq 'ordinary cell', '2,2 contents');
+ok($cells->[2]->{'rowspan'} == 1, '2,3 rowspan');
+ok($cells->[2]->{'colspan'} == 1, '2,3 colspan');
+ok($cells->[2]->{'contents'} eq 'ordinary cell','2,3 contents');
+
+# 3'd row. Shoould look a lot like the second row, but the second cell
+# has a rowspan of 2.
+
+$row = $testobject->get_row(2);
+$cells = $row->{'cells'};
+ok(scalar(@$cells) == 3, '3 cell hashes in row 3');
+ok($cells->[0]->{'rowspan'} == 1, '3,1 rowspan carried from above, down -> 1');
+ok($cells->[0]->{'colspan'} == 2, '3,1 colspan carried from above.');
+ok($cells->[0]->{'contents'} eq "" , '3,1 contetns empty');
+
+ok($cells->[1]->{'rowspan'} == 2, '3,2, rowspan');
+ok($cells->[1]->{'colspan'} == 1, '3,2 colspan');
+ok($cells->[1]->{'contents'} eq '2 rows 1 col', '3,2 contents');
+
+ok($cells->[2]->{'rowspan'} == 1, '3,3 rowspan');
+ok($cells->[2]->{'colspan'} == 1, '3,3 colspan');
+ok($cells->[2]->{'contents'} eq 'ordinary cell', '3,3 contents');
+
+# last row, should have cell 3 carried down from above. all other cells
+# are ordinary.
+
+$row = $testobject->get_row(3);
+$cells = $row->{'cells'};
+ok(scalar(@$cells) == 4, '4 cell hashes in row 4');
+ok($cells->[0]->{'rowspan'} == 1, "4,1 rowsspan");
+ok($cells->[0]->{'colspan'} == 1, "4,1 colspan");
+ok($cells->[0]->{'contents'} eq 'ordinary cell', '4,1 contents');
+
+ok($cells->[1]->{'rowspan'} == 1, '4,2 rowspan');
+ok($cells->[1]->{'colspan'} == 1, '4,2 colspan');
+ok($cells->[1]->{'contents'} eq 'ordinary cell', '4,2, contents');
+
+ok($cells->[2]->{'rowspan'} == 1, "4,3 rowspan carried down");
+ok($cells->[2]->{'colspan'} == 1, '4,3 colspan carried down');
+ok($cells->[2]->{'contents'} eq '', '4,3 contents empty');
+
+ok($cells->[3]->{'rowspan'} == 1, "4,4 rowspan");
+ok($cells->[3]->{'colspan'} == 2, '4,4 colspan');
+ok($cells->[3]->{'contents'} eq 'ordinary cell', '4,4 contents');
--foxr1228823409--