[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
SF.net SVN: ledger-smb:[3109] trunk
- Subject: SF.net SVN: ledger-smb:[3109] trunk
- From: ..hidden..
- Date: Mon, 06 Dec 2010 20:17:51 +0000
Revision: 3109
http://ledger-smb.svn.sourceforge.net/ledger-smb/?rev=3109&view=rev
Author: einhverfr
Date: 2010-12-06 20:17:51 +0000 (Mon, 06 Dec 2010)
Log Message:
-----------
Lacey's patches for cleaning up test cases
John Locke's fixes for numerous bugs
Modified Paths:
--------------
trunk/LedgerSMB/AA.pm
trunk/LedgerSMB/AM.pm
trunk/LedgerSMB/BP.pm
trunk/LedgerSMB/Batch.pm
trunk/LedgerSMB/CP.pm
trunk/LedgerSMB/DBObject/Account.pm
trunk/LedgerSMB/DBObject/Company.pm
trunk/LedgerSMB/DBObject/Menu.pm
trunk/LedgerSMB/DBObject/Payment.pm
trunk/LedgerSMB/DBObject/Reconciliation.pm
trunk/LedgerSMB/DBObject.pm
trunk/LedgerSMB/Form.pm
trunk/LedgerSMB/GL.pm
trunk/LedgerSMB/HR.pm
trunk/LedgerSMB/IC.pm
trunk/LedgerSMB/IR.pm
trunk/LedgerSMB/IS.pm
trunk/LedgerSMB/JC.pm
trunk/LedgerSMB/Log.pm
trunk/LedgerSMB/Num2text.pm
trunk/LedgerSMB/OE.pm
trunk/LedgerSMB/PE.pm
trunk/LedgerSMB/PriceMatrix.pm
trunk/LedgerSMB/RP.pm
trunk/LedgerSMB/ScriptLib/Company.pm
trunk/LedgerSMB/Template/LaTeX.pm
trunk/LedgerSMB/Template.pm
trunk/LedgerSMB/User.pm
trunk/LedgerSMB.pm
trunk/UI/payments/payment2.html
trunk/UI/payments/payments_filter.html
trunk/bin/aa.pl
trunk/bin/ca.pl
trunk/bin/ir.pl
trunk/bin/is.pl
trunk/bin/rp.pl
trunk/payment.pl
trunk/scripts/employee.pl
trunk/scripts/payment.pl
trunk/scripts/recon.pl
trunk/scripts/report.pl
trunk/sql/Pg-database.sql
trunk/sql/modules/1099_reports.sql
trunk/sql/modules/Account.sql
trunk/sql/modules/Drafts.sql
trunk/sql/modules/Entity.sql
trunk/sql/modules/Payment.sql
trunk/sql/modules/Roles.sql
trunk/sql/modules/Voucher.sql
trunk/sql/modules/test/Taxform.sql
trunk/t/02-number-handling.t
trunk/t/04-template-handling.t
trunk/t/10-form.t
trunk/t/11-ledgersmb.t
trunk/t/42-dbobject.t
trunk/t/89-dropdb.t
trunk/t/data/62-request-data
Modified: trunk/LedgerSMB/AA.pm
===================================================================
--- trunk/LedgerSMB/AA.pm 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/LedgerSMB/AA.pm 2010-12-06 20:17:51 UTC (rev 3109)
@@ -496,8 +496,6 @@
$arap = 1;
}
- my $exchangerate;
-
# add paid transactions
for $i ( 1 .. $form->{paidaccounts} ) {
@@ -919,7 +917,7 @@
description => 28
);
- my @a = ( transdate, invnumber, name );
+ my @a = qw( transdate invnumber name );
push @a, "employee" if $form->{l_employee};
push @a, "manager" if $form->{l_manager};
my $sortorder = $form->sort_order( ..hidden.., \%ordinal );
Modified: trunk/LedgerSMB/AM.pm
===================================================================
--- trunk/LedgerSMB/AM.pm 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/LedgerSMB/AM.pm 2010-12-06 20:17:51 UTC (rev 3109)
@@ -1605,7 +1605,7 @@
$dbh->commit;
- my $myconfig = LedgerSMB::User->new( $form->{login} );
+ $myconfig = LedgerSMB::User->new( $form->{login} );
map { $myconfig->{$_} = $form->{$_} if exists $form->{$_} }
qw(name email dateformat signature numberformat vclimit tel fax
@@ -2002,7 +2002,7 @@
if ( $form->{media} eq 'file' ) {
- open( IN, '<:raw', "$tmpfile" ) or $form->error("$tmpfile : $!");
+ #open( IN, '<:raw', "$tmpfile" ) or $form->error("$tmpfile : $!");
open( OUT, ">-" ) or $form->error("STDOUT : $!");
binmode( OUT, ':raw' );
Modified: trunk/LedgerSMB/BP.pm
===================================================================
--- trunk/LedgerSMB/BP.pm 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/LedgerSMB/BP.pm 2010-12-06 20:17:51 UTC (rev 3109)
@@ -59,7 +59,6 @@
my $n;
my $count;
my $item;
- my $sth;
$item = $form->{dbh}->quote($item);
foreach $item ( @{ $arap{ $form->{type} } } ) {
@@ -108,7 +107,7 @@
$sth->finish;
}
- $dbh->{commit};
+ $dbh->commit();
$form->all_years( $myconfig, $dbh );
Modified: trunk/LedgerSMB/Batch.pm
===================================================================
--- trunk/LedgerSMB/Batch.pm 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/LedgerSMB/Batch.pm 2010-12-06 20:17:51 UTC (rev 3109)
@@ -57,15 +57,22 @@
$search_proc = "batch_search";
}
- if ($self->{created_by_eid} == 0){
+ if ( !defined $self->{created_by_eid} || $self->{created_by_eid} == 0){
delete $self->{created_by_eid};
}
- if ($args->{custom_types}->{$self->{class_id}}->{select_method}){
+
+ if ( !defined $self->{class_id} )
+ {
+ delete $self->{class_id};
+ }
+
+ if ( ( defined $args->{custom_types} ) && ( defined $self->{class_id} ) && ( $args->{custom_types}->{$self->{class_id}}->{select_method} ) ){
$search_proc
= $args->{custom_types}->{$self->{class_id}}->{select_method};
- } elsif ($self->{class_id} =~ /[\D]/){
+ } elsif ( ( defined $self->{class_id} ) && ( $self->{class_id} =~ /[\D]/ ) ){
$self->error("Invalid Batch Type");
}
+
return $search_proc;
}
Modified: trunk/LedgerSMB/CP.pm
===================================================================
--- trunk/LedgerSMB/CP.pm 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/LedgerSMB/CP.pm 2010-12-06 20:17:51 UTC (rev 3109)
@@ -413,7 +413,7 @@
WHERE $where
AND a.trans_id = ?|;
- my $sth = $dbh->prepare($query);
+ $sth = $dbh->prepare($query);
$sth->execute( $form->{"id_$i"} );
my ($id) = $sth->fetchrow_array;
Modified: trunk/LedgerSMB/DBObject/Account.pm
===================================================================
--- trunk/LedgerSMB/DBObject/Account.pm 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/LedgerSMB/DBObject/Account.pm 2010-12-06 20:17:51 UTC (rev 3109)
@@ -45,12 +45,13 @@
sub get {
my $self = shift @_;
- my @accounts = $self->exec_method(funcname => 'account_get');
+ my $func = 'account_get';
+ if ($self->{charttype} and $self->{charttype} eq 'H'){
+ $func = 'account_heading_get';
+ }
+ my @accounts = $self->exec_method(funcname => $func);
$self->{account_list} = [];
for my $ref (@accounts){
- if ($self->{charttype} and $self->{charttype} ne $ref->{charttype}){
- next;
- }
bless $ref, 'LedgerSMB::DBObject::Account';
$ref->merge($self, keys => ['_user', '_locale', 'stylesheet', 'dbh', '_roles', '_request']);
push (@{$self->{account_list}}, $ref);
Modified: trunk/LedgerSMB/DBObject/Company.pm
===================================================================
--- trunk/LedgerSMB/DBObject/Company.pm 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/LedgerSMB/DBObject/Company.pm 2010-12-06 20:17:51 UTC (rev 3109)
@@ -241,7 +241,7 @@
my ($self, $account) = @_;
$self->set_entity_class();
- my ($account) = $self->exec_method(funcname => 'company__get_account');
+ $account = $self->exec_method(funcname => 'company__get_account');
}
sub accounts {
@@ -270,12 +270,12 @@
if($self->{entity_id})
{
- @{$self->{taxform_list}} = $self->exec_method(funcname => 'list_taxforms');
+ @{$self->{taxform_list}} = $self->exec_method(funcname => 'list_taxforms');
- foreach my $ref1(@{$self->{taxform_list}})
- {
- print STDERR qq| ______ return value $ref1->{id} and $ref1->{country_id},$ref1->{form_name} ________|;
- }
+ #foreach my $ref1(@{$self->{taxform_list}})
+ #{
+ #print STDERR qq| ______ return value $ref1->{id} and $ref1->{country_id},$ref1->{form_name} ________|;
+ #}
}
my ($ref) = $self->exec_method(funcname => 'company_retrieve');
Modified: trunk/LedgerSMB/DBObject/Menu.pm
===================================================================
--- trunk/LedgerSMB/DBObject/Menu.pm 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/LedgerSMB/DBObject/Menu.pm 2010-12-06 20:17:51 UTC (rev 3109)
@@ -17,7 +17,6 @@
package LedgerSMB::DBObject::Menu;
-use Config::Std;
use base(qw(LedgerSMB::DBObject));
1;
Modified: trunk/LedgerSMB/DBObject/Payment.pm
===================================================================
--- trunk/LedgerSMB/DBObject/Payment.pm 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/LedgerSMB/DBObject/Payment.pm 2010-12-06 20:17:51 UTC (rev 3109)
@@ -344,7 +344,9 @@
}
push(@$processed_invoices, $new_invoice);
}
- $contact->{invoice} = sort { $a->{invoice_date} cmp $b->{invoice_date} } @{ $processed_invoices };
+ #$contact->{invoice} = sort { $a->{invoice_date} cmp $b->{invoice_date} } @{ $processed_invoices };
+ my @sorted = sort { $a->{invoice_date} cmp $b->{invoice_date} } @{ $processed_invoices };
+ $contact->{invoice} = $sorted[0];
$contact->{invoice} = $processed_invoices;
}
return @{$self->{contacts}};
@@ -403,16 +405,6 @@
=cut
-sub list_departments {
- my ($self) = shift @_;
- my @args = @_;
- @{$self->{departments}} = $self->call_procedure(
- procname => 'department_list',
- args => ..hidden..
- );
- return @{$self->{departments}};
-}
-
=over
=item get_open_currencies
@@ -542,12 +534,16 @@
sub get_payment_detail_data {
my ($self) = @_;
$self->get_metadata();
- if (!defined $self->{source_start}){
+ if ( !defined $self->{source_start} ){
$self->error('No source start defined!');
+ exit;
}
+ #$self->error('No source start defined!') unless defined $self->{source_start};
my $source_inc;
my $source_src;
+ #print STDERR "Use of uninitialized value \$self->{source_start}: $self->{source_start} \n";
+ #if ( defined $self->{source_start} ) { print STDERR "Use of uninitialized value \$self->{source_start} is undefined"; } else { print STDERR "Use of uninitialized value \$self->{source_start} is undefined \n"; }
$self->{source_start} =~ /(\d*)\D*$/;
$source_src = $1;
if ($source_src) {
@@ -565,6 +561,7 @@
(defined $self->{"id_$inv->{contact_id}"})
) {
my $source = $self->{source_start};
+ $source = "" unless defined $source;
if (length($source_inc) < $source_length) {
$source_inc = sprintf('%0*s', $source_length, $source_inc);
}
Modified: trunk/LedgerSMB/DBObject/Reconciliation.pm
===================================================================
--- trunk/LedgerSMB/DBObject/Reconciliation.pm 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/LedgerSMB/DBObject/Reconciliation.pm 2010-12-06 20:17:51 UTC (rev 3109)
@@ -328,7 +328,7 @@
@{$self->{report_lines}} = $self->exec_method(
funcname=>'reconciliation__report_details'
);
- my ($ref) = $self->exec_method(
+ $ref = $self->exec_method(
funcname=>'reconciliation__get_cleared_balance'
);
Modified: trunk/LedgerSMB/DBObject.pm
===================================================================
--- trunk/LedgerSMB/DBObject.pm 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/LedgerSMB/DBObject.pm 2010-12-06 20:17:51 UTC (rev 3109)
@@ -107,7 +107,7 @@
$logger->debug("exec_method: \$funcname = $funcname");
my @in_args;
- @in_args = @{ $args{args}} if $args{args};
+ @in_args = @{ $args{args} } if $args{args};
my @call_args;
@@ -141,9 +141,18 @@
@proc_args = $self->_parse_array($pargs);
if (@proc_args) {
for my $arg (@proc_args) {
+ #print STDERR "User Provided Args: $arg\n";
if ( $arg =~ s/^in_// ) {
- $logger->debug("exec_method pushing $arg = $self->{$arg}");
- push @call_args, $self->{$arg};
+ if ( defined $self->{$arg} )
+ {
+ $logger->debug("exec_method pushing $arg = $self->{$arg}");
+ }
+ else
+ {
+ $logger->debug("exec_method pushing \$arg defined $arg | \$self->{\$arg} is undefined");
+ $self->{$arg} = undef;
+ }
+ push ( @call_args, $self->{$arg} );
}
}
}
Modified: trunk/LedgerSMB/Form.pm
===================================================================
--- trunk/LedgerSMB/Form.pm 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/LedgerSMB/Form.pm 2010-12-06 20:17:51 UTC (rev 3109)
@@ -70,6 +70,9 @@
use open ':utf8';
package Form;
+use LedgerSMB::Log;
+our $logger = Log::Log4perl->get_logger('LedgerSMB::Form');
+
=item new Form([$argstr])
Returns a reference to new Form object. The initial set of attributes is
@@ -87,15 +90,16 @@
sub new {
my $type = shift;
-
my $argstr = shift;
- if ($ENV{CONTENT_LENGTH} > $LedgerSMB::Sysconfig::max_post_size) {
+ $ENV{CONTENT_LENGTH} = 0 unless defined $ENV{CONTENT_LENGTH};
+
+ if ( ( $ENV{CONTENT_LENGTH} != 0 ) && ( $ENV{CONTENT_LENGTH} > $LedgerSMB::Sysconfig::max_post_size ) ) {
print "Status: 413\n Request entity too large\n\n";
die "Error: Request entity too large\n";
}
- read( STDIN, $_, $ENV{CONTENT_LENGTH} );
+ read( STDIN, $_, $ENV{CONTENT_LENGTH} ) unless $ENV{CONTENT_LENGTH} == 0;
if ($argstr) {
$_ = $argstr;
@@ -110,17 +114,21 @@
my $self = {};
my $orig = {};
- %$orig = split /[&=]/;
+ %$orig = split /[&=]/ unless !defined $_;
for ( keys %$orig ) {
$self->{unescape( "", $_) } = unescape( "", $orig->{$_} );
}
+ $self->{action} = "" unless defined $self->{action};
+
if ( substr( $self->{action}, 0, 1 ) !~ /( |\.)/ ) {
$self->{action} = lc $self->{action};
$self->{action} =~ s/( |-|,|\#|\/|\.$)/_/g;
$self->{nextsub} = lc $self->{nextsub};
$self->{nextsub} =~ s/( |-|,|\#|\/|\.$)/_/g;
}
+
+ $self->{login} = "" unless defined $self->{login};
$self->{login} =~ s/[^a-zA-Z0-9._+\@'-]//g;
if (!$self->{company} && $ENV{HTTP_COOKIE}){
@@ -136,17 +144,18 @@
$self->{company} = $ccookie;
}
- $self->{menubar} = 1 if $self->{path} =~ /lynx/i;
+ $self->{menubar} = 1 if ( ( defined $self->{path} ) && ( $self->{path} =~ /lynx/i ) );
#menubar will be deprecated, replaced with below
- $self->{lynx} = 1 if $self->{path} =~ /lynx/i;
+ $self->{lynx} = 1 if ( ( defined $self->{path} ) && ( $self->{path} =~ /lynx/i ) );
$self->{version} = "1.2.99";
$self->{dbversion} = "1.2.0";
bless $self, $type;
- if ( $self->{path} ne 'bin/lynx' ) { $self->{path} = 'bin/mozilla'; }
+ if ( !defined $self->{path} or $self->{path} ne 'bin/lynx' ) { $self->{path} = 'bin/mozilla'; }
+ #if ( $self->{path} ne 'bin/lynx' ) { $self->{path} = 'bin/mozilla'; }
if ( ( $self->{script} )
and not List::Util::first { $_ eq $self->{script} }
@@ -159,7 +168,8 @@
$self->error( "Access Denied", __LINE__, __FILE__ );
}
- for ( keys %$self ) { $self->{$_} =~ s/\N{NULL}//g }
+ #for ( keys %$self ) { $self->{$_} =~ s/\N{NULL}//g }
+ for ( keys %$self ) { if ( defined $self->{$_} ) { $self->{$_}=~ s/\N{NULL}//g; } }
if ( ($self->{action} eq 'redirect') || ($self->{nextsub} eq 'redirect') ) {
$self->error( "Access Denied", __LINE__, __FILE__ );
@@ -239,7 +249,11 @@
if ($file) {
open( FH, '>', "$file" ) or die $!;
- for ( sort keys %$self ) { print FH "$_ = $self->{$_}\n" }
+ for ( sort keys %$self )
+ {
+ $self->{$_} = "" unless defined $self->{$_};
+ print FH "$_ = $self->{$_}\n";
+ }
close(FH);
}
else {
@@ -311,7 +325,7 @@
$str =~ s/\\$//;
utf8::encode($str) if utf8::is_utf8($str);
- $str =~ s/%([0-9a-fA-Z]{2})/pack("c",hex($1))/eg;
+ $str =~ s/%([0-9a-fA-Z]{2})/pack("C",hex($1))/eg;
utf8::decode($str);
$str =~ s/\r?\n/\n/g;
@@ -663,6 +677,11 @@
my ( $self, $columns, $ordinal ) = @_;
+ $self = "" unless defined $self;
+ $self->{sort} = "" unless defined $self->{sort};
+ $self->{oldsort} = "" unless defined $self->{oldsort};
+ $self->{direction} = "" unless defined $self->{direction};
+
# setup direction
if ( $self->{direction} ) {
@@ -687,11 +706,24 @@
my @a = $self->sort_columns( @{$columns} );
if (ref $ordinal eq 'HASH') {
- $a[0] =
- ( $ordinal->{ $a[$_] } )
- ? "$ordinal->{$a[0]} $self->{direction}"
- : "$a[0] $self->{direction}";
+ #$a[0] =
+ #( $ordinal->{ $a[$_] } )
+ #? "$ordinal->{$a[0]} $self->{direction}";
+ #: "$a[0] $self->{direction}";
+ if ( defined $_ && $ordinal->{ $a[$_] } )
+ {
+ $a[0] = "$ordinal->{$a[0]} $self->{direction}";
+ }
+ elsif ( !defined $_ && $ordinal->{ $a[0] } )
+ {
+ $a[0] = "$ordinal->{$a[0]} $self->{direction}";
+ }
+ else
+ {
+ $a[0] = "$a[0] $self->{direction}";
+ }
+
for ( 1 .. $#a ) {
$a[$_] = $ordinal->{ $a[$_] } if $ordinal->{ $a[$_] };
}
@@ -730,6 +762,12 @@
my ( $self, $myconfig, $amount, $places, $dash ) = @_;
+ $self = "" unless defined $self;
+ $myconfig = "" unless defined $myconfig;
+ $amount = "" unless defined $amount;
+ $places = "" unless defined $places;
+ $dash = "" unless defined $dash;
+
my $negative;
if ($amount) {
$amount = $self->parse_amount( $myconfig, $amount );
@@ -754,6 +792,9 @@
if ( $myconfig->{numberformat} ) {
my ( $whole, $dec ) = split /\./, "$amount";
+
+ $dec = "" unless defined $dec;
+
$amount = join '', reverse split //, $whole;
if ($places) {
@@ -841,7 +882,8 @@
my ( $self, $myconfig, $amount ) = @_;
- if ( ( $amount eq '' ) or ( ! defined $amount ) ) {
+ #if ( ( $amount eq '' ) or ( ! defined $amount ) ) {
+ if ( ( ! defined $amount ) or ( $amount eq '' ) ) {
$amount = 0;
}
@@ -850,6 +892,7 @@
return $amount;
}
my $numberformat = $myconfig->{numberformat};
+ $numberformat = "" unless defined $numberformat;
if ( ( $numberformat eq '1.000,00' )
|| ( $numberformat eq '1000,00' ) )
@@ -876,7 +919,7 @@
$amount =~ /(\d*)\.(\d*)/;
- my $decimalplaces = length $1 + length $2;
+ #my $decimalplaces = length $1 + length $2;
$amount = new Math::BigFloat($amount);
if ($amount->is_nan){
@@ -1044,6 +1087,8 @@
my ( $self, $myconfig, $date, $picture ) = @_;
+ $date = "" unless defined $date;
+
if ($date =~ /^\d{4}-\d{2}-\d{2}$/){
$date =~ s/-//g;
return $date;
@@ -1233,8 +1278,11 @@
'dd-mm-yy' => 'set DateStyle to \'POSTGRES, EUROPEAN\'',
'dd.mm.yy' => 'set DateStyle to \'GERMAN\''
);
-
- $self->{dbh}->do( $date_query{ $myconfig->{dateformat} } );
+ if ( !$myconfig->{dateformat}) {
+ $myconfig->{dateformat} = 'yyyy-mm-dd';
+ } else {
+ $self->{dbh}->do( $date_query{ $myconfig->{dateformat} } );
+ }
$self->{db_dateformat} = $myconfig->{dateformat}; #shim
# This is the general version check
@@ -1252,7 +1300,7 @@
|| ':' || f.field_name as field_def
FROM custom_table_catalog t
JOIN custom_field_catalog f USING (table_id)";
- my $sth = $self->{dbh}->prepare($query);
+ $sth = $self->{dbh}->prepare($query);
$sth->execute;
my $ref;
while ( $ref = $sth->fetchrow_hashref('NAME_lc') ) {
@@ -2577,7 +2625,7 @@
my $sth = $dbh->prepare($query);
$sth->execute(@queryargs);
- my ($thisdate) = $sth->fetchrow_array;
+ $thisdate = $sth->fetchrow_array;
$thisdate;
}
@@ -3328,12 +3376,12 @@
}
}
- my $query = qq|
+ $query = qq|
UPDATE defaults
SET value = ?
WHERE setting_key = ?|;
- my $sth = $dbh->prepare($query);
+ $sth = $dbh->prepare($query);
$sth->execute( $dbvar, $fld ) || $self->dberror($query);
$dbh->commit;
@@ -3481,7 +3529,7 @@
else { # return date
$datestring = $date;
}
- $datestring;
+ return $datestring;
}
=item $form->from_to($yyyy, $mm[, $interval]);
@@ -3499,6 +3547,9 @@
my ( $self, $yyyy, $mm, $interval ) = @_;
+ $yyyy = 0 unless defined $yyyy;
+ $mm = 0 unless defined $mm;
+
my @t;
my $dd = 1;
my $fromdate = "$yyyy-${mm}-01";
@@ -3541,7 +3592,7 @@
$t[4] = substr( "0$t[4]", -2 );
$t[3] = substr( "0$t[3]", -2 );
$t[5] += 1900;
-
+
return ( $self->format_date($fromdate), $self->format_date("$t[5]-$t[4]-$t[3]") );
}
@@ -3584,7 +3635,6 @@
$dbh = $self->{dbh};
}
my $sth;
- my $query;
# if we have an id add audittrail, otherwise get a new timestamp
Modified: trunk/LedgerSMB/GL.pm
===================================================================
--- trunk/LedgerSMB/GL.pm 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/LedgerSMB/GL.pm 2010-12-06 20:17:51 UTC (rev 3109)
@@ -189,7 +189,7 @@
fx_transaction, memo, cleared)
VALUES (?, (SELECT id
FROM chart
- WHERE accno = ?),
+ WHERE accno = ? AND charttype = 'A'),
?, ?, ?, ?, ?, ?, ?)|;
$sth = $dbh->prepare($query);
@@ -234,7 +234,7 @@
my $var;
my $null;
if ($form->{chart_id}){
- my $sth = $dbh->prepare('SELECT id, accno, description FROM chart WHERE id = ?');
+ my $sth = $dbh->prepare("SELECT id, accno, description FROM chart WHERE id = ? AND charttype = 'A'");
$sth->execute($form->{chart_id});
($form->{chart_id}, $form->{chart_accno}, $form->{chart_description}) = $sth->fetchrow_array();
}
@@ -282,8 +282,8 @@
$apwhere .= " AND lower(ac.memo) LIKE $var";
}
- if (!form->{datefrom} && !$form->{dateto}
- && form->{year} && $form->{month}){
+ if (!$form->{datefrom} && !$form->{dateto}
+ && $form->{year} && $form->{month}){
( $form->{datefrom}, $form->{dateto} ) =
$form->from_to( $form->{year}, $form->{month}, $form->{interval} );
}
@@ -407,7 +407,7 @@
$query = qq|
SELECT SUM(ac.amount)
FROM acc_trans ac
- JOIN chart c ON (ac.chart_id = c.id)
+ JOIN chart c ON (ac.chart_id = c.id AND c.charttype = 'A')
WHERE c.gifi_accno = $gifi
AND ac.transdate < date | . $dbh->quote( $form->{datefrom} );
@@ -431,7 +431,7 @@
entry_id => 20
);
- my @a = ( entry_id, trans_id, chart_id, id, transdate, reference, source, description, accno);
+ my @a = qw( entry_id trans_id chart_id id transdate reference source description accno);
my $sortorder = $form->sort_order( ..hidden.., \%ordinal );
my $chart_id;
@@ -449,7 +449,7 @@
$approved = $dbh->quote($form->{approved});
}
- my $query = qq|SELECT g.id, 'gl' AS type, $false AS invoice, g.reference,
+ $query = qq|SELECT g.id, 'gl' AS type, $false AS invoice, g.reference,
g.description, ac.transdate, ac.source,
ac.amount, c.accno, c.gifi_accno, g.notes, c.link,
'' AS till, ac.cleared, d.description AS department,
@@ -457,7 +457,7 @@
ac.chart_id, ac.entry_id
FROM gl AS g
JOIN acc_trans ac ON (g.id = ac.trans_id)
- JOIN chart c ON (ac.chart_id = c.id)
+ JOIN chart c ON (ac.chart_id = c.id AND c.charttype = 'A')
LEFT JOIN department d ON (d.id = g.department_id)
WHERE $glwhere
AND (ac.chart_id = $chart_id OR
@@ -476,7 +476,7 @@
ac.chart_id, ac.entry_id
FROM ar a
JOIN acc_trans ac ON (a.id = ac.trans_id)
- JOIN chart c ON (ac.chart_id = c.id)
+ JOIN chart c ON (ac.chart_id = c.id AND c.charttype = 'A')
JOIN entity_credit_account ec ON
(a.entity_credit_account = ec.id)
JOIN entity e ON (ec.entity_id = e.id)
@@ -498,7 +498,7 @@
ac.chart_id, ac.entry_id
FROM ap a
JOIN acc_trans ac ON (a.id = ac.trans_id)
- JOIN chart c ON (ac.chart_id = c.id)
+ JOIN chart c ON (ac.chart_id = c.id AND c.charttype = 'A')
JOIN entity_credit_account ec ON
(a.entity_credit_account = ec.id)
JOIN entity e ON (ec.entity_id = e.id)
@@ -510,7 +510,7 @@
$approved =
(ac.approved AND a.approved))
ORDER BY $sortorder|;
- my $sth = $dbh->prepare($query);
+ $sth = $dbh->prepare($query);
$sth->execute || $form->dberror($query);
while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) {
@@ -599,7 +599,7 @@
# retrieve individual rows
$query = qq|SELECT ac.*, c.accno, c.description, p.projectnumber
FROM acc_trans ac
- JOIN chart c ON (ac.chart_id = c.id)
+ JOIN chart c ON (ac.chart_id = c.id and c.charttype = 'A')
LEFT JOIN project p ON (p.id = ac.project_id)
WHERE ac.trans_id = ?
ORDER BY ac.entry_id|;
Modified: trunk/LedgerSMB/HR.pm
===================================================================
--- trunk/LedgerSMB/HR.pm 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/LedgerSMB/HR.pm 2010-12-06 20:17:51 UTC (rev 3109)
@@ -44,7 +44,7 @@
my $notid = "";
if ( $form->{id} ) {
- $query = qq|SELECT e.* FROM employee e WHERE e.id = ?|;
+ $query = qq|SELECT e.* FROM employee e WHERE e.employeenumber = ?|;
$sth = $dbh->prepare($query);
$sth->execute( $form->{id} )
|| $form->dberror( __FILE__ . ':' . __LINE__ . ':' . $query );
@@ -61,10 +61,10 @@
$sth->finish;
# get manager
- $form->{managerid} *= 1;
+ $form->{manager_id} *= 1;
- $sth = $dbh->prepare("SELECT name FROM employee WHERE id = ?");
- $sth->execute( $form->{managerid} );
+ $sth = $dbh->prepare("SELECT first_name FROM employee WHERE entity_id = ?");
+ $sth->execute( $form->{manager_id} );
( $form->{manager} ) = $sth->fetchrow_array;
$notid = qq|AND id != | . $dbh->quote( $form->{id} );
@@ -78,7 +78,7 @@
# get managers
$query = qq|
- SELECT id, name
+ SELECT entity_id, first_name
FROM employee
WHERE sales = '1'
AND role = 'manager'
@@ -110,11 +110,11 @@
my $uid = localtime;
$uid .= "$$";
- $query = qq|INSERT INTO employee (name) VALUES ('$uid')|;
+ $query = qq|INSERT INTO employee (first_name) VALUES ('$uid')|;
$dbh->do($query)
|| $form->dberror( __FILE__ . ':' . __LINE__ . ':' . $query );
- $query = qq|SELECT id FROM employee WHERE name = '$uid'|;
+ $query = qq|SELECT entity_id FROM employee WHERE first_name = '$uid'|;
$sth = $dbh->prepare($query);
$sth->execute
|| $form->dberror( __FILE__ . ':' . __LINE__ . ':' . $query );
@@ -123,15 +123,15 @@
$sth->finish;
}
- my ( $null, $managerid ) = split /--/, $form->{manager};
- $managerid *= 1;
+ my ( $null, $manager_id ) = split /--/, $form->{manager};
+ $manager_id *= 1;
$form->{sales} *= 1;
$query = qq|
UPDATE employee
SET employeenumber = ?,
- name = ?,
+ first_name = ?,
address1 = ?,
address2 = ?,
city = ?,
@@ -150,20 +150,20 @@
dob = ?,
iban = ?,
bic = ?,
- managerid = ?
+ manager_id = ?
WHERE id = ?|;
$sth = $dbh->prepare($query);
$form->{dob} ||= undef;
$form->{startdate} ||= undef;
$form->{enddate} ||= undef;
$sth->execute(
- $form->{employeenumber}, $form->{name}, $form->{address1},
+ $form->{employeenumber}, $form->{first_name}, $form->{address1},
$form->{address2}, $form->{city}, $form->{state},
$form->{zipcode}, $form->{country}, $form->{workphone},
$form->{homephone}, $form->{startdate}, $form->{enddate},
$form->{notes}, $form->{role}, $form->{sales},
$form->{email}, $form->{ssn}, $form->{dob},
- $form->{iban}, $form->{bic}, $managerid,
+ $form->{iban}, $form->{bic}, $manager_id,
$form->{id}
) || $form->dberror( __FILE__ . ':' . __LINE__ . ':' . $query );
@@ -196,8 +196,8 @@
my $dbh = $form->{dbh};
my $where = "1 = 1";
- $form->{sort} = ( $form->{sort} ) ? $form->{sort} : "name";
- my @a = qw(name);
+ $form->{sort} = ( $form->{sort} ) ? $form->{sort} : "first_name";
+ my @a = qw(first_name);
my $sortorder = $form->sort_order( ..hidden.. );
my $var;
@@ -209,9 +209,9 @@
if ( $form->{startdateto} ) {
$where .= " AND e.startddate <= " . $dbh->quote( $form->{startdateto} );
}
- if ( $form->{name} ne "" ) {
- $var = $dbh->quote( $form->like( lc $form->{name} ) );
- $where .= " AND lower(e.name) LIKE $var";
+ if ( $form->{first_name} ne "" ) {
+ $var = $dbh->quote( $form->like( lc $form->{first_name} ) );
+ $where .= " AND lower(e.first_name) LIKE $var";
}
if ( $form->{notes} ne "" ) {
$var = $dbh->quote( $form->like( lc $form->{notes} ) );
@@ -231,9 +231,9 @@
}
my $query = qq|
- SELECT e.*, m.name AS manager
+ SELECT e.*, m.first_name AS manager
FROM employee e
- LEFT JOIN employee m ON (m.id = e.managerid)
+ LEFT JOIN employee m ON (m.entity_id = e.manager_id)
WHERE $where
ORDER BY $sortorder|;
Modified: trunk/LedgerSMB/IC.pm
===================================================================
--- trunk/LedgerSMB/IC.pm 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/LedgerSMB/IC.pm 2010-12-06 20:17:51 UTC (rev 3109)
@@ -1711,7 +1711,7 @@
}
$sth->finish;
- my %ofld = ( customer => so, vendor => po );
+ my %ofld = ( customer => 'so', vendor => 'po' );
for (qw(customer vendor)) {
$query = qq|
Modified: trunk/LedgerSMB/IR.pm
===================================================================
--- trunk/LedgerSMB/IR.pm 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/LedgerSMB/IR.pm 2010-12-06 20:17:51 UTC (rev 3109)
@@ -156,7 +156,6 @@
my $amount;
my $grossamount;
- my $allocated;
my $invamount = 0;
my $invnetamount = 0;
@@ -979,7 +978,7 @@
SELECT spoolfile FROM status
WHERE trans_id = ?
AND spoolfile IS NOT NULL|;
- my $sth = $dbh->prepare($query);
+ $sth = $dbh->prepare($query);
$sth->execute( $form->{id} ) || $form->dberror($query);
my $spoolfile;
@@ -992,7 +991,7 @@
# delete status entries
$query = qq|DELETE FROM status WHERE trans_id = ?|;
- my $sth = $dbh->prepare($query);
+ $sth = $dbh->prepare($query);
$sth->execute( $form->{id} ) || $form->dberror($query);
if ($rc) {
@@ -1016,7 +1015,7 @@
$sth->execute($form->{id});
# delete AP record
$query = qq|DELETE FROM ap WHERE id = ?|;
- my $sth = $dbh->prepare($query);
+ $sth = $dbh->prepare($query);
$sth->execute( $form->{id} ) || $form->dberror($query);
my $rc = $dbh->commit;
@@ -1463,7 +1462,6 @@
my $sth = $dbh->prepare("SELECT on_hold from ar where ar.id = ?");
$sth->execute($form->{id});
my $state = $sth->fetchrow_array;
- my $sth;
my $n_s; # new state
if ($state[0] == 't') {
@@ -1474,7 +1472,7 @@
$n_s = 't';
}
- my $sth = $dbh->prepare("update ar set on_hold = ?::boolean where ar.id = ?");
+ $sth = $dbh->prepare("update ar set on_hold = ?::boolean where ar.id = ?");
my $code = $dbh->execute($ns, $form->{id});
return 1;
Modified: trunk/LedgerSMB/IS.pm
===================================================================
--- trunk/LedgerSMB/IS.pm 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/LedgerSMB/IS.pm 2010-12-06 20:17:51 UTC (rev 3109)
@@ -74,7 +74,6 @@
my @taxaccounts;
my %taxaccounts;
- my $tax;
my $taxrate;
my $taxamount;
@@ -156,7 +155,7 @@
$form->{projectnumber} .= $form->{partsgroup};
}
- $form->format_string(projectnumber);
+ $form->format_string($form->{projectnumber});
}
@@ -832,7 +831,7 @@
my $exchangerate = 0;
my $keepcleared = 0;
- %$form->{acc_trans} = ();
+ $form->{acc_trans} = ();
if ($form->{id}){
delete_invoice($self, $myconfig, $form);
@@ -944,15 +943,9 @@
}
-
my $taxformfound=IS->taxform_exist($form,$form->{"customer_id"});
-
-
- my $taxformfound=IS->taxform_exist($form,$form->{"customer_id"});
-
-
foreach $i ( 1 .. $form->{rowcount} ) {
my $allocated = 0;
$form->{"qty_$i"} = $form->parse_amount( $myconfig, $form->{"qty_$i"} );
@@ -1785,13 +1778,13 @@
return unless $id;
# reverse inventory items
- my $query = qq|
+ $query = qq|
SELECT i.id, i.parts_id, i.qty, i.assemblyitem, p.assembly,
p.inventory_accno_id
FROM invoice i
JOIN parts p ON (i.parts_id = p.id)
WHERE i.trans_id = ?|;
- my $sth = $dbh->prepare($query);
+ $sth = $dbh->prepare($query);
$sth->execute( $form->{id} ) || $form->dberror($query);
while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) {
@@ -1852,7 +1845,7 @@
$sth = $dbh->prepare($query);
$sth->execute( $form->{id} ) || $form->dberror($query);
- $query = qq|DELETE FROM shipto WHERE trans_id = ?|;
+ $query = qq|DELETE FROM new_shipto WHERE trans_id = ?|;
$sth = $dbh->prepare($query);
$sth->execute( $form->{id} ) || $form->dberror($query);
@@ -1981,7 +1974,7 @@
$sth->finish;
# get shipto
- $query = qq|SELECT * FROM shipto WHERE trans_id = ?|;
+ $query = qq|SELECT ns.*, l.* FROM new_shipto ns JOIN location l ON ns.location_id = l.id WHERE ns.trans_id = ?|;
$sth = $dbh->prepare($query);
$sth->execute( $form->{id} ) || $form->dberror($query);
@@ -2264,7 +2257,6 @@
my $sth = $dbh->prepare("SELECT on_hold from ar where ar.id = ?");
$sth->execute($form->{id});
my $state = $sth->fetchrow_array;
- my $sth;
my $n_s; # new state
if ($state[0] == 't') {
@@ -2275,7 +2267,7 @@
$n_s = 't';
}
- my $sth = $dbh->prepare("update ar set on_hold = ?::boolean where ar.id = ?");
+ $sth = $dbh->prepare("update ar set on_hold = ?::boolean where ar.id = ?");
my $code = $dbh->execute($ns, $form->{id});
return 1;
Modified: trunk/LedgerSMB/JC.pm
===================================================================
--- trunk/LedgerSMB/JC.pm 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/LedgerSMB/JC.pm 2010-12-06 20:17:51 UTC (rev 3109)
@@ -341,7 +341,7 @@
WHERE formname = ?
AND trans_id = ?
AND spoolfile IS NOT NULL|;
- my $sth = $dbh->prepare($query);
+ $sth = $dbh->prepare($query);
$sth->execute( $form->{type}, $form->{id} ) || $form->dberror($query);
my $spoolfile;
@@ -358,7 +358,7 @@
FROM status
WHERE formname = ?
AND trans_id = ?|;
- my $sth = $dbh->prepare($query);
+ $sth = $dbh->prepare($query);
$sth->execute( $form->{type}, $form->{id} ) || $form->dberror($query);
my $rc = $dbh->commit;
@@ -370,7 +370,7 @@
}
}
- $dbh->{commit};
+ $dbh->commit();
$rc;
@@ -442,7 +442,7 @@
projectdescription => 11,
);
- my @a = ( transdate, projectnumber );
+ my @a = qw( transdate projectnumber );
my $sortorder = $form->sort_order( ..hidden.., \%ordinal );
my $dateformat = $myconfig->{dateformat};
Modified: trunk/LedgerSMB/Log.pm
===================================================================
--- trunk/LedgerSMB/Log.pm 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/LedgerSMB/Log.pm 2010-12-06 20:17:51 UTC (rev 3109)
@@ -41,6 +41,10 @@
This uses Data::Dumper to dump the contents of a data structure as a debug message.
+=item print
+
+Uses sprintf to format a log line with a timestamp and a message.
+
=back
=cut
Modified: trunk/LedgerSMB/Num2text.pm
===================================================================
--- trunk/LedgerSMB/Num2text.pm 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/LedgerSMB/Num2text.pm 2010-12-06 20:17:51 UTC (rev 3109)
@@ -137,7 +137,8 @@
for ( 1 .. 3 ) {
push @a, shift @num;
}
- push @numblock, join / /, reverse @a;
+ #push @numblock, join / /, reverse @a;
+ push @numblock, join(" ", reverse @a);
}
while (@numblock) {
@@ -229,7 +230,8 @@
for ( 1 .. 3 ) {
push @a, shift @num;
}
- push @numblock, join / /, reverse @a;
+ #push @numblock, join / /, reverse @a;
+ push @numblock, join(" ", reverse @a);
}
my $belowhundred = !$#numblock;
@@ -354,7 +356,8 @@
for ( 1 .. 3 ) {
push @a, shift @num;
}
- push @numblock, join / /, reverse @a;
+ #push @numblock, join / /, reverse @a;
+ push @numblock, join(" ", reverse @a);
}
while (@numblock) {
@@ -448,7 +451,8 @@
for ( 1 .. 3 ) {
push @a, shift @num;
}
- push @numblock, join / /, reverse @a;
+ #push @numblock, join / /, reverse @a;
+ push @numblock, join(" ", reverse @a);
}
# special case for 1000
@@ -587,7 +591,8 @@
for ( 1 .. 3 ) {
push @a, shift @num;
}
- push @numblock, join / /, reverse @a;
+ #push @numblock, join / /, reverse @a;
+ push @numblock, join(" ", reverse @a);
}
my $cent = 0;
@@ -736,7 +741,8 @@
for ( 1 .. 3 ) {
push @a, shift @num;
}
- push @numblock, join / /, reverse @a;
+ #push @numblock, join / /, reverse @a;
+ push @numblock, join(" ", reverse @a);
}
while (@numblock) {
$i = $#numblock;
@@ -829,7 +835,8 @@
for ( 1 .. 3 ) {
push @a, shift @num;
}
- push @numblock, join / /, reverse @a;
+ #push @numblock, join / /, reverse @a;
+ push @numblock, join(" ", reverse @a);
}
while (@numblock) {
@@ -921,7 +928,8 @@
for ( 1 .. 3 ) {
push @a, shift @num;
}
- push @numblock, join / /, reverse @a;
+ #push @numblock, join / /, reverse @a;
+ push @numblock, join(" ", reverse @a);
}
while (@numblock) {
@@ -1016,7 +1024,8 @@
for ( 1 .. 3 ) {
push @a, shift @num;
}
- push @numblock, join / /, reverse @a;
+ #push @numblock, join / /, reverse @a;
+ push @numblock, join(" ", reverse @a);
}
my $i;
@@ -1130,7 +1139,8 @@
for (1 .. 3) {
push @a, shift @num;
}
- push @numblock, join / /, reverse @a;
+ #push @numblock, join / /, reverse @a;
+ push @numblock, join(" ", reverse @a);
}
my $belowhundred = !$#numblock;
Modified: trunk/LedgerSMB/OE.pm
===================================================================
--- trunk/LedgerSMB/OE.pm 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/LedgerSMB/OE.pm 2010-12-06 20:17:51 UTC (rev 3109)
@@ -75,7 +75,7 @@
if ( $form->{vc} ne 'customer' ) { # Sanitize $form->{vc}
$form->{vc} = 'vendor';
}
- my $query = qq|
+ $query = qq|
SELECT o.id, o.ordnumber, o.transdate, o.reqdate,
o.amount, c.legal_name AS name, o.netamount, o.entity_credit_account AS $form->{vc}_id,
ex.$rate AS exchangerate, o.closed, o.quonumber,
@@ -112,7 +112,7 @@
ponumber => 17
);
- my @a = ( transdate, $ordnumber, name );
+ my @a = ( 'transdate', $ordnumber, 'name' );
push @a, "employee" if $form->{l_employee};
if ( $form->{type} !~ /(ship|receive)_order/ ) {
push @a, "manager" if $form->{l_manager};
@@ -1098,7 +1098,7 @@
$form->{projectnumber} .= $form->{partsgroup};
}
- $form->format_string(projectnumber);
+ $form->format_string($form->{projectnumber});
}
@@ -1773,8 +1773,9 @@
my $wth;
my $serialnumber;
my $ship;
+ my $employee_id;
- my ( $null, $employee_id ) = split /--/, $form->{employee};
+ ( $null, $employee_id ) = split /--/, $form->{employee};
( $null, $employee_id ) = $form->get_employee($dbh) if !$employee_id;
$query = qq|
@@ -2038,7 +2039,7 @@
warehouse => 6,
);
- my @a = ( partnumber, warehouse );
+ my @a = qw( partnumber warehouse );
my $sortorder = $form->sort_order( ..hidden.., \%ordinal );
if ($fromwarehouse_id ne 'NULL') {
Modified: trunk/LedgerSMB/PE.pm
===================================================================
--- trunk/LedgerSMB/PE.pm 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/LedgerSMB/PE.pm 2010-12-06 20:17:51 UTC (rev 3109)
@@ -538,7 +538,6 @@
my $count;
- my $count;
while ( ($count) = $sth->fetchrow_array ) {
$form->{orphaned} += $count;
}
@@ -1144,7 +1143,7 @@
my $dbh = $form->{dbh};
$form->{sort} = "partsgroup" unless $form->{partsgroup};
- my @a = (partsgroup);
+ my @a = qw(partsgroup);
my $sortorder = $form->sort_order( ..hidden.. );
my $query = qq|SELECT g.* FROM partsgroup g|;
@@ -1280,7 +1279,7 @@
my $dbh = $form->{dbh};
$form->{sort} = "pricegroup" unless $form->{sort};
- my @a = (pricegroup);
+ my @a = qw(pricegroup);
my $sortorder = $form->sort_order( ..hidden.. );
my $query = qq|SELECT g.* FROM pricegroup g|;
Modified: trunk/LedgerSMB/PriceMatrix.pm
===================================================================
--- trunk/LedgerSMB/PriceMatrix.pm 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/LedgerSMB/PriceMatrix.pm 2010-12-06 20:17:51 UTC (rev 3109)
@@ -47,7 +47,7 @@
if ( $form->{customer_id} ) {
my $defaultcurrency = $form->{dbh}->quote( $form->{defaultcurrency} );
$query = qq|
- SELECT p.parts_id, p.customer_id AS entity_id,
+ SELECT p.parts_id, p.credit_id AS entity_id,
NULL AS pricegroup_id,
p.pricebreak, p.sellprice, p.validfrom,
p.validto, p.curr, NULL AS pricegroup,
@@ -58,11 +58,11 @@
$transdate
AND coalesce(p.validto, $transdate) >=
$transdate
- AND p.customer_id = $entity_id
+ AND p.credit_id = $entity_id
UNION
- SELECT p.parts_id, p.customer_id AS entity_id,
+ SELECT p.parts_id, p.credit_id AS entity_id,
p.pricegroup_id,
p.pricebreak, p.sellprice, p.validfrom,
p.validto, p.curr, g.pricegroup, 2 AS priority
@@ -78,7 +78,7 @@
UNION
- SELECT p.parts_id, p.customer_id AS entity_id,
+ SELECT p.parts_id, p.credit_id AS entity_id,
p.pricegroup_id,
p.pricebreak, p.sellprice, p.validfrom,
p.validto, p.curr, g.pricegroup, 3 AS priority
Modified: trunk/LedgerSMB/RP.pm
===================================================================
--- trunk/LedgerSMB/RP.pm 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/LedgerSMB/RP.pm 2010-12-06 20:17:51 UTC (rev 3109)
@@ -32,6 +32,8 @@
#======================================================================
package RP;
+use LedgerSMB::Log;
+our $logger = Log::Log4perl->get_logger('LedgerSMB::Form');
sub inventory_activity {
my ( $self, $myconfig, $form ) = @_;
@@ -187,7 +189,7 @@
$form->{interval} );
}
}
-
+
&get_accounts( $dbh, $last_period, $form->{fromdate}, $form->{todate},
$form, ..hidden.., 1 );
@@ -457,9 +459,9 @@
}
}
else {
- if ( $form->{asofyear} && $form->{asofmonth} ) {
+ if ( $form->{fromyear} && $form->{frommonth} ) {
( $null, $form->{asofdate} ) =
- $form->from_to( $form->{asofyear}, $form->{asofmonth} );
+ $form->from_to( $form->{fromyear}, $form->{frommonth} );
}
}
@@ -1842,7 +1844,7 @@
$sth->finish;
# get language
- my $query = qq|SELECT code, description FROM language ORDER BY 2|;
+ $query = qq|SELECT code, description FROM language ORDER BY 2|;
$sth = $dbh->prepare($query);
$sth->execute || $form->dberror($query);
@@ -1895,14 +1897,14 @@
$sth->finish;
# get gifi tax accounts
- my $query = qq|
+ $query = qq|
SELECT DISTINCT g.accno, g.description
FROM gifi g
JOIN chart c ON (c.gifi_accno= g.accno)
JOIN tax t ON (c.id = t.chart_id)
WHERE c.link LIKE '%${ARAP}_tax%'
ORDER BY accno|;
- my $sth = $dbh->prepare($query);
+ $sth = $dbh->prepare($query);
$sth->execute || $form->dberror;
while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) {
Modified: trunk/LedgerSMB/ScriptLib/Company.pm
===================================================================
--- trunk/LedgerSMB/ScriptLib/Company.pm 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/LedgerSMB/ScriptLib/Company.pm 2010-12-06 20:17:51 UTC (rev 3109)
@@ -518,8 +518,8 @@
$company->{dbh}->commit;
$company->get_metadata();
- $company->{creditlimit} = "$company->{creditlimit}";
- $company->{discount} = "$company->{discount}";
+ $company->{creditlimit} = $company->format_amount({amount => $company->{creditlimit}}) unless !defined $company->{creditlimit};
+ $company->{discount} = "$company->{discount}" unless !defined $company->{discount};
$company->{note_class_options} = [
{label => 'Entity', value => 1},
{label => $ec_labels->{"$company->{entity_class}"} . ' Account',
Modified: trunk/LedgerSMB/Template/LaTeX.pm
===================================================================
--- trunk/LedgerSMB/Template/LaTeX.pm 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/LedgerSMB/Template/LaTeX.pm 2010-12-06 20:17:51 UTC (rev 3109)
@@ -84,7 +84,6 @@
$vars =~ s/"(.*)"/``$1''/gs;
}
} else {
- print STDERR "Type: $type\n";
for ( keys %{$rawvars} ) {
$vars->{$_} = preprocess($rawvars->{$_});
}
Modified: trunk/LedgerSMB/Template.pm
===================================================================
--- trunk/LedgerSMB/Template.pm 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/LedgerSMB/Template.pm 2010-12-06 20:17:51 UTC (rev 3109)
@@ -108,6 +108,10 @@
This command checks for valid langages. Returns 1 if the language is valid,
0 if it is not.
+=item column_heading()
+
+Apply locale settings to column headings and add sort urls if necessary.
+
=back
=head1 Copyright 2007, The LedgerSMB Core Team
Modified: trunk/LedgerSMB/User.pm
===================================================================
--- trunk/LedgerSMB/User.pm 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/LedgerSMB/User.pm 2010-12-06 20:17:51 UTC (rev 3109)
@@ -546,7 +546,7 @@
DBI->connect( $form->{dbconnect}, $form->{dbuser},
$form->{dbpasswd} )
or $form->dberror( __FILE__ . ':' . __LINE__ );
- $dbh->{pg_enable_utf8};
+ $dbh->{pg_enable_utf8} = 1;
$query = qq|
SELECT tablename
@@ -950,7 +950,7 @@
my ($id) = $sth->fetchrow_array;
$sth->finish;
- my $query = qq|
+ $query = qq|
UPDATE employee
SET login = NULL,
enddate = current_date
Modified: trunk/LedgerSMB.pm
===================================================================
--- trunk/LedgerSMB.pm 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/LedgerSMB.pm 2010-12-06 20:17:51 UTC (rev 3109)
@@ -114,10 +114,48 @@
Removes all elements starting with a . because these elements conflict with the
ability to hide the entire structure for things like CSV lookups.
-= item get_default_value_by_key($key)
+=item get_default_value_by_key($key)
Retrieves a default value for the given key, it is just a wrapper on LedgerSMB::Setting;
+
+=item call_procedure( procname => $procname, args => $args )
+
+Function that allows you to call a stored procedure by name and map the appropriate argument to the function values
+
+=item dberror()
+
+Localizes and returns database errors and error codes within LedgerSMB
+
+=item error()
+
+Returns HTML errors in LedgerSMB. Needs refactored into a general Error class.
+
+=item get_user_info()
+
+Loads user configuration info from LedgerSMB::User
+
+=item round_amount()
+
+Uses Math::Float with an amount and a set number of decimal places to round the amount and return it.
+
+Defaults to the default decimal places setting in the LedgerSMB configuration if there is no places argument passed in.
+
+They should be changed to allow different rules for different accounts.
+
+=item sanitize_for_display()
+
+Expands a hash into human-readable key => value pairs, and formats and rounds amounts, recursively expanding hashes until there are no hash members present.
+
+=item take_top_level()
+
+Removes blank keys and non-reference keys from a hash and returns a hash with only non-blank and referenced keys.
+
+=item type()
+
+Ensures that the $ENV{REQUEST_METHOD} is defined and either "HEAD", "GET", "POST".
+
+
=back
@@ -168,15 +206,22 @@
my $logger = Log::Log4perl->get_logger('LedgerSMB');
sub new {
+ #my $type = "" unless defined shift @_;
+ #my $argstr = "" unless defined shift @_;
my $type = shift @_;
my $argstr = shift @_;
my %cookie;
my $self = {};
+ $type = "" unless defined $type;
+ $argstr = "" unless defined $argstr;
+
$logger->debug("Begin LedgerSMB.pm");
$self->{version} = $VERSION;
$self->{dbversion} = "1.2.0";
+ #bless $self if defined $self;
+ #bless $type if defined $type;
bless $self, $type;
$logger->debug("LedgerSMB::new: \$argstr = $argstr");
my $query = ($argstr) ? new CGI::Simple($argstr) : new CGI::Simple;
@@ -207,10 +252,12 @@
$cookie{$name} = $value;
}
}
-
+ $self->{action} = "" unless defined $self->{action};
$self->{action} =~ s/\W/_/g;
$self->{action} = lc $self->{action};
+ $self->{path} = "" unless defined $self->{path};
+
if ( $self->{path} eq "bin/lynx" ) {
$self->{menubar} = 1;
@@ -223,8 +270,11 @@
}
+ $ENV{SCRIPT_NAME} = "" unless defined $ENV{SCRIPT_NAME};
+
$ENV{SCRIPT_NAME} =~ m/([^\/\\]*.pl)\?*.*$/;
- $self->{script} = $1;
+ $self->{script} = $1 unless !defined $1;
+ $self->{script} = "" unless defined $self->{script};
if ( ( $self->{script} =~ m#(\.\.|\\|/)# ) ) {
$self->error("Access Denied");
@@ -362,6 +412,7 @@
my $self = shift;
my %args = @_;
my $str = $args{string};
+ $str = "" unless defined $str;
my $regex = qr/([^a-zA-Z0-9_.-])/;
$str =~ s/$regex/sprintf("%%%02x", ord($1))/ge;
@@ -372,10 +423,13 @@
my $self = shift @_;
my %args = @_;
my $name = $args{name};
+ my $rc;
+
if (not defined $name){
- # TODO: Raise error
+ $self->{_locale} = LedgerSMB::Locale->get_handle('en') unless defined $self->{_locale};
+ $self->error($self->{_locale}->text('Field \"Name\" Not Defined'));
}
- my $rc;
+
if ( $self->{$name} =~ /^\s*$/ ) {
$rc = 1;
}
@@ -460,6 +514,9 @@
my $places = $args{precision};
my $dash = $args{neg_format};
my $format = $args{format};
+
+ $dash = "" unless defined $dash;
+
if (!defined $format){
$format = $myconfig->{numberformat}
}
@@ -477,6 +534,7 @@
$negative = ( $amount < 0 );
$amount->babs();
+ $places = "" unless defined $places;
if ( $places =~ /\d+/ ) {
#$places = 4 if $places == 2;
@@ -494,6 +552,7 @@
if ( $format ) {
my ( $whole, $dec ) = split /\./, "$amount";
+ $dec = "" unless defined $dec;
$amount = join '', reverse split //, $whole;
if ($places) {
@@ -573,7 +632,7 @@
my $myconfig = $args{user} || $self->{_user};
my $amount = $args{amount};
- if ( $amount eq '' or ! defined $amount) {
+ if ( ! defined $amount or $amount eq '' ) {
return 0;
}
@@ -582,6 +641,7 @@
return $amount;
}
my $numberformat = $myconfig->{numberformat};
+ $numberformat = "" unless defined $numberformat;
if ( ( $numberformat eq '1.000,00' )
|| ( $numberformat eq '1000,00' ) )
@@ -620,7 +680,7 @@
# We will grab the default value, if it isnt defined
#
if (!defined $places){
- $places = ${LedgerSMB::Sysconfig::decimal_places};
+ $places = ${LedgerSMB::Sysconfig::decimal_places};
}
# These rounding rules follow from the previous implementation.
@@ -707,6 +767,7 @@
my ($self, $args) = @_;
my @roles = @{$args->{allowed_roles}};
for my $role (@roles){
+ $self->{_role_prefix} = "" unless defined $self->{_role_prefix};
my @roleset = grep m/^$self->{_role_prefix}$role$/, @{$self->{_roles}};
if (scalar @roleset){
return 1;
@@ -724,8 +785,10 @@
my $myconfig = $args{user};
my $date = $args{date};
+ $date = "" unless defined $date;
+
my ( $yy, $mm, $dd );
- if ( $date && $date =~ /\D/ ) {
+ if ( $date ne "" && $date && $date =~ /\D/ ) {
if ( $date =~ /^\d{4}-\d\d-\d\d$/ ) {
( $yy, $mm, $dd ) = split /\D/, $date;
@@ -872,7 +935,7 @@
|| ':' || f.field_name as field_def
FROM custom_table_catalog t
JOIN custom_field_catalog f USING (table_id)";
- my $sth = $self->{dbh}->prepare($query);
+ $sth = $self->{dbh}->prepare($query);
$sth->execute;
my $ref;
while ( $ref = $sth->fetchrow_hashref('NAME_lc') ) {
@@ -908,7 +971,7 @@
'22012' => $self->{_locale}->text('Division by 0 error'),
'22004' => $self->{_locale}->text('Required input not provided'),
'23502' => $self->{_locale}->text('Required input not provided'),
- '23505' => $self->{_locale}->text('Conflict with Existing Data'),
+ '23505' => $self->{_locale}->text('Conflict with Existing Data'),
'P0001' => $self->{_locale}->text('Error from Function:') . "\n" .
$self->{dbh}->errstr,
};
@@ -916,6 +979,7 @@
$self->{dbh}->err . ", string " .$self->{dbh}->errstr);
if (defined $state_error->{$self->{dbh}->state}){
$self->error($state_error->{$self->{dbh}->state});
+ $self->{dbh}->rollback;
exit;
}
$self->error($self->{dbh}->state . ":" . $self->{dbh}->errstr);
@@ -969,7 +1033,22 @@
else {
$dst_arg = $arg;
}
- $logger->debug("LedgerSMB.pm: merge setting $dst_arg to $src->{$arg}");
+ if ( defined $dst_arg && defined $src->{$arg} )
+ {
+ $logger->debug("LedgerSMB.pm: merge setting $dst_arg to $src->{$arg}");
+ }
+ elsif ( !defined $dst_arg && defined $src->{$arg} )
+ {
+ $logger->debug("LedgerSMB.pm: merge setting \$dst_arg is undefined \$src->{\$arg} is defined $src->{$arg}");
+ }
+ elsif ( defined $dst_arg && !defined $src->{$arg} )
+ {
+ $logger->debug("LedgerSMB.pm: merge setting \$dst_arg is defined $dst_arg \$src->{\$arg} is undefined");
+ }
+ elsif ( !defined $dst_arg && !defined $src->{$arg} )
+ {
+ $logger->debug("LedgerSMB.pm: merge setting \$dst_arg is undefined \$src->{\$arg} is undefined");
+ }
$self->{$dst_arg} = $src->{$arg};
}
}
Modified: trunk/UI/payments/payment2.html
===================================================================
--- trunk/UI/payments/payment2.html 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/UI/payments/payment2.html 2010-12-06 20:17:51 UTC (rev 3109)
@@ -302,7 +302,7 @@
<td align="center">
<input
name="overpayment_topay_<?lsmb overpayment_item -?>"
- id="overpayment_topay_<?lsmboverpayment_item ?>"
+ id="overpayment_topay_<?lsmb overpayment_item -?>"
value="<?lsmb IF unhandled_overpayment.value > 0 -?>
<?lsmb unhandled_overpayment.value -?>
<?lsmb END -?>"
@@ -357,4 +357,4 @@
</div>
</form>
</body>
-</html>
\ No newline at end of file
+</html>
Modified: trunk/UI/payments/payments_filter.html
===================================================================
--- trunk/UI/payments/payments_filter.html 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/UI/payments/payments_filter.html 2010-12-06 20:17:51 UTC (rev 3109)
@@ -51,6 +51,7 @@
<div id = "payments-filter-departments" class="input">
<label for="department"><?lsmb text('Department') ?></label>
<select name="department_id" id="department">
+ <option value=""></option>
<?lsmb FOREACH d = departments ?>
<option value="<?lsmb d.id ?>"><?lsmb d.description ?></option>
<?lsmb END ?>
@@ -76,6 +77,7 @@
<div id = "payments-filter-businesses" class="input">
<label for="businesses"><?lsmb text('Business Class') ?></label>
<select name="business_id" id="businesses">
+ <option value=""></option>
<?lsmb FOREACH b = businesses ?>
<option value="<?lsmb b.id ?>"><?lsmb b.description ?></option>
<?lsmb END ?>
Modified: trunk/bin/aa.pl
===================================================================
--- trunk/bin/aa.pl 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/bin/aa.pl 2010-12-06 20:17:51 UTC (rev 3109)
@@ -2234,7 +2234,7 @@
. "</th>";
}
- for (@column_index) { print STDERR qq|______ $_ => $column_data{$_} ______________|; print "\n$column_data{$_}" }
+ #for (@column_index) { print STDERR qq|______ $_ => $column_data{$_} ______________|; print "\n$column_data{$_}" }
if ( $myconfig{acs} !~ /$form->{ARAP}--$form->{ARAP}/ ) {
$i = 1;
Modified: trunk/bin/ca.pl
===================================================================
--- trunk/bin/ca.pl 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/bin/ca.pl 2010-12-06 20:17:51 UTC (rev 3109)
@@ -206,7 +206,11 @@
my $selectdepartment;
if ( @{ $form->{all_department} } ) {
$selectdepartment = {name => 'department', options => []};
- for ( @{ $form->{all_department} } ) {
+ push @{$selectdepartment->{options}}, {
+ value => '',
+ text => ''
+ };
+ for ( @{ $form->{all_department} } ) {
push @{$selectdepartment->{options}}, {
value => "$_->{description}--$_->{id}",
text => $_->{description}};
Modified: trunk/bin/ir.pl
===================================================================
--- trunk/bin/ir.pl 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/bin/ir.pl 2010-12-06 20:17:51 UTC (rev 3109)
@@ -1158,11 +1158,11 @@
$taxformfound=IR->taxform_exist($form,$form->{"vendor_id"});
- print STDERR qq|___Rowcount=$form->{rowcount} _______|;
+ #print STDERR qq|___Rowcount=$form->{rowcount} _______|;
foreach my $i(1..($form->{rowcount}))
{
- print STDERR qq| taxformcheck_$i = $form->{"taxformcheck_$i"} and taxformfound= $taxformfound ___________|;
+ #print STDERR qq| taxformcheck_$i = $form->{"taxformcheck_$i"} and taxformfound= $taxformfound ___________|;
if($form->{"taxformcheck_$i"} and $taxformfound)
{
Modified: trunk/bin/is.pl
===================================================================
--- trunk/bin/is.pl 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/bin/is.pl 2010-12-06 20:17:51 UTC (rev 3109)
@@ -1242,11 +1242,11 @@
$taxformfound=IS->taxform_exist($form,$form->{"customer_id"});
- print STDERR qq|___Rowcount=$form->{rowcount} _______|;
+ #print STDERR qq|___Rowcount=$form->{rowcount} _______|;
foreach my $i(1..($form->{rowcount}))
{
- print STDERR qq| taxformcheck_$i = $form->{"taxformcheck_$i"} and taxformfound= $taxformfound ___________|;
+ #print STDERR qq| taxformcheck_$i = $form->{"taxformcheck_$i"} and taxformfound= $taxformfound ___________|;
if($form->{"taxformcheck_$i"} and $taxformfound)
{
Modified: trunk/bin/rp.pl
===================================================================
--- trunk/bin/rp.pl 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/bin/rp.pl 2010-12-06 20:17:51 UTC (rev 3109)
@@ -134,7 +134,7 @@
# accounting years
$form->{selectaccountingyear} = {
- name => 'year',
+ name => 'fromyear',
options => [{text => '', value => ''}],
};
push @{$form->{selectaccountingyear}{options}}, {
@@ -143,7 +143,7 @@
} foreach ( @{ $form->{all_years} } );
$form->{selectaccountingmonth} = {
- name => 'month',
+ name => 'frommonth',
options => [{text => '', value => ''}],
};
push @{$form->{selectaccountingmonth}{options}}, {
Modified: trunk/payment.pl
===================================================================
--- trunk/payment.pl 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/payment.pl 2010-12-06 20:17:51 UTC (rev 3109)
@@ -1,3 +1,3 @@
-#!/usr/bin/perl
+#!/usr/bin/perl
require "lsmb-request.pl";
Modified: trunk/scripts/employee.pl
===================================================================
--- trunk/scripts/employee.pl 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/scripts/employee.pl 2010-12-06 20:17:51 UTC (rev 3109)
@@ -67,7 +67,7 @@
$employee->get();
- $employee->get_metadata();
+ #$employee->get_metadata();
_render_main_screen($employee);
@@ -170,7 +170,7 @@
sub _render_main_screen{
my $employee = shift @_;
- $employee->get_metadata();
+ #$employee->get_metadata();
$employee->{creditlimit} = "$employee->{creditlimit}";
$employee->{discount} = "$employee->{discount}";
Modified: trunk/scripts/payment.pl
===================================================================
--- trunk/scripts/payment.pl 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/scripts/payment.pl 2010-12-06 20:17:51 UTC (rev 3109)
@@ -113,7 +113,7 @@
template => 'form-dynatable',
format => ($request->{format}) ? $request->{format} : 'HTML',
);
- my $cols = qw(accno transdate source memo debit credit);
+ my $cols = "accno transdate source memo debit credit";
my $rows = [];
my $heading = {};
my $total = 0;
@@ -201,9 +201,15 @@
my $search_url = "$base_url";
for my $key (keys %{$request->take_top_level}){
if ($base_url =~ /\?$/){
- $base_url .= "$key=$request->{key}";
+ if ( defined $key && defined $request->{key} )
+ {
+ $base_url .= "$key=$request->{key}";
+ }
} else {
- $base_url .= "&$key=$request->{key}";
+ if ( defined $key && defined $request->{key} )
+ {
+ $base_url .= "&$key=$request->{key}";
+ }
}
}
@@ -426,6 +432,7 @@
for my $invoice (@{$_->{invoices}}){
if (($payment->{action} ne 'update_payments')
or (defined $payment->{"id_$_->{contact_id}"})){
+ $payment->{"paid_$_->{contact_id}"} = "" unless defined $payment->{"paid_$_->{contact_id}"};
if ($payment->{"paid_$_->{contact_id}"} eq 'some'){
my $i_id = $invoice->[0];
my $payment_amt = $payment->parse_amount(
@@ -688,7 +695,6 @@
my @project;
my @selected_checkboxes;
my @department;
-my @array_options;
my @currency_options;
my $exchangerate;
# LETS GET THE CUSTOMER/VENDOR INFORMATION
@@ -864,7 +870,7 @@
my @overpayment;
my @overpayment_account;
# Got to build the account selection box first.
-my @overpayment_account = $Payment->list_overpayment_accounting();
..hidden.. = $Payment->list_overpayment_accounting();
# Now we build the structure for the UI
for (my $i=1 ; $i <= $request->{overpayment_qty}; $i++) {
if (!$request->{"overpayment_checkbox_$i"}) {
Modified: trunk/scripts/recon.pl
===================================================================
--- trunk/scripts/recon.pl 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/scripts/recon.pl 2010-12-06 20:17:51 UTC (rev 3109)
@@ -460,7 +460,7 @@
my ($report_id, $entries) = $recon->new_report($recon->import_file());
$recon->{dbh}->commit;
if ($recon->{error}) {
- $recon->{error};
+ #$recon->{error};
$template = LedgerSMB::Template->new(
user=>$user,
@@ -627,7 +627,7 @@
# Load the corrections for a given report & entry id.
# possibly should use a "micro" popup window?
- my $recon = LedgerSMB::DBObject::Reconciliation->new(base => request, copy=> 'all');
+ my $recon = LedgerSMB::DBObject::Reconciliation->new(base => 'request', copy=> 'all');
my $template;
Modified: trunk/scripts/report.pl
===================================================================
--- trunk/scripts/report.pl 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/scripts/report.pl 2010-12-06 20:17:51 UTC (rev 3109)
@@ -8,7 +8,7 @@
my ($request) = @_;
my $template = $request->{template};
my $report = new LedgerSMB::DBObject::Report->new({base => $request });
- my $template = LedgerSMB::Template->new(
+ $template = LedgerSMB::Template->new(
user =>$request->{_user},
locale => $request->{_locale},
path => 'UI/report',
Modified: trunk/sql/Pg-database.sql
===================================================================
--- trunk/sql/Pg-database.sql 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/sql/Pg-database.sql 2010-12-06 20:17:51 UTC (rev 3109)
@@ -61,12 +61,13 @@
('AR_overpayment', FALSE, FALSE),
('AR_discount', FALSE, FALSE),
('AP_amount', FALSE, FALSE),
+('AP_expense', FALSE, FALSE),
('AP_tax', FALSE, FALSE),
('AP_paid', FALSE, FALSE),
('AP_overpayment', FALSE, FALSE),
('AP_discount', FALSE, FALSE),
('IC_sale', FALSE, FALSE),
-('IC_tax', FALSE, FALSE),
+('IC_tax', FALSE, FALSE),
('IC_cogs', FALSE, FALSE),
('IC_taxpart', FALSE, FALSE),
('IC_taxservice', FALSE, FALSE),
@@ -930,6 +931,7 @@
CREATE VIEW customer AS
SELECT
c.id,
+ e.name,
emd.entity_id,
emd.entity_class,
emd.discount,
@@ -949,14 +951,16 @@
eba.iban,
ein.note as invoice_notes
FROM entity_credit_account emd
- join entity_bank_account eba on emd.entity_id = eba.entity_id
+ LEFT JOIN entity_bank_account eba on emd.entity_id = eba.entity_id
Left join entity_note ein on ein.ref_key = emd.entity_id
join company c on c.entity_id = emd.entity_id
+ join entity e on c.entity_id = e.id
where emd.entity_class = 2;
CREATE VIEW vendor AS
SELECT
- c.id,
+ c.id,
+ e.name,
emd.entity_id,
emd.entity_class,
emd.discount,
@@ -979,6 +983,7 @@
LEFT join entity_bank_account eba on emd.entity_id = eba.entity_id
left join entity_note ein on ein.ref_key = emd.entity_id
join company c on c.entity_id = emd.entity_id
+ join entity e on c.entity_id = e.id
where emd.entity_class = 1;
COMMENT ON TABLE entity_credit_account IS $$ This is a metadata table for ALL entities in LSMB; it deprecates the use of customer and vendor specific tables (which were nearly identical and largely redundant), and replaces it with a single point of metadata. $$;
Modified: trunk/sql/modules/1099_reports.sql
===================================================================
--- trunk/sql/modules/1099_reports.sql 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/sql/modules/1099_reports.sql 2010-12-06 20:17:51 UTC (rev 3109)
@@ -21,12 +21,13 @@
duedate text);
CREATE OR REPLACE FUNCTION tax_form__list_all()
-RETURNS SETOF country_tax_form as
-$$
-select * from country_tax_form order by country_id;
-$$ language sql;
+RETURNS SETOF country_tax_form AS
+$BODY$
+SELECT * FROM country_tax_form ORDER BY country_id;
+$BODY$ LANGUAGE SQL;
-CREATE OR REPLACE FUNCTION tax_form_summary_report(in_tax_form_id int, in_begin date, in_end date) RETURNS setof tax_form_report_item AS $$
+CREATE OR REPLACE FUNCTION tax_form_summary_report(in_tax_form_id int, in_begin date, in_end date)
+RETURNS SETOF tax_form_report_item AS $BODY$
DECLARE
out_row tax_form_report_item;
BEGIN
@@ -70,14 +71,15 @@
JOIN country_tax_form ON (entity_credit_account.taxform_id = country_tax_form.id)
WHERE country_tax_form.id = in_tax_form_id
AND transdate BETWEEN in_begin AND in_end
- GROUP BY legal_name, meta_number, company.entity_id, entity_credit_account.entity_class, entity.control_code
- LOOP
+ GROUP BY legal_name, meta_number, company.entity_id, entity_credit_account.entity_class, entity.control_code
+ LOOP
RETURN NEXT out_row;
END LOOP;
END;
-$$ LANGUAGE plpgsql;
+$BODY$ LANGUAGE PLPGSQL;
-CREATE OR REPLACE FUNCTION tax_form_details_report(in_tax_form_id int, in_begin date, in_end date, in_meta_number text) RETURNS setof tax_form_report_detail_item AS $$
+CREATE OR REPLACE FUNCTION tax_form_details_report(in_tax_form_id int, in_begin date, in_end date, in_meta_number text)
+RETURNS SETOF tax_form_report_detail_item AS $BODY$
DECLARE
out_row tax_form_report_detail_item;
BEGIN
@@ -130,4 +132,4 @@
RETURN NEXT out_row;
END LOOP;
END;
-$$ LANGUAGE plpgsql;
+$BODY$ LANGUAGE PLPGSQL;
Modified: trunk/sql/modules/Account.sql
===================================================================
--- trunk/sql/modules/Account.sql 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/sql/modules/Account.sql 2010-12-06 20:17:51 UTC (rev 3109)
@@ -22,12 +22,23 @@
DECLARE
account chart%ROWTYPE;
BEGIN
- SELECT * INTO account FROM chart WHERE id = in_id;
+ SELECT * INTO account FROM chart WHERE id = in_id AND charttype = 'A';
RETURN account;
END;
$$ LANGUAGE plpgsql;
+CREATE OR REPLACE FUNCTION account_heading_get (in_id int) RETURNS chart AS
+$$
+DECLARE
+ account chart%ROWTYPE;
+BEGIN
+ SELECT * INTO account FROM chart WHERE id = in_id AND charttype = 'H';
+ RETURN account;
+END;
+$$ LANGUAGE plpgsql;
+
+
CREATE OR REPLACE FUNCTION account_has_transactions (in_id int) RETURNS bool AS
$$
BEGIN
@@ -155,11 +166,11 @@
v_chart_id int;
BEGIN
-- Check for existence of the account already
- PERFORM * FROM cr_coa_to_account WHERE in_accno = in_accno;
+ PERFORM * FROM cr_coa_to_account WHERE account = in_accno;
IF NOT FOUND THEN
-- This is a new account. Insert the relevant data.
- SELECT chart_id INTO v_chart_id FROM charts WHERE accno = in_accno;
+ SELECT id INTO v_chart_id FROM chart WHERE accno = in_accno;
INSERT INTO cr_coa_to_account (chart_id, account) VALUES (v_chart_id, in_accno||'--'||in_description);
END IF;
-- Already found, no need to do anything. =)
Modified: trunk/sql/modules/Drafts.sql
===================================================================
--- trunk/sql/modules/Drafts.sql 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/sql/modules/Drafts.sql 2010-12-06 20:17:51 UTC (rev 3109)
@@ -24,12 +24,13 @@
ELSE 0
END) as amount
FROM (
- SELECT id, transdate, reference, description,
- approved from gl
+ SELECT id, transdate, reference,
+ (SELECT name FROM eca__get_entity(entity_credit_account)),
+ approved from gl
WHERE lower(in_type) = 'gl'
UNION
SELECT id, transdate, invnumber as reference,
- description::text,
+ (SELECT name FROM eca__get_entity(entity_credit_account)),
approved from ap
WHERE lower(in_type) = 'ap'
UNION
Modified: trunk/sql/modules/Entity.sql
===================================================================
--- trunk/sql/modules/Entity.sql 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/sql/modules/Entity.sql 2010-12-06 20:17:51 UTC (rev 3109)
@@ -67,3 +67,21 @@
$$ language plpgsql;
+CREATE OR REPLACE FUNCTION eca__get_entity (
+ in_credit_id int
+) RETURNS setof entity AS $$
+
+declare
+ v_row entity;
+BEGIN
+ SELECT entity.* INTO v_row FROM entity_credit_account JOIN entity ON entity_credit_account.entity_id = entity.id WHERE entity_credit_account.id = in_credit_id;
+ IF NOT FOUND THEN
+ raise exception 'Could not find entity with ID %', in_credit_id;
+ ELSE
+ return next v_row;
+ END IF;
+END;
+
+$$ language plpgsql;
+
+
Modified: trunk/sql/modules/Payment.sql
===================================================================
--- trunk/sql/modules/Payment.sql 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/sql/modules/Payment.sql 2010-12-06 20:17:51 UTC (rev 3109)
@@ -65,13 +65,13 @@
JOIN company cp ON (cp.entity_id = e.id)
WHERE ec.entity_class = in_account_class
AND CASE WHEN in_account_class = 1 THEN
- e.id IN (SELECT entity_id FROM ap
+ ec.id IN (SELECT entity_credit_account FROM ap
WHERE amount <> paid
- GROUP BY entity_id)
+ GROUP BY entity_credit_account)
WHEN in_account_class = 2 THEN
- e.id IN (SELECT entity_id FROM ar
+ ec.id IN (SELECT entity_credit_account FROM ar
WHERE amount <> paid
- GROUP BY entity_id)
+ GROUP BY entity_credit_account)
END
LOOP
RETURN NEXT out_entity;
Modified: trunk/sql/modules/Roles.sql
===================================================================
--- trunk/sql/modules/Roles.sql 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/sql/modules/Roles.sql 2010-12-06 20:17:51 UTC (rev 3109)
@@ -614,8 +614,8 @@
WITH INHERIT NOLOGIN
IN ROLE "lsmb_<?lsmb dbname ?>__ar_transaction_list";
-GRANT INSERT, SELECT ON payment, payment_links, overpayment
-TO "lsmb_<?lsmb dbname ?>__receipt_proces";
+GRANT INSERT, SELECT ON payment, payment_links, overpayments
+TO "lsmb_<?lsmb dbname ?>__receipt_process";
GRANT INSERT ON acc_trans TO "lsmb_<?lsmb dbname ?>__receipt_process";
GRANT ALL ON acc_trans_entry_id_seq TO "lsmb_<?lsmb dbname ?>__receipt_process";
Modified: trunk/sql/modules/Voucher.sql
===================================================================
--- trunk/sql/modules/Voucher.sql 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/sql/modules/Voucher.sql 2010-12-06 20:17:51 UTC (rev 3109)
@@ -184,8 +184,8 @@
FROM batch b
JOIN batch_class c ON (b.batch_class_id = c.id)
LEFT JOIN users u ON (u.entity_id = b.created_by)
- JOIN voucher v ON (v.batch_id = b.id)
- JOIN batch_class vc ON (v.batch_class = vc.id)
+ LEFT JOIN voucher v ON (v.batch_id = b.id)
+ LEFT JOIN batch_class vc ON (v.batch_class = vc.id)
LEFT JOIN ar ON (vc.id = 2 AND v.trans_id = ar.id)
LEFT JOIN ap ON (vc.id = 1 AND v.trans_id = ap.id)
LEFT JOIN acc_trans al ON
@@ -433,12 +433,12 @@
BEGIN
SELECT * INTO voucher_row FROM voucher WHERE id = in_voucher_id;
IF voucher_row.batch_class IN (1, 2, 5) THEN
- DELETE FROM ac_tax_form WHERE entry_id IN (
- SELECT entry_id
- from acc_trans
- WHERE trans_id = voucher_row.trans_id);
-
- DELETE from acc_trans WHERE trans_id = voucher_row.trans_id;
+ DELETE FROM ac_tax_form WHERE entry_id IN (
+ SELECT entry_id
+ FROM acc_trans
+ WHERE trans_id = voucher_row.trans_id);
+
+ DELETE FROM acc_trans WHERE trans_id = voucher_row.trans_id;
DELETE FROM ar WHERE id = voucher_row.trans_id;
DELETE FROM ap WHERE id = voucher_row.trans_id;
DELETE FROM gl WHERE id = voucher_row.trans_id;
Modified: trunk/sql/modules/test/Taxform.sql
===================================================================
--- trunk/sql/modules/test/Taxform.sql 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/sql/modules/test/Taxform.sql 2010-12-06 20:17:51 UTC (rev 3109)
@@ -235,4 +235,4 @@
|| (select count(*) from test_result where success is not true)
|| ' failed' as message;
-ROLLBACK;
\ No newline at end of file
+ROLLBACK;
Modified: trunk/t/02-number-handling.t
===================================================================
--- trunk/t/02-number-handling.t 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/t/02-number-handling.t 2010-12-06 20:17:51 UTC (rev 3109)
@@ -5,7 +5,8 @@
$ENV{TMPDIR} = 't/var';
-use Test::More 'no_plan';
+#use Test::More 'no_plan';
+use Test::More tests => 1172;
use Test::Trap qw(trap $trap);
use Math::BigFloat;
Modified: trunk/t/04-template-handling.t
===================================================================
--- trunk/t/04-template-handling.t 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/t/04-template-handling.t 2010-12-06 20:17:51 UTC (rev 3109)
@@ -38,6 +38,11 @@
##############
## AM tests ##
##############
+my $expStackTrace = 0;
+if ( $ENV{PERL5OPT}=~/.*?Devel::SimpleTrace.*/ || $ENV{PERL5OPT}=~/.*?Carp::Always.*/ )
+{
+ $expStackTrace = 1;
+}
# AM->check_template_name checks
# check_template operates by calling $form->error if the checks fail
@@ -55,38 +60,129 @@
'AM, check_template_name: CSS directory, txt');
$form->{file} = 'test2/apples.txt';
@r = trap{AM->check_template_name($myconfig, $form)};
-is($trap->die, "Error: Not in a whitelisted directory: test2/apples.txt\n",
- 'AM, check_template_name: Invalid directory, non-css denial');
+if ( $expStackTrace == 0 )
+{
+ is($trap->die, "Error: Not in a whitelisted directory: test2/apples.txt\n",
+ 'AM, check_template_name: Invalid directory, non-css denial');
+}
+else
+{
+ my $trapmsg="";
+ if ($trap->die =~/(Error: Not in a whitelisted directory: test2\/apples.txt\n).*/)
+ {
+ $trapmsg = $1;
+ }
+ is($trapmsg, "Error: Not in a whitelisted directory: test2/apples.txt\n",
+ 'AM, check_template_name: Invalid directory, non-css denial');
+}
$form->{file} = 'test/apples.exe';
@r = trap{AM->check_template_name($myconfig, $form)};
-is($trap->die, "Error: Error: File is of type that is not allowed.\n",
- 'AM, check_template_name: Disallowed type denial');
+if ( $expStackTrace == 0 )
+{
+ is($trap->die, "Error: Error: File is of type that is not allowed.\n",
+ 'AM, check_template_name: Disallowed type denial');
+}
+else
+{
+ my $trapmsg="";
+ if ($trap->die =~/(Error: Error: File is of type that is not allowed.\n).*/)
+ {
+ $trapmsg = $1;
+ }
+ is($trapmsg, "Error: Error: File is of type that is not allowed.\n",
+ 'AM, check_template_name: Disallowed type denial');
+}
# adjusting backuppath to avoid triggering directory traversal detection
$temp = ${LedgerSMB::Sysconfig::backuppath};
${LedgerSMB::Sysconfig::backuppath} = "foo";
$form->{file} = "${LedgerSMB::Sysconfig::backuppath}/apples.txt";
@r = trap{AM->check_template_name($myconfig, $form)};
-is($trap->die, "Error: Not allowed to access foo/ with this method\n",
- 'AM, check_template_name: Backup path denial');
+if ( $expStackTrace == 0 )
+{
+ is($trap->die, "Error: Not allowed to access foo/ with this method\n",
+ 'AM, check_template_name: Backup path denial');
+}
+else
+{
+ my $trapmsg="";
+ if ($trap->die =~/(Error: Not allowed to access foo\/ with this method\n).*/)
+ {
+ $trapmsg = $1;
+ }
+ is($trapmsg, "Error: Not allowed to access foo/ with this method\n",
+ 'AM, check_template_name: Backup path denial');
+}
${LedgerSMB::Sysconfig::backuppath} = $temp;
$form->{file} = "css/../apples.txt";
@r = trap{AM->check_template_name($myconfig, $form)};
-is($trap->die, "Error: Directory transversal not allowed.\n",
- 'AM, check_template_name: Directory transversal denial 1');
+if ( $expStackTrace == 0 )
+{
+ is($trap->die, "Error: Directory transversal not allowed.\n",
+ 'AM, check_template_name: Directory transversal denial 1');
+}
+else
+{
+ my $trapmsg="";
+ if ($trap->die =~/(Error: Directory transversal not allowed.\n).*/)
+ {
+ $trapmsg = $1;
+ }
+ is($trapmsg, "Error: Directory transversal not allowed.\n",
+ 'AM, check_template_name: Directory transversal denial 1');
+}
$form->{file} = "/tmp/apples.txt";
@r = trap{AM->check_template_name($myconfig, $form)};
-is($trap->die, "Error: Directory transversal not allowed.\n",
- 'AM, check_template_name: Directory transversal denial 2');
+if ( $expStackTrace == 0 )
+{
+ is($trap->die, "Error: Directory transversal not allowed.\n",
+ 'AM, check_template_name: Directory transversal denial 2');
+}
+else
+{
+ my $trapmsg="";
+ if ($trap->die =~/(Error: Directory transversal not allowed.\n).*/)
+ {
+ $trapmsg = $1;
+ }
+ is($trapmsg, "Error: Directory transversal not allowed.\n",
+ 'AM, check_template_name: Directory transversal denial 2');
+}
$form->{file} = "test/apples.txt:evil";
@r = trap{AM->check_template_name($myconfig, $form)};
-is($trap->die, "Error: Directory transversal not allowed.\n",
- 'AM, check_template_name: Directory transversal denial 3');
+if ( $expStackTrace == 0 )
+{
+ is($trap->die, "Error: Directory transversal not allowed.\n",
+ 'AM, check_template_name: Directory transversal denial 3');
+}
+else
+{
+ my $trapmsg="";
+ if ($trap->die =~/(Error: Directory transversal not allowed.\n).*/)
+ {
+ $trapmsg = $1;
+ }
+ is($trapmsg, "Error: Directory transversal not allowed.\n",
+ 'AM, check_template_name: Directory transversal denial 3');
+}
$form->{file} = "c:\\evil.txt";
@r = trap{AM->check_template_name($myconfig, $form)};
-is($trap->die, "Error: Directory transversal not allowed.\n",
- 'AM, check_template_name: Directory transversal denial 4');
+if ( $expStackTrace == 0 )
+{
+ is($trap->die, "Error: Directory transversal not allowed.\n",
+ 'AM, check_template_name: Directory transversal denial 4');
+}
+else
+{
+ my $trapmsg="";
+ if ($trap->die =~/(Error: Directory transversal not allowed.\n).*/)
+ {
+ $trapmsg = $1;
+ }
+ is($trapmsg, "Error: Directory transversal not allowed.\n",
+ 'AM, check_template_name: Directory transversal denial 4');
+}
# AM->load_template checks
# load_template takes its file name from form
@@ -94,8 +190,21 @@
$myconfig = {'templates' => 't/data'};
$form->{file} = 't/data/04-not-there.txt';
@r = trap{AM->load_template($myconfig, $form)};
-is($trap->die, "Error: t/data/04-not-there.txt : No such file or directory\n",
- 'AM, load_template: Die on non-existent file');
+if ( $expStackTrace == 0 )
+{
+ is($trap->die, "Error: t/data/04-not-there.txt : No such file or directory\n",
+ 'AM, load_template: Die on non-existent file');
+}
+else
+{
+ my $trapmsg="";
+ if ($trap->die =~/(Error: t\/data\/04-not-there.txt : No such file or directory\n).*/)
+ {
+ $trapmsg = $1;
+ }
+ is($trapmsg, "Error: t/data/04-not-there.txt : No such file or directory\n",
+ 'AM, load_template: Die on non-existent file');
+}
$form->{file} = 't/data/04-template.html';
AM->load_template($myconfig, $form);
is($form->{body}, "I am a template.\nLook at me <?lsmb login ?>.\n",
@@ -107,9 +216,23 @@
$form->{body} = "I am a template.\nLook at me.\n";
$form->{file} = "$myconfig->{templates}/test.txt";
@r = trap{AM->save_template($myconfig, $form)};
-is($trap->die,
- "Error: t/var/not here/test.txt : No such file or directory\n",
- 'AM, save_template: Die on unwritable file');
+if ( $expStackTrace == 0 )
+{
+ is($trap->die,
+ "Error: t/var/not here/test.txt : No such file or directory\n",
+ 'AM, save_template: Die on unwritable file');
+}
+else
+{
+ my $trapmsg="";
+ if ($trap->die =~/(Error: t\/var\/not here\/test.txt : No such file or directory\n).*/)
+ {
+ $trapmsg = $1;
+ }
+ is($trapmsg,
+ "Error: t/var/not here/test.txt : No such file or directory\n",
+ 'AM, save_template: Die on unwritable file');
+}
$myconfig = {'templates' => 't/var'};
$form->{body} = "I am a template.\nLook at me.";
$form->{file} = "$myconfig->{templates}/04-template-save-test-$$.txt";
Modified: trunk/t/10-form.t
===================================================================
--- trunk/t/10-form.t 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/t/10-form.t 2010-12-06 20:17:51 UTC (rev 3109)
@@ -90,6 +90,12 @@
ok(defined $form);
isa_ok($form, 'Form');
+my $expStackTrace = 0;
+if ( $ENV{PERL5OPT}=~/.*?Devel::SimpleTrace.*/ || $ENV{PERL5OPT}=~/.*?Carp::Always.*/ )
+{
+ $expStackTrace = 1;
+}
+
## $form->escape checks
$utfstr = "\xd8\xad";
utf8::decode($utfstr);
@@ -120,10 +126,10 @@
cmp_ok($form->unescape('%20'), 'eq', ' ', 'unescape: %20');
cmp_ok($form->unescape("foo\r\n"), 'eq', "foo\n", 'unescape: foo\r\n');
ok(utf8::is_utf8($form->unescape('foo%d8%ad')), 'unescape: (utf8 output)');
-cmp_ok(unpack("H*", $form->unescape('%d8%ad')), 'eq',
- unpack("H*", $utfstr), 'unescape: %d8%ad');
-cmp_ok(unpack("H*", $form->unescape($form->unescape('%d8%ad'))), 'eq',
- unpack("H*", $utfstr), '(2x) unescape: %d8%ad');
+cmp_ok(unpack("U", $form->unescape('%d8%ad')), 'eq',
+ unpack("U", $utfstr), 'unescape: %d8%ad');
+cmp_ok(unpack("U", $form->unescape($form->unescape('%d8%ad'))), 'eq',
+ unpack("U", $utfstr), '(2x) unescape: %d8%ad');
## $form->quote checks
ok(!defined $form->quote(), 'quote: (undef)');
@@ -237,8 +243,21 @@
$form->{pre} = 'Blah';
$form->{header} = 'Blah';
@r = trap{$form->error('hello world')};
-is($trap->die, "Error: hello world\n",
- 'error: CLI, content, terminated');
+if ( $expStackTrace == 0 )
+{
+ is($trap->die, "Error: hello world\n",
+ 'error: CLI, content, terminated');
+}
+else
+{
+ my $trapmsg="";
+ if ($trap->die =~/(Error: hello world\n).*/)
+ {
+ $trapmsg = $1;
+ }
+ is($trapmsg, "Error: hello world\n",
+ 'error: CLI, content, terminated');
+}
ok($form->{pre}, 'error: CLI, ignored $self->{pre}');
$ENV{error_function} = 'main::form_error_func';
@@ -248,8 +267,21 @@
@r = trap{$form->error('hello world')};
is($trap->stdout, 'hello world',
'error: CLI, function call called');
+if ( $expStackTrace == 0 )
+{
is($trap->die, "Error: hello world\n",
'error: CLI, function call termination');
+}
+else
+{
+ my $trapmsg="";
+ if ($trap->die =~/(Error: hello world\n).*/)
+ {
+ $trapmsg = $1;
+ }
+ is($trapmsg, "Error: hello world\n",
+ 'error: CLI, function call termination');
+}
};
## $form->isblank checks
Modified: trunk/t/11-ledgersmb.t
===================================================================
--- trunk/t/11-ledgersmb.t 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/t/11-ledgersmb.t 2010-12-06 20:17:51 UTC (rev 3109)
@@ -176,6 +176,8 @@
ok(defined $lsmb->{version}, 'new: blank, version defined');
$lsmb = LedgerSMB->new('path=bin/lynx');
+#$lsmb = LedgerSMB->new();
+#$lsmb->{path} = "bin/lynx";
ok(defined $lsmb, 'new: lynx, defined');
isa_ok($lsmb, 'LedgerSMB', 'new: lynx, correct type');
ok(defined $lsmb->{action}, 'new: lynx, action defined');
@@ -228,6 +230,8 @@
@r = $lsmb->call_procedure('procname' => 'pi', 'schema'=>'pg_catalog');
like($r[0]->{'pi'}, qr/^3.14/,
'call_procedure: no args, non-numeric return');
+ $lsmb->{dbh}->rollback();
+ $lsmb->{dbh}->disconnect;
}
# $lsmb->merge checks
Modified: trunk/t/42-dbobject.t
===================================================================
--- trunk/t/42-dbobject.t 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/t/42-dbobject.t 2010-12-06 20:17:51 UTC (rev 3109)
@@ -22,7 +22,7 @@
my $passes = 0;
for (LedgerSMB::DBObject->_parse_array($test)){
- is($_, shift @vals, "pass $pass, array parse test");
+ is($_, shift @vals, "pass $passes, array parse test");
}
my $test2 = '{{1,1,1,1},{1,2,2,2},{1,3,3,4}}';
my @test_arry2_c = ( [1,1,1,1], [1,2,2,2], [1,3,3,4]);
Modified: trunk/t/89-dropdb.t
===================================================================
--- trunk/t/89-dropdb.t 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/t/89-dropdb.t 2010-12-06 20:17:51 UTC (rev 3109)
@@ -2,7 +2,7 @@
use strict;
my $temp = $ENV{TEMP} || '/tmp/';
-my $run_tests = 5;
+my $run_tests = 6;
for my $evar (qw(LSMB_NEW_DB LSMB_TEST_DB PG_CONTRIB_DIR)){
if (!defined $ENV{$evar}){
$run_tests = 0;
@@ -14,7 +14,7 @@
}
if ($run_tests){
- plan tests => 5;
+ plan tests => 6;
$ENV{PGDATABASE} = $ENV{LSMB_NEW_DB};
}
@@ -25,3 +25,16 @@
ok(!system ("dropdb $ENV{LSMB_NEW_DB}"), 'dropped db');
ok(close (DBLOCK), 'Closed db lock file');
ok(unlink ("$temp/LSMB_TEST_DB"), 'Removed test db lockfile');
+
+# We clean up the test DB roles.
+open (PSQL, '|-', "psql");
+
+(open (ROLES, '<', 'sql/modules/test/Drop_Roles.sql') && pass("Roles description found"))
+|| fail("Roles description found");
+
+for my $roleline (<ROLES>){
+ $roleline =~ s/<\?lsmb dbname \?>/$ENV{LSMB_NEW_DB}/;
+ print PSQL $roleline;
+ }
+
+close (PSQL);
Modified: trunk/t/data/62-request-data
===================================================================
--- trunk/t/data/62-request-data 2010-10-28 20:45:39 UTC (rev 3108)
+++ trunk/t/data/62-request-data 2010-12-06 20:17:51 UTC (rev 3109)
@@ -351,6 +351,7 @@
delete $GLOBAL{batch_no};
# save form_id and batch number for additional requests
$GLOBAL{"form_id"} = $1 if ($res->content =~ m/input type=hidden name="form_id" value="(\d+)"/);
+ $GLOBAL{"form_id"} = "" unless defined $GLOBAL{"form_id"};
ok($GLOBAL{form_id}, "Received form ID: ".$GLOBAL{form_id});
$GLOBAL{batch_no} = $1 if ($res->content =~ m/input name="batch_number" type="text" value="([A-Z]-\d+)"/);
@@ -388,12 +389,14 @@
"_lwp_tests" => sub {
my $res = shift;
my $batch_no = $GLOBAL{batch_no};
- my $batch_id;
+ my $batch_id = "";
+ $batch_no = "" unless defined $GLOBAL{batch_no};
delete @GLOBAL{ qw( form_id row_1 )};
$GLOBAL{"form_id"} = $1 if ($res->content =~ m/input id="form-id" type="hidden" name="form_id" value="(\d+)"\s+\/\>/);
$batch_id = $1 if ($res->content =~ m/\<a href="vouchers.pl\?action=get_batch&batch_id=(\d+)"\>$batch_no\<\/a\>/);
$GLOBAL{"row_1"} = $batch_id if ($res->content =~ m/<input id="batch-${batch_id}" type="checkbox" name="batch_${batch_id}" value="\d"\s+\/\>/);
+ $GLOBAL{"row_1"} = "" unless defined $GLOBAL{"row_1"};
$GLOBAL{batch_id} = "batch_".$batch_id;
ok(exists $GLOBAL{"row_1"}, 'Received correct batch ID '.$GLOBAL{row_1});
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.