[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

SF.net SVN: ledger-smb: [1190] trunk



Revision: 1190
          http://svn.sourceforge.net/ledger-smb/?rev=1190&view=rev
Author:   tetragon
Date:     2007-05-14 11:58:54 -0700 (Mon, 14 May 2007)

Log Message:
-----------
Some bug fixes and tests for LedgerSMB.pm

Modified Paths:
--------------
    trunk/Build.PL
    trunk/LedgerSMB.pm
    trunk/Makefile.PL

Added Paths:
-----------
    trunk/t/11-ledgersmb.t

Modified: trunk/Build.PL
===================================================================
--- trunk/Build.PL	2007-05-14 18:14:37 UTC (rev 1189)
+++ trunk/Build.PL	2007-05-14 18:58:54 UTC (rev 1190)
@@ -5,7 +5,7 @@
 
 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 @@
 		'Error'				=> 0,
 		'Template'			=> 0,
 		'Test::More'			=> 0,
+		'Test::Trap'			=> 0,
+		'Test::Exception'		=> 0,
 		},
 	recommends => {
 		'HTML::LinkExtor'		=> 0,

Modified: trunk/LedgerSMB.pm
===================================================================
--- trunk/LedgerSMB.pm	2007-05-14 18:14:37 UTC (rev 1189)
+++ trunk/LedgerSMB.pm	2007-05-14 18:58:54 UTC (rev 1190)
@@ -166,9 +166,9 @@
 }
 
 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 @@
         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 @@
 }
 
 1;
+

Modified: trunk/Makefile.PL
===================================================================
--- trunk/Makefile.PL	2007-05-14 18:14:37 UTC (rev 1189)
+++ trunk/Makefile.PL	2007-05-14 18:58:54 UTC (rev 1190)
@@ -31,6 +31,8 @@
 requires 'Error';
 
 build_requires 'Test::More';
+build_requires 'Test::Trap';
+build_requires 'Test::Exception';
 
 feature 'POS module credit card processing support',
     -default => 0,

Added: trunk/t/11-ledgersmb.t
===================================================================
--- trunk/t/11-ledgersmb.t	                        (rev 0)
+++ trunk/t/11-ledgersmb.t	2007-05-14 18:58:54 UTC (rev 1190)
@@ -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');


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.