From: Sven Dowideit <svendowid...@fosiki.com> --- AnyData.pm | 47 +++++++++++++++++++++++++---------------------- MANIFEST | 7 ++++--- t/01distributtion.t | 7 +++++-- t/01pod_snippets.t | 10 ++++++++++ t/fixed.t | 15 ++++++++------- t/fixed.tbl | 8 +------- t/test.t | 47 +++++++++++++++++++++++------------------------ 7 files changed, 76 insertions(+), 65 deletions(-) create mode 100644 t/01pod_snippets.t
diff --git a/AnyData.pm b/AnyData.pm index 2182c15..dd350c7 100644 --- a/AnyData.pm +++ b/AnyData.pm @@ -822,7 +822,8 @@ AnyData - easy access to data in many formats =head1 SYNOPSIS - $table = adTie( 'CSV','my_db.csv','o', # create a table + use AnyData; + my $table = adTie( 'CSV','my_db.csv','o', # create a table {col_names=>'name,country,sex'} ); $table->{Sue} = {country=>'de',sex=>'f'}; # insert a row @@ -831,7 +832,7 @@ AnyData - easy access to data in many formats while ( my $row = each %$table ) { # loop through table print $row->{name} if $row->{sex} eq 'f'; } - $rows = $table->{{age=>'> 25'}} # select multiple rows + $rows = $table->{{age=>'> 25'}}; # select multiple rows delete $table->{{country=>qr/us|mx|ca/}}; # delete multiple rows $table->{{country=>'Nz'}}={country=>'nz'}; # update multiple rows my $num = adRows( $table, age=>'< 25' ); # count matching rows @@ -843,9 +844,8 @@ AnyData - easy access to data in many formats print adDump($table); # dump table to screen undef $table; # close the table - adConvert( $format1, $file1, $format2, $file2 ); # convert btwn formats - print adConvert( $format1, $file1, $format2 ); # convert to screen - + #adConvert( $format1, $file1, $format2, $file2 ); # convert btwn formats + #print adConvert( $format1, $file1, $format2 ); # convert to screen =head1 DESCRIPTION @@ -883,7 +883,9 @@ DBI, DBD::AnyData, SQL::Statement and DBD::File installed. =head1 USAGE - The AnyData module imports eight methods (functions): +The AnyData module imports eight methods (functions): + +=for test ignore adTie() -- create a new table or open an existing table adExport() -- save an existing table in a specified format @@ -894,14 +896,14 @@ DBI, DBD::AnyData, SQL::Statement and DBD::File installed. adDump() -- display the data formatted as an array of rows adColumn() -- group values in a single column - The adTie() command returns a special tied hash. The tied hash can - then be used to access and/or modify data. See below for details +The adTie() command returns a special tied hash. The tied hash can +then be used to access and/or modify data. See below for details - With the exception of the XML, HTMLtable, and ARRAY formats, the - adTie() command saves all modifications of the data directly to file - as they are made. With XML and HTMLtable, you must make your - modifications in memory and then explicitly save them to file with - adExport(). +With the exception of the XML, HTMLtable, and ARRAY formats, the +adTie() command saves all modifications of the data directly to file +as they are made. With XML and HTMLtable, you must make your +modifications in memory and then explicitly save them to file with +adExport(). =head2 adTie() @@ -911,22 +913,23 @@ The adTie() command creates a reference to a multi-dimensional tied hash. In its my $table = adTie( $format, $file ); - $format is the name of any supported format 'CSV','Fixed','Passwd', etc. - $file is the name of a relative or absolute path to a local file +$format is the name of any supported format 'CSV','Fixed','Passwd', etc. +$file is the name of a relative or absolute path to a local file - e.g. my $table = adTie( 'CSV', '/usr/me/myfile.csv' ); +e.g. + my $table = adTie( 'CSV', '/usr/me/myfile.csv' ); - this creates a tied hash called $table by reading data in the - CSV (comma separated values) format from the file 'myfile.csv'. +this creates a tied hash called $table by reading data in the +CSV (comma separated values) format from the file 'myfile.csv'. The hash reference resulting from adTie() can be accessed and modified as follows: use AnyData; my $table = adTie( $format, $file ); - $table->{$key}->{$column} # select a value - $table->{$key} = {$col1=>$val1,$col2=>$val2...} # update a row - delete $table->{$key} # delete a row - while(my $row = each %$table) { # loop through rows + $table->{$key}->{$column}; # select a value + $table->{$key} = {$col1=>$val1,$col2=>$val2...}; # update a row + delete $table->{$key}; # delete a row + while(my $row = each %$table) { # loop through rows print $row->{$col1} if $row->{$col2} ne 'baz'; } diff --git a/MANIFEST b/MANIFEST index 7a52d0c..7224983 100644 --- a/MANIFEST +++ b/MANIFEST @@ -22,10 +22,11 @@ AnyData/Storage/FileSys.pm AnyData/Storage/PassThru.pm AnyData/Storage/RAM.pm AnyData/Storage/TiedHash.pm +t/01distributtion.t +t/01pod_snippets.t t/pod.t t/test.t -t/fixed.t t/fixed.tbl - - +t/spelling.t +t/fixed.t diff --git a/t/01distributtion.t b/t/01distributtion.t index a6963b8..9c0bab9 100644 --- a/t/01distributtion.t +++ b/t/01distributtion.t @@ -1,14 +1,17 @@ use Test::More; BEGIN { + eval { require Test::Distribution; }; if ($@) { plan skip_all => 'Test::Distribution not installed'; } else { -#TODO: work to fix these -# import Test::Distribution only => [ qw/use description sig versions use prereq pod podcoverage/ ]; + #TODO: work to fix these + import Test::Distribution + only => [qw/description/], + not => [qw/use sig versions use prereq pod podcoverage/]; } } diff --git a/t/01pod_snippets.t b/t/01pod_snippets.t new file mode 100644 index 0000000..cea3cec --- /dev/null +++ b/t/01pod_snippets.t @@ -0,0 +1,10 @@ +use Test::More; +plan skip_all => 'Need to do more work fixing pod code snippets'; + +my @modules = qw/ AnyData /; +plan tests => 3; + +use Test::Pod::Snippets; +my $tps = Test::Pod::Snippets->new; + +$tps->runtest( module => $_, testgroup => 1 ) for @modules; diff --git a/t/fixed.t b/t/fixed.t index f2bd342..310461e 100644 --- a/t/fixed.t +++ b/t/fixed.t @@ -7,16 +7,17 @@ plan tests => 6; use AnyData; - my $table = adTie( 'Fixed', 't/fixed.tbl', 'r', {pattern=>'A11 A2'} ); +my $table = adTie( 'Fixed', 't/fixed.tbl', 'r', { pattern => 'A11 A2' } ); - ok(6 == adRows($table), "Failed rows"); - ok('au' eq $table->{'australia'}->{code}, 'select one'); - ok('ch' eq $table->{'switzerland'}->{code}, 'select another'); - ok('0' eq $table->{'broken'}->{code}, 'select another'); - ok(' 0' eq $table->{'broken2'}->{code}, 'select another'); +ok( 6 == adRows($table), "Failed rows" ); +ok( 'au' eq $table->{'australia'}->{code}, 'select one' ); +ok( 'ch' eq $table->{'switzerland'}->{code}, 'select another' ); +ok( '0' eq $table->{'broken'}->{code}, 'select another' ); +ok( ' 0' eq $table->{'broken2'}->{code}, 'select another' ); #write test - ok(<<'HERE' eq adExport($table, 'Fixed', undef, {pattern=>'A11 A2'}), 'export fixed format'); +ok( + <<'HERE' eq adExport( $table, 'Fixed', undef, { pattern => 'A11 A2' } ), 'export fixed format' ); country co australia au germany de diff --git a/t/fixed.tbl b/t/fixed.tbl index 02ffb63..aeac94d 100644 --- a/t/fixed.tbl +++ b/t/fixed.tbl @@ -1,7 +1 @@ -country,code -australia au -germany de -france fr -switzerlandch -broken 0 -broken2 0 +country, code australia au germany de france fr switzerlandch broken 0 broken2 0 diff --git a/t/test.t b/t/test.t index a860f48..966730c 100755 --- a/t/test.t +++ b/t/test.t @@ -7,40 +7,39 @@ use warnings; my @formats = qw(CSV Pipe Tab Fixed Paragraph ARRAY); use Test::More; -plan tests => (1+$#formats) * 6; +plan tests => ( 1 + $#formats ) * 6; use AnyData; - -for my $format( @formats ) { - test_ad($format); +for my $format (@formats) { + test_ad($format); } sub test_ad { - my $file = []; + my $file = []; my $format = shift; - my $mode = 'o'; - my $flags = {cols=>'name,country,sex',pattern=>'A5 A8 A3'}; - my $table = adTie( $format,$file, $mode, $flags ); # create a table - $table->{Sue} = {country=>'fr',sex=>'f'}; # insert rows - $table->{Tom} = {country=>'fr',sex=>'f'}; - $table->{Bev} = {country=>'en',sex=>'f'}; - $table->{Nel} = {country=>'en',sex=>'f'}; - $table->{Pam} = {country=>'au',sex=>'f'}; - $table->{{ name=>'Tom'}} = {sex=>'m'}; # update a row - delete $table->{Bev}; # delete a row - $flags = {pattern=>'A5 A8 A3'}; - ok('f' eq $table->{Sue}->{sex}, "Failed single select"); + my $mode = 'o'; + my $flags = { cols => 'name,country,sex', pattern => 'A5 A8 A3' }; + my $table = adTie( $format, $file, $mode, $flags ); # create a table + $table->{Sue} = { country => 'fr', sex => 'f' }; # insert rows + $table->{Tom} = { country => 'fr', sex => 'f' }; + $table->{Bev} = { country => 'en', sex => 'f' }; + $table->{Nel} = { country => 'en', sex => 'f' }; + $table->{Pam} = { country => 'au', sex => 'f' }; + $table->{ { name => 'Tom' } } = { sex => 'm' }; # update a row + delete $table->{Bev}; # delete a row + $flags = { pattern => 'A5 A8 A3' }; + ok( 'f' eq $table->{Sue}->{sex}, "Failed single select" ); my $tstr; - while ( my $person = each %$table ) { # select mulitple rows + + while ( my $person = each %$table ) { # select mulitple rows $tstr .= $person->{name} if $person->{country} eq 'fr'; } - ok('SueTom' eq $tstr, "Failed multiple select"); - ok('namecountrysex' eq join('',adNames($table)), "Failed names"); - ok(4 == adRows($table), "Failed rows"); - ok(4 == adColumn($table, 'country'), "total number of rows"); - ok(3 == adColumn($table, 'country', 1), "distinct countries"); + ok( 'SueTom' eq $tstr, "Failed multiple select" ); + ok( 'namecountrysex' eq join( '', adNames($table) ), "Failed names" ); + ok( 4 == adRows($table), "Failed rows" ); + ok( 4 == adColumn( $table, 'country' ), "total number of rows" ); + ok( 3 == adColumn( $table, 'country', 1 ), "distinct countries" ); } - __END__ -- 1.7.10.4