package tests::ReportGroupTest; use strict; use base qw/Lire::Test::TestCase/; use Lire::Report::Group; use Lire::Report::TableInfo; sub set_up { my $self = shift->SUPER::set_up(); $self->set_up_nested2_info(); return $self; } sub tear_down { my $self = shift->SUPER::tear_down(); return $self; } sub set_up_nested2_info { my $self = $_[0]; my $table_info = new Lire::Report::TableInfo(); $table_info->create_column_info( 'cell1', 'categorical', 'string' ); my $group_info1 = $table_info->create_group_info( 'nested1' ); $group_info1->create_column_info( 'cell2', 'categorical', 'string' ); $group_info1->create_column_info( 'cell3', 'numerical', 'int' ); my $group_info2 = $table_info->create_group_info( 'nested2' ); $group_info2->create_column_info( 'cell4', 'categorical', 'string' ); $group_info2->create_column_info( 'cell5', 'numerical', 'int' ); $self->{'nested2_info'} = $table_info; return; } sub set_up_group { my $self = $_[0]; my $top = new Lire::Report::Group( bless( {}, "Lire::Report::Entry" ), $self->{'nested2_info'} ); # cell1, cell2, $cell3, $cell4, $cell5 my $report_data = [ [ '1x1', [[ '1x21', 131 ], [ "1x22", 132 ]], [[ '1x41', 151]]], [ '2x1', [[ '2x21', 231]], [[ '2x41', 251 ], [ '2x42', 252 ]]], [ '3x1', [[ '3x21', 331], [ '3x22', 332]], [[ '3x41', 351 ], [ '3x42', 352 ]]], ]; $self->{'entry_dlf_keys'} = {}; $self->{'entries'} = {}; foreach my $row ( @$report_data ) { my $dlf_t = {}; my $entry = $top->create_entry(); $dlf_t->{ 'cell1'} = $row->[0]; $entry->add_name( $row->[0] ); $self->{'entry_dlf_keys'}{$row->[0]} = {%$dlf_t}; $self->{'entries'}{$row->[0]} = $entry; my $nested1 = $entry->create_group(); foreach my $n1 ( @{$row->[1]} ) { my $e = $nested1->create_entry(); $dlf_t->{ 'cell2'} = $n1->[0]; $dlf_t->{ 'cell3'} = $n1->[1]; $self->{'entry_dlf_keys'}{$n1->[0]} = {%$dlf_t}; $self->{'entries'}{$n1->[0]} = $e; $e->add_name( 'Cell ' . $n1->[0], $n1->[0] ); $e->add_value( 'value' => $n1->[1], 'content' => $n1->[0] ); } my $nested2 = $entry->create_group(); foreach my $n2 ( @{$row->[2]} ) { my $e = $nested2->create_entry(); $dlf_t->{ 'cell4'} = $n2->[0]; $dlf_t->{ 'cell5'} = $n2->[1]; $self->{'entry_dlf_keys'}{$n2->[0]} = {%$dlf_t}; $self->{'entries'}{$n2->[0]} = $e; $e->add_name( 'Cell ' . $n2->[0], $n2->[0] ); $e->add_value( 'value' => $n2->[1], 'content' => $n2->[0] ); } } $self->{'group'} = $top; return; } sub test_assign_row_indices { my $self = $_[0]; my $table_info = $self->{'nested2_info'}; my $group = new Lire::Report::Group( bless( {}, 'Lire::Report::Entry' ), $table_info ); foreach my $row ( 1 .. 10) { my $entry = $group->create_entry(); $entry->add_name( "row$row" ); my $group1 = $entry->create_group(); $group1->show( 2 ); my $group2 = $entry->create_group(); foreach my $gidx ( 1..5 ) { my $n_entry1 = $group1->create_entry(); $n_entry1->add_name( 'row' . $row . 'group1-' . $gidx ); $n_entry1->add_value( 'content' => 10 ); my $n_entry2 = $group2->create_entry(); $n_entry2->add_name( 'row' . $row . 'group2-' . $gidx ); $n_entry2->add_value( 'content' => 5 ); } } my $idx = $group->assign_row_indices( 1 ); $self->assert_equals( 1, $group->row_idx() ); $self->assert_equals( 61, $idx ); my $row_idx = 2; foreach my $entry ( $group->entries() ) { $self->assert_equals( $row_idx, $entry->row_idx() ); $self->assert_equals( $row_idx, $entry->data_by_name( 'nested1')->row_idx() ); my @subentries = $entry->data_by_name( 'nested1')->entries(); $self->assert_equals( $row_idx + 1, $subentries[0]->row_idx() ); $self->assert_equals( $row_idx + 2, $subentries[1]->row_idx() ); foreach my $idx ( 2 .. 4) { $self->assert_null( $subentries[$idx]->row_idx(), "row_idx() should return undef" ); } my $offset = 1; $self->assert_equals( $row_idx, $entry->data_by_name( 'nested2')->row_idx() ); foreach my $sub ( $entry->data_by_name( 'nested2')->entries() ) { $self->assert_equals( $row_idx + $offset++, $sub->row_idx() ); } $row_idx += $offset; } return; } sub test_compute_column_info_stats { my $self = $_[0]; my $table_info = new Lire::Report::TableInfo(); $table_info->create_column_info( 'cell1', 'categorical', 'string', "Length0000000016" ); my $group_info1 = $table_info->create_group_info( 'nested1' ); $group_info1->create_column_info( 'cell2', 'categorical', 'string', 'Length0010' ); $group_info1->create_column_info( 'cell3', 'numerical', 'int', 'Length7'); my $subreport = new Lire::Report::Group( bless( {}, 'Lire::Report::Entry' ), $table_info ); $subreport->show( 2 ); $subreport->set_summary_value( 'cell3', 'content' => 'Length7', value => 0 ); foreach ( 1..10 ) { my $e = $subreport->create_entry(); $e->add_name( 'Len4' ); my $group = $e->create_group(); $group->set_summary_value( 'cell3', 'content' => 'Length000012', 'value' => 0 ); foreach ( 1..5) { my $sub = $group->create_entry(); $sub->add_name( 'Length7' ); $sub->add_value( 'content' => 'Length7', value => 0 ); } } $subreport->assign_row_indices( -1 ); $subreport->compute_column_info_stats(); $self->assert_equals( 16, $subreport->group_info()->column_info_by_name( 'cell1' )->max_chars() ); $self->assert_equals( 8, $subreport->group_info()->column_info_by_name( 'cell1' )->avg_chars() ); $self->assert_equals( 10, $subreport->group_info()->column_info_by_name( 'cell2' )->max_chars() ); $self->assert_equals( 8, $subreport->group_info()->column_info_by_name( 'cell2' )->avg_chars() ); $self->assert_equals( 12, $subreport->group_info()->column_info_by_name( 'cell3' )->max_chars() ); $self->assert_equals( 8, $subreport->group_info()->column_info_by_name( 'cell3' )->avg_chars() ); return; } sub test_new { my $self = $_[0]; my $entry = bless {}, 'Lire::Report::Entry'; my $info = new Lire::Report::TableInfo(); $self->assert_died( sub { new Lire::Report::Group() }, qr/missing \'entry\' parameter/); $self->assert_died( sub { new Lire::Report::Group( {}, $info ) }, qr/\'entry\' parameter should be a \'Lire::Report::Entry\' instance, not \'HASH/ ); $self->assert_died( sub { new Lire::Report::Group( $entry ) }, qr/missing \'group_info\' parameter/ ); $self->assert_died( sub { new Lire::Report::Group( $entry, {} ) }, qr/\'group_info\' parameter should be a \'Lire::Report::GroupInfo\' instance, not \'HASH/ ); my $group = new Lire::Report::Group( $entry, $info ); $self->assert_not_null( $group, 'new() returned undef' ); $self->assert_isa( 'Lire::Report::Group', $group ); $self->assert_equals( 'group', $group->{'type'} ); $self->assert_deep_equals( [], $group->{'entries'} ); $self->assert_deep_equals( {}, $group->{'summary'} ); $self->assert_equals( 0, $group->{'nrecords'} ); $self->assert_equals( 0, $group->{'missing_cases'} ); $self->assert_null( $group->{'show'}, "'show' attribute should be undef" ); $self->assert_equals( $entry, $group->{'parent_entry'} ); $self->assert_equals( $info, $group->{'group_info'} ); $self->assert_null( $group->{'row_idx'}, "'row_idx' attribute should be undef" ); return; } sub test_create_entry { my $self = $_[0]; my $group = new Lire::Report::Group( bless( {}, 'Lire::Report::Entry' ), new Lire::Report::TableInfo ); my $entry = $group->create_entry(); $self->assert_not_null( $entry, "create_entry() returned undef" ); $self->assert( UNIVERSAL::isa( $entry, 'Lire::Report::Entry'), "create_entry() should return an instance of Lire::Report::Entry: $entry" ); $self->assert_deep_equals( [ $entry ], $group->{'entries'} ); my $entry2 = $group->create_entry(); $self->assert_deep_equals( [ $entry, $entry2 ], $group->{'entries'} ); return; } sub test_find_entry { my $self = $_[0]; $self->set_up_group(); my $group = $self->{'group'}; $self->assert_null( $self->{'group'}->find_entry( {} ), "find_entry() should return undef"); $self->assert_null( $self->{'group'}->find_entry( { 'cell1' => 'blah' } ), "find_entry() should return undef"); foreach my $key ( keys %{$self->{'entry_dlf_keys'}}) { my $dlf_key = $self->{'entry_dlf_keys'}{$key}; my $e_entry = $self->{'entries'}{$key}; my $name = $e_entry->group_info()->name(); my $entry = $group->find_entry( $name, $dlf_key ); $self->assert_not_null( $entry, sprintf( "find_entry( '$name', '$key' ) with dlf cell1=%s, cell2=%s, cell4=%s returned undef", map { defined $_ ? $_ : 'undef' } @{$dlf_key}{'cell1','cell2','cell4'} )); $self->assert_equals( $e_entry, $entry ); } return; } 1;