diff options
| -rw-r--r-- | Build.PL | 4 | ||||
| -rwxr-xr-x | LedgerSMB.pm | 11 | ||||
| -rw-r--r-- | Makefile.PL | 2 | ||||
| -rw-r--r-- | t/11-ledgersmb.t | 111 |
4 files changed, 122 insertions, 6 deletions
@@ -5,7 +5,7 @@ use Module::Build; my $build = Module::Build->new ( dist_name => 'LedgerSMB', - dist_version => '1.1.99', + dist_version => '1.2.99', license => 'GPL', requires => { 'perl' => '>= 5.8.0', @@ -29,6 +29,8 @@ my $build = Module::Build->new ( 'Error' => 0, 'Template' => 0, 'Test::More' => 0, + 'Test::Trap' => 0, + 'Test::Exception' => 0, }, recommends => { 'HTML::LinkExtor' => 0, diff --git a/LedgerSMB.pm b/LedgerSMB.pm index b50b779d..0b71c918 100755 --- a/LedgerSMB.pm +++ b/LedgerSMB.pm @@ -166,9 +166,9 @@ sub debug { } sub escape { - my ($self) = @_; - my %args = @_; - my $str = $args{string}; + my $self = shift; + my %args = @_; + my $str = $args{string}; my $regex = qr/([^a-zA-Z0-9_.-])/; $str =~ s/$regex/sprintf("%%%02x", ord($1))/ge; @@ -221,8 +221,8 @@ sub num_text_rows { my $line = $_; while ( length($line) > $cols ) { my $fragment = substr( $line, 0, $cols + 1 ); - my $fragment = s/^(.*)\S*$/$1/; - $line = s/$fragment//; + $fragment =~ s/^(.*)\W.*$/$1/; + $line =~ s/$fragment//; if ( $line eq $fragment ) { # No word breaks! $line = ""; } @@ -595,3 +595,4 @@ sub merge { } 1; + diff --git a/Makefile.PL b/Makefile.PL index 65317663..3b1c58f5 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -31,6 +31,8 @@ requires 'Template'; requires 'Error'; build_requires 'Test::More'; +build_requires 'Test::Trap'; +build_requires 'Test::Exception'; feature 'POS module credit card processing support', -default => 0, diff --git a/t/11-ledgersmb.t b/t/11-ledgersmb.t new file mode 100644 index 00000000..71ebc5c1 --- /dev/null +++ b/t/11-ledgersmb.t @@ -0,0 +1,111 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use Test::More 'no_plan'; +use Test::Exception; +use Test::Trap qw(trap $trap); +use Math::BigFloat; + +use LedgerSMB; + +##line subroutine +##108 new +##145 debug +##204 num_text_rows +##235 redirect +##254 format_amount +##364 parse_amount +##408 round_amount +##423 call_procedure +##454 date_to_number +##490 db_init +##522 redo_rows +##547 merge + +my $lsmb = new LedgerSMB; +my %myconfig; +my $utfstr; +ok(defined $lsmb); +isa_ok($lsmb, 'LedgerSMB'); + +# $lsmb->escape checks +$lsmb = new LedgerSMB; +$utfstr = "\xd8\xad"; +utf8::decode($utfstr); +ok(!$lsmb->escape, 'escape: (undef)'); +ok(!$lsmb->escape('foo' => 'bar'), 'escape: (invalid args)'); +cmp_ok($lsmb->escape('string' => ' '), 'eq', '%20', + 'escape: \' \''); +cmp_ok($lsmb->escape('string' => 'foo'), 'eq', 'foo', + 'escape: foo'); +cmp_ok($lsmb->escape('string' => 'foo bar'), 'eq', 'foo%20bar', + 'escape: foo bar'); +TODO: { + local $TODO = 'Fun with Unicode'; + cmp_ok($lsmb->escape('string' => $utfstr), 'eq', '%d8%ad', + 'escape: U+D8AD'); +} + +# $lsmb->is_blank checks +$lsmb = new LedgerSMB; +$lsmb->{blank} = ' '; +$lsmb->{notblank} = ' d '; +TODO: { + local $TODO = 'Errors should be thrown'; + throws_ok{$lsmb->is_blank} 'Error::Simple', 'is_blank: (undef)'; + throws_ok{$lsmb->is_blank('foo' => 'bar')} 'Error::Simple', + 'is_blank: (invalid args)'; +} +is($lsmb->is_blank('name' => 'notblank'), 0, 'is_blank: notblank'); +is($lsmb->is_blank('name' => 'blank'), 1, 'is_blank: blank'); + +# $lsmb->is_run_mode checks +$lsmb = new LedgerSMB; +$ENV{GATEWAY_INTERFACE} = 'foo'; +is($lsmb->is_run_mode('cgi'), 1, 'is_run_mode: CGI - CGI'); +is($lsmb->is_run_mode('cli'), 0, 'is_run_mode: CGI - CLI'); +is($lsmb->is_run_mode('mod_perl'), 0, 'is_run_mode: CGI - mod_perl'); +is($lsmb->is_run_mode('foo'), 0, 'is_run_mode: CGI - (bad mode)'); +is($lsmb->is_run_mode, 0, 'is_run_mode: CGI - (unknown mode)'); +$ENV{MOD_PERL} = 'foo'; +is($lsmb->is_run_mode('cgi'), 1, 'is_run_mode: CGI/mod_perl - CGI'); +is($lsmb->is_run_mode('cli'), 0, 'is_run_mode: CGI/mod_perl - CLI'); +is($lsmb->is_run_mode('mod_perl'), 1, 'is_run_mode: CGI/mod_perl - mod_perl'); +is($lsmb->is_run_mode('foo'), 0, 'is_run_mode: CGI/mod_perl - (bad mode)'); +is($lsmb->is_run_mode, 0, 'is_run_mode: CGI/mod_perl - (unknown mode)'); +delete $ENV{GATEWAY_INTERFACE}; +is($lsmb->is_run_mode('cgi'), 0, 'is_run_mode: mod_perl - CGI'); +is($lsmb->is_run_mode('cli'), 0, 'is_run_mode: mod_perl - CLI'); +is($lsmb->is_run_mode('mod_perl'), 1, 'is_run_mode: mod_perl - mod_perl'); +is($lsmb->is_run_mode('foo'), 0, 'is_run_mode: mod_perl - (bad mode)'); +is($lsmb->is_run_mode, 0, 'is_run_mode: mod_perl - (unknown mode)'); +delete $ENV{MOD_PERL}; +is($lsmb->is_run_mode('cgi'), 0, 'is_run_mode: CLI - CGI'); +is($lsmb->is_run_mode('cli'), 1, 'is_run_mode: CLI - CLI'); +is($lsmb->is_run_mode('mod_perl'), 0, 'is_run_mode: CLI - mod_perl'); +is($lsmb->is_run_mode('foo'), 0, 'is_run_mode: CLI - (bad mode)'); +is($lsmb->is_run_mode, 0, 'is_run_mode: CLI - (unknown mode)'); + +# $lsmb->num_text_rows checks +$lsmb = new LedgerSMB; +is($lsmb->num_text_rows('string' => "apple\npear", 'cols' => 10, 'max' => 5), + 2, 'num_text_rows: 2 rows, no column breakage, max 5 rows'); +is($lsmb->num_text_rows('string' => "apple\npear", 'cols' => 10, 'max' => 1), + 1, 'num_text_rows: 2 rows, no column breakage, max 1 row'); +is($lsmb->num_text_rows('string' => "apple\npear", 'cols' => 10, 'max' => 2), + 2, 'num_text_rows: 2 rows, no column breakage, max 2 rows'); +is($lsmb->num_text_rows('string' => "apple\npear", 'cols' => 10), + 2, 'num_text_rows: 2 rows, no column breakage, no max row count'); +is($lsmb->num_text_rows('string' => "01234567890123456789", 'cols' => 10), + 2, 'num_text_rows: 2 rows, non-word column breakage, no max row count'); +is($lsmb->num_text_rows('string' => "012345 67890123 456789", 'cols' => 10), + 3, 'num_text_rows: 3 rows, word column breakage, no max row count'); +is($lsmb->num_text_rows('string' => "0123456789", 'cols' => 10), + 1, 'num_text_rows: 1 rows, no breakage, max cols, no max row count'); +is($lsmb->num_text_rows('string' => "01234567890", 'cols' => 10), + 2, 'num_text_rows: 2 rows, no breakage, max cols+1, no max row count'); +is($lsmb->num_text_rows('string' => "1\n\n2", 'cols' => 10), + 3, 'num_text_rows: 3 rows, no breakage, blank line, no max row count'); +is($lsmb->num_text_rows('string' => "012345 67890123456789", 'cols' => 10), + 3, 'num_text_rows: 3 rows, word and non column breakage, no max row count'); |