# $Source: /home/aplonis/CPAN/Text-CSV-Munge/lib/Text/CSV/Munge/t/Test.pm $ # $Date: 2006-08-23 $ package Text::CSV::Munge::Test; use strict; use warnings; use Carp qw(carp croak); use Math::Trig; use English qw(-no_match_vars); use Text::CSV::Munge; our ($VERSION) = '$Revision: 0.01 $' =~ m{ \$Revision: \s+ (\S+) }xm; my $LSB = 0x1; my $EMPTY = q{}; # For author's use when testing on different OS environs. # while (my ($key,$val) = each %ENV) { print "$key = $val \n"} # Select an user's own home space to write test files into. # Must untaint that path as apporiate for whicever OS as this # program is called in CPAN module test on build. sub home_dir { my $home_dir = $ENV{HOME}; # Must untaint. if ( $Config::Config{'osname'} =~ m/(MS)?Win32/im ) { # Do for Win32 users. Tested only on WinXP $ENV{PATH} = 'C:\Perl\bin'; $home_dir = $ENV{USERPROFILE}; $home_dir =~ s/\\/\//gm; # Untaint it. if ($home_dir =~ m/(C:\/Documents and Settings)\/(.*)/m) { $home_dir = "$1/$2/Desktop"; } else { $home_dir = 'C:/'; } } else { # Assume everybody else is UNIX. Tested only on NetBSD $ENV{PATH} = '/bin:/usr/bin:/usr/pkg/bin'; if ($home_dir =~ m/(\/home)\/(.*)/m) { $home_dir = "$1/$2" } else { $home_dir = '/tmp' } } return $home_dir; } # Test if scalar is tainted. sub is_tainted { my $arg = shift; my $nada = substr $arg, 0, 0; local $EVAL_ERROR = 0; # Perl::Critic errs about localization. eval { eval "# $nada"}; # Perl::Critic errs about the quotes. return length $EVAL_ERROR != 0; } sub ck_age_size { ref( my $self = shift ) or croak 'Oops! Method ck_age_size() is instance, not class.'; my ($name, $min_bytes) = @_; if ( my @stats = stat "$self->{dir}/$name" ) { my $age = time - $stats[9]; if ($age < 10) { $self->{results} .= "Okay: File '$name' looks fresh: $age seconds old. \n" } else { $self->{results} .= "Oops! File '$name' looks old: $age seconds old. \n" } my $size = $stats[7]; if ($size > $min_bytes) { $self->{results} .= "Okay: File '$name' looks big enough, $size bytes. \n" } else { $self->{results} .= "Oops! File '$name' looks too small, $size bytes. \n" } } else { $self->{results} .= "Oops! File '$name' has no status. \n" } return 'Pthhht! to Perl::Critic'; } # Wipe out any earlier EPS and PNG test files in same dir. sub clean_up_dir { ref( my $self = shift ) or croak 'Oops! Method clean_up_dir() is instance, not class.'; unlink "$self->{dir}/foo.csv"; unlink "$self->{dir}/bar.csv"; return 'Pthhht! to Perl::Critic'; } # Test CSV file for content, age and size. sub test_csv_file { ref( my $self = shift ) or croak 'Oops! Method test_csv_file() is instance, not class. \n'; my ($file_name, $first_line, $last_line, $min_size ) = @_; my @lines; if (open my $fh, '<', "$self->{dir}/$file_name") { while (<$fh>) {chomp $_; push @lines, $_;} if (($lines[0] eq $first_line) && ($lines[100] eq $last_line)) { $self->{results} .= "Okay: File '$file_name' has expected first or last line. \n"; } else { $self->{results} .= "Oops! File '$file_name' lacks expected first or last line. \n"; } close $fh; $self->ck_age_size("$file_name", $min_size); } else { $self->{results} .= "Oops! File '$file_name' could not be read. \n"; } return 'Pthhht! to Perl::Critic'; } # For column key_test() use. # The captured output of $bar->describe(0,6) my $bar_col_keys = <<'EOHD'; 'Column Order' = 0 'Column Name' = 'Time (s)' 'Data Length' = 100 'Column Order' = 6 'Column Name' = 'SG 6' 'Gage Factor' = 2.01 'Transverse Sensitivity' = 0.015 'Ohms' = 120 'Data Length' = 100 EOHD # The captured output of $dbl_ck->describe(0,6) my $dbl_chk_col_keys = <<'EOHD'; 'Column Order' = 0 'Column Name' = 'Time (s)' 'Data Length' = 100 'Column Order' = 6 'Column Name' = 'DR 4-5-6 Deg' 'Array' = 4, 5, 6 'Data Length' = 100 EOHD # For column key_test() use. # Test CSV file for content, age and size. sub test_col_keys { ref( my $self = shift ) or croak 'Oops! Method test_col_keys() is instance, not class. \n'; # Compare against string defined just above here in Test.pm # If redefine Test::CSV::Munge->describe() must alter $bar_col_keys also. if ($_[0] eq $_[1]) { $self->{results} .= "Okay: Column keys remembered. \n"; } else { $self->{results} .= "Oops! Column keys not remembered. \n"; } # Debug use only # print "\n\nOUTPUT FROM describe():\n=======\n$_[0]VERSUS HERE DOC\n=======\n$_[1]=======\n";. return 'Pthhht! to Perl::Critic'; } # Final arbiter of package correctness. sub pass_judgement { ref( my $self = shift ) or croak 'Oops! Method pass_judgement() is instance, not class.'; $self->{results} .= "\n"; if ($self->{results} =~ m/Oops!/m) { $self->{results} .= "Woe & Lament! Not all is well for Text::CSV::Munge. \n" } else { $self->{results} .= "Glad Tidings! All tests okay for Text::CSV::Munge. \n" } return "\n" . $self->{results} . "\n"; } ############# # FAKE DATA # ############# # PURPOSE: Generate arbitrary data to use for demo and/or troubleshooting. # Simulates the output from a pair of strain gage rosettes, one rectangular # and one delta. # Simulate a data collection for a strain gage rectangular rosette # by returning an array of N refs of pseudorandom 3-elem arrays. sub fake_ue_array { my $obj = shift; my $i = shift; my @eu_3xN; my @keys = ( 'Time (s)', 'SG 1', 'SG 2', 'SG 3', 'SG 4', 'SG 5', 'SG 6' ); for my $j ( 0 .. $i ) { my @data_row = fake_ue_scan_reading( $obj, 15, 0.33 ); for my $k ( 0 .. $#keys ) { $eu_3xN[$k][$j] = shift @data_row; } } return ( \@keys, \@eu_3xN ); } my $fake_seconds = 0; # Time domain my $fake_ue_theta = 0; # Degrees my $fake_max_p_ue = 0; # Microstrain # Simulate one scan of time plus eu-readings from two unlike rosettes. sub fake_ue_scan_reading { my $obj = shift; my @ue_scan = ( $fake_seconds, $obj->sg_retro_rosette( fake_ue_next(@_), 45, 90, 0.283, 0.015 ), # Rectangular rosette. $obj->sg_retro_rosette( fake_ue_next(@_), 60, 120, 0.283, 0.015 ) # Delta rosette. ); $fake_seconds += 0.01; # Linear progression of time. return @ue_scan; } # Generate the next artifical max principal strain and theta. # Improbable (sometimes even impossible) strain values will result. sub fake_ue_next { my ( $ue_inc, $theta_inc ) = @_; # Waver max principal strain up one way, down the other. if ( abs($fake_ue_theta) > 17.5 ) { $fake_max_p_ue += $ue_inc } else { $fake_max_p_ue -= $ue_inc } $fake_max_p_ue += sin( 1 / ( $fake_seconds + $LSB ) ); # Wave the strain angle around in a circle. $fake_ue_theta += $theta_inc; return ( int($fake_max_p_ue), int( $fake_max_p_ue * 0.233 ), int( $fake_ue_theta % 360 ) ); } ############## # GAGES INFO # ############## # Info required to correct intrinsic small errors. my $poisson = 0.285; # Poisson's ratio for steel. ######## # TEST # ######## sub full_test { my $tainted = 0; # Assume called by user, not CPAN build test. ref( my $class = shift ) and croak 'Oops! Method full_test() is class, not instance.'; my $self = {}; bless $self, $class; $self->{dir} = shift; $self->{results} = $EMPTY; my $bar = Text::CSV::Munge->new(); my ( $names_aref, $data_arefs ) = fake_ue_array($bar, 99); my $foo = Text::CSV::Munge->new(); $foo->set_keys( 'Column Names' => $names_aref, 'Column Data Arefs' => $data_arefs, 'Verbosity Level' => 0, ); $foo->round_cols( 4, 0); # Set decimals to 4 for time channel. $foo->round_cols( 1, 1 .. 6); # Set decimals to 1 for strain channels. $foo->align_cols( 8, 0 .. 6 ); # Set widths of all columns (channels). $foo->write_csv( "$self->{dir}/foo.csv"); # Save all channels. $self->test_csv_file( 'foo.csv', q{ 'Time (s)', 'SG 1', 'SG 2', 'SG 3', 'SG 4', 'SG 5', 'SG 6'}, q{ 0.9900, 573.1, 1370.2, 1300.5, 579.2, 1509.0, 751.1}, 5000, ); # Read in the fake data written above as if it were real. $bar->merge_csvs( "$self->{dir}/foo.csv"); # Denote the column keys of each strain gage. $bar->sg_set_col_key('ohms', 120, 1 .. 6); $bar->sg_set_col_key('gage factor', 2.01, 1 .. 6); $bar->sg_set_col_key('transverse sensitivity', 0.015, 1 .. 6); # Test column key integrity. $self->test_col_keys( $bar->describe(0,6), $bar_col_keys ); # Solve 2 sets of 3-chan data as rosettes (added in as new channels). $bar->sg_rosette_rect( 1, 2, 3, $poisson ); $bar->sg_rosette_delta( 4, 5, 6, $poisson ); # Decimal digits (0th elem) and channel list. $bar->round_cols( 3, 0 ); # Time channel to 3 digits. $bar->round_cols( 1, 1 .. 12 ); # Strain channels to 1 digit. # Column width (0th elem) and channel list. $bar->align_cols( 8, 0 .. 12); # Save only time (0th elem) and the two solved-for rosettes. $bar->set_keys( 'Info File Flag' => 1 ); $bar->write_csv( "$self->{dir}/bar.csv", 0, 7 .. 12 ); # Compare contents of output file with intended. $self->test_csv_file( 'bar.csv', q{ 'Time (s)', 'RR 1-2-3 Max', 'RR 1-2-3 Min', 'RR 1-2-3 Deg',} . q{ 'DR 4-5-6 Max', 'DR 4-5-6 Min', 'DR 4-5-6 Deg'}, q{ 0.990, 1491.0, 347.1, -25.0,} . q{ 1516.6, 361.6, -24.6}, 10000, ); # Read back in to check the "*.csv.info" file system for # the retention of untidy, non-CSV data in a *.info file. my $dbl_ck = Text::CSV::Munge->new(); $dbl_ck->set_keys( 'Info File Flag' => 1 ); $dbl_ck->merge_csvs( "$self->{dir}/bar.csv" ); $bar->describe(0, 6); $dbl_ck->describe(0, 6); # Test column key integrity. $self->test_col_keys( $dbl_ck->describe(0,6), $dbl_chk_col_keys); return $self->pass_judgement(); # RE the string for "Oops!" as failure. } 1; __END__ =head1 NAME Text::CSV::Munge::Test.pm =head1 VERSION Version 0.01 =head1 SYNOPSIS From the CLI, call as below where C<'/some/dir/'> is any directory you have permission to write to. C From anywhere else call... C Cfull_test(/some/dir);> With the parent module (C) loaded, call as below. The C<$foo> may be either class or instance (of module C) as it will be ignored. The test module auto-instanciates its own object without need of a C method. It is just a test, after all. C<$foo-Efull_test('/some/dir');> =head1 DESCRIPTION Simulates calculating the maximum and minimum principal bar from delta and rectangular strain gage rosettes. Graphs the output via Chart::EPS_graph =head1 FEATURES Reads in uncorrected strain gage data from a C<*.csv> file. User designates which of these belong to which kinds of rosettes. Script then calculates the max and min principal bar along with their their angle. Resolved data is then output either as another C<*.csv> file, or as graphical data, or both. =head1 BUGS AND LIMITATIONS This program is free software. It carries absolutely no warranties or guarantees of any kind (expressed, implied, or even vaguely hinted at). =head1 DEPENDENCIES Install these into Perl via ActiveState PPM, NetBSD pkgsrc or CPAN as appropriate for your OS: C The last two of those I wrote myself and are very new. If not yet in CPAN, then email me and I'll send you the most recent versions personally. =head1 AUTHOR Gan Uesli Starling > =head1 LICENSE AND COPYRIGHT Copyright (c) 2006 Gan Uesli Starling. All rights reserved. This program is free software; you may redistribute and/or modify it under the same terms as Perl itself. =cut