[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--