Form.pm now uses strit mode except in the constructor

git-svn-id: https://ledger-smb.svn.sourceforge.net/svnroot/ledger-smb/trunk@1606 4979c152-3d1c-0410-bac9-87ea11338e46

2 files changed, 161 insertions, 61 deletions

diff --git a/LedgerSMB/DBObject/Payment.pm b/LedgerSMB/DBObject/Payment.pm
index 8d299311..0cd63c38 100644
--- a/LedgerSMB/DBObject/Payment.pm
+++ b/LedgerSMB/DBObject/Payment.pm
@@ -1,6 +1,20 @@
 
-=head1:  LedgerSMB::DBObject::Payment:  Stub function for payments.
-=head1:  Copyright (c) 2007.  LedgerSMB Core Team 
+=head1 NAME
+
+LedgerSMB::Payment:  Payment Handling Back-end Routines for LedgerSMB
+
+=head1 SYNOPSIS
+
+Provides the functions for generating the data structures payments made in 
+LedgerSMB.   This module currently handles only basic payment logic, and does
+handle overpayment logic, though these features will be moved into this module
+in the near future.
+
+=head1 COPYRIGHT
+
+Copyright (c) 2007 The LedgerSMB Core Team.  Licensed under the GNU General 
+Public License version 2 or at your option any later version.  Please see the
+included COPYRIGHT and LICENSE files for more information.
 
 =cut
 
@@ -10,6 +24,31 @@ use strict;
 use Math::BigFloat lib => 'GMP';
 our $VERSION = '0.1.0';
 
+=head1 METHODS
+
+=over
+
+=item LedgerSMB::DBObject::Payment->new()
+
+Inherited from LedgerSMB::DBObject.  Please see that documnetation for details.
+
+=item $oayment->get_open_accounts()
+
+This function returns a list of open accounts depending on the 
+$payment->{account_class} property.  If this property is 1, it returns a list 
+of vendor accounts, for 2, a list of customer accounts are returned.
+
+The returned list of hashrefs is stored in the $payment->{accounts} property.
+Each hashref has the following keys:  id (entity id), name, and entity_class.
+
+An account is considered open if there are outstanding, unpaid invoices 
+attached to it.  Customer/vendor payment threshold is not considered for this 
+calculation.
+
+=back
+
+=cut
+
 sub get_open_accounts {
     my ($self) = @_;
     @{$self->{accounts}} = 
@@ -17,6 +56,21 @@ sub get_open_accounts {
     return @{$self->{accounts}};
 }
 
+=over
+
+=item $oayment->get_all_accounts()
+
+This function returns a list of open or closed accounts depending on the 
+$payment->{account_class} property.  If this property is 1, it returns a list 
+of vendor accounts, for 2, a list of customer accounts are returned.
+
+The returned list of hashrefs is stored in the $payment->{accounts} property.
+Each hashref has the following keys:  id (entity id), name, and entity_class.
+
+=back
+
+=cut
+
 sub get_all_accounts {
     my ($self) = @_;
     @{$self->{accounts}} = 
@@ -24,6 +78,23 @@ sub get_all_accounts {
     return @{$self->{accounts}};
 }
 
+=over
+
+=item $oayment->get_open_invoices()
+
+This function returns a list of open invoices depending on the 
+$payment->{account_class}, $payment->{entity_id}, and $payment->{currency} 
+properties.  Account classes follow the conventions above.  This list is hence
+specific to a customer or vendor and currency as well.
+
+The returned list of hashrefs is stored in the $payment->{open_invoices} 
+property. Each hashref has the following keys:  id (entity id), name, and 
+entity_class.
+
+=back
+
+=cut
+
 sub get_open_invoices {
     my ($self) = @_;
     @{$self->{open_invoices}} = 
@@ -31,6 +102,39 @@ sub get_open_invoices {
     return @{$self->{open_invoices}};
 }
 
+=over
+
+=item $oayment->get_all_contact_invoices()
+
+This function returns a list of open accounts depending on the 
+$payment->{account_class} property.  If this property is 1, it returns a list 
+of vendor accounts, for 2, a list of customer accounts are returned.  Attached
+to each account is a list of open invoices.  The data structure is somewhat 
+complex.
+
+Each item in the list has the following keys: contact_id, contact_name, \
+account_number, total_due, and invoices.
+
+The invoices entry is a reference to an array of hashrefs.  Each of these 
+hashrefs has the following keys: invoice_id, invnumber, invoice_date, amount, 
+discount, and due.
+
+These are filtered based on the (required) properties:
+$payment->{account_class}, $payment->{business_type}, $payment->{date_from},
+$payment->{date_to}, and $payment->{ar_ap_accno}.
+
+The $payment->{ar_ap_accno} property is used to filter out by AR or AP account.
+
+The following can also be optionally passed: $payment->{batch_id}.  If this is 
+patched, vouchers in the current batch will be picked up as well.
+
+The returned list of hashrefs is stored in the $payment->{contact} property.
+Each hashref has the following keys:  id (entity id), name, and entity_class.
+
+=back
+
+=cut
+
 sub get_all_contact_invoices {
     my ($self) = @_;
     @{$self->{contacts}} = 
diff --git a/LedgerSMB/Form.pm b/LedgerSMB/Form.pm
index 60d0ec19..99a41184 100644
--- a/LedgerSMB/Form.pm
+++ b/LedgerSMB/Form.pm
@@ -67,7 +67,6 @@ use File::Copy;
 
 use charnames ':full';
 use open ':utf8';
-
 package Form;
 
 =item new Form([$argstr])
@@ -85,6 +84,9 @@ $form->error may be called to deny access on some attribute values.
 =cut
 
 sub new {
+    # Without the line below, we get unknown errors.  I guess this is an
+    # indication of why this module is deprecated :-)-- CT
+    no strict;
 
     my $type = shift;
 
@@ -617,7 +619,7 @@ sub sort_order {
         $a[0] .= " $self->{direction}";
     }
 
-    $sortorder = join ',', @a;
+    my $sortorder = join ',', @a;
     $sortorder;
 }
 
@@ -843,7 +845,7 @@ sub db_parse_numeric {
     my @names = @{$sth->{NAME_lc}};
     for (0 .. $#names){
         if ($types[$_] == 3){
-            $arrayref[$_] = Math::BigFloat->new($arrayref[$_]) 
+            $arrayref->[$_] = Math::BigFloat->new($arrayref->[$_]) 
               if defined $arrayref;
             $hashref->{$names[$_]} = Math::BigFloat->new($hashref->{$names[$_]})
               if defined $hashref;
@@ -853,29 +855,6 @@ sub db_parse_numeric {
     return ($hashref || $arrayref);
 }
 
-=item Form::callproc($procname);
-
-Broken function.  Use $lsmb::call_procedure instead.
-
-=cut
-
-sub callproc {
-    my $procname = shift @_;
-    my $argstr   = "";
-    my @results;
-    for ( 1 .. $#_ ) {
-        $argstr .= "?, ";
-    }
-    $argstr =~ s/\, $//;
-    $query = "SELECT * FROM $procname";
-    $query =~ s/\(\)/$argstr/;
-    my $sth = $self->{dbh}->prepare($query);
-    while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) {
-        push @results, $ref;
-    }
-    @results;
-}
-
 =item $form->get_my_emp_num($myconfig);
 
 Function to get the employee number of the user $form->{login}.  $myconfig is
@@ -887,19 +866,19 @@ This function is currently (2007-08-02) only used by pos.conf.pl.
 
 sub get_my_emp_num {
     my ( $self, $myconfig) = @_;
-    %myconfig = %{$myconfig};
-    my $dbh = $form->{dbh};
+    my %myconfig = %{$myconfig};
+    my $dbh = $self->{dbh};
 
     # we got a connection, check the version
     my $query = qq|
 		SELECT employeenumber FROM employee 
 		 WHERE login = ?|;
     my $sth = $dbh->prepare($query);
-    $sth->execute( $form->{login} ) || $form->dberror($query);
+    $sth->execute( $self->{login} ) || $self->dberror($query);
 
     my ($id) = $sth->fetchrow_array;
     $sth->finish;
-    $form->{'emp_num'} = $id;
+    $self->{'emp_num'} = $id;
 }
 
 =item $form->format_string(@fields);
@@ -979,8 +958,14 @@ sub datetonum {
 
     my ( $self, $myconfig, $date, $picture ) = @_;
 
+    my $date;
+
     if ( $date && $date =~ /\D/ ) {
 
+        my $yy;
+        my $mm;
+        my $dd;
+
         if ( $myconfig->{dateformat} =~ /^yy/ ) {
             ( $yy, $mm, $dd ) = split /\D/, $date;
         }
@@ -1072,7 +1057,7 @@ sub add_date {
 
         $mm--;
 
-        @t = localtime( Time::Local::timelocal( 0, 0, 0, $dd, $mm, $yy ) + $diff );
+        my @t = localtime( Time::Local::timelocal( 0, 0, 0, $dd, $mm, $yy ) + $diff );
 
         $t[4]++;
         $mm = substr( "0$t[4]", -2 );
@@ -1133,7 +1118,7 @@ autocommit disabled.
 sub db_init {
     my ( $self, $myconfig ) = @_;
     $self->{dbh} = $self->dbconnect_noauto($myconfig) || $self->dberror();
-    %date_query = (
+    my %date_query = (
         'mm/dd/yy' => 'set DateStyle to \'SQL, US\'',
         'mm-dd-yy' => 'set DateStyle to \'POSTGRES, US\'',
         'dd/mm/yy' => 'set DateStyle to \'SQL, EUROPEAN\'',
@@ -1172,9 +1157,7 @@ sub run_custom_queries {
     my $dbh = $self->{dbh};
     if ( $query_type !~ /^(select|insert|update)$/i ) {
         $self->error(
-            $locale->text(
                 "Passed incorrect query type to run_custom_queries."
-            )
         );
     }
     my @rc;
@@ -1182,7 +1165,9 @@ sub run_custom_queries {
     my @templist;
     my @elements;
     my $query;
+    my $did_insert;
     my $ins_values;
+    my $sth;
     if ($linenum) {
         $linenum = "_$linenum";
     }
@@ -1254,10 +1239,10 @@ sub run_custom_queries {
     }
     elsif ( $query_type eq 'SELECT' ) {
         for (@rc) {
-            $query = shift @{$_};
-            $sth   = $self->{dbh}->prepare($query);
+            my $query = shift @{$_};
+            my $sth   = $self->{dbh}->prepare($query);
             $sth->execute( $self->{id} );
-            $ref = $sth->fetchrow_hashref(NAME_lc);
+            my $ref = $sth->fetchrow_hashref(NAME_lc);
             for ( keys %{$ref} ) {
                 $self->{$_} = $ref->{$_};
             }
@@ -1302,7 +1287,7 @@ sub dbconnect_noauto {
     my ( $self, $myconfig ) = @_;
 
     # connect to database
-    $dbh = DBI->connect(
+    my $dbh = DBI->connect(
         $myconfig->{dbconnect}, $myconfig->{dbuser},
         $myconfig->{dbpasswd}, { AutoCommit => 0 }
     ) or $self->dberror;
@@ -1478,6 +1463,7 @@ sub get_exchangerate {
     my ( $self, $dbh, $curr, $transdate, $fld ) = @_;
 
     my $exchangerate = 1;
+    my $sth;
 
     if ($transdate) {
         my $query = qq|
@@ -1561,7 +1547,7 @@ sub add_shipto {
 			VALUES ( ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)
 			|;
 
-        $sth = $self->{dbh}->prepare($query) || $self->dberror($query);
+        my $sth = $self->{dbh}->prepare($query) || $self->dberror($query);
         $sth->execute(
             $id,                     $self->{shiptoname},
             $self->{shiptoaddress1}, $self->{shiptoaddress2},
@@ -1595,7 +1581,7 @@ sub get_employee {
 					 FROM employee 
 					WHERE login = ?)|;
 
-    $sth = $self->{dbh}->prepare($query);
+    my $sth = $self->{dbh}->prepare($query);
     $sth->execute($login);
     my (@a) = $sth->fetchrow_array();
     $a[1] *= 1;
@@ -1657,7 +1643,7 @@ sub get_name {
 
     my $i = 0;
     @{ $self->{name_list} } = ();
-    while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) {
+    while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) {
         push( @{ $self->{name_list} }, $ref );
         $i++;
     }
@@ -1943,12 +1929,12 @@ sub all_projects {
 
     $query .= qq| ORDER BY projectnumber|;
 
-    $sth = $dbh->prepare($query);
+    my $sth = $dbh->prepare($query);
     $sth->execute(@queryargs) || $self->dberror($query);
 
     @{ $self->{all_project} } = ();
 
-    while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) {
+    while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) {
         push @{ $self->{all_project} }, $ref;
     }
 
@@ -1972,7 +1958,7 @@ sub all_departments {
 
     my ( $self, $myconfig, $dbh2, $vc ) = @_;
 
-    $dbh = $self->{dbh};
+    my $dbh = $self->{dbh};
 
     my $where = "1 = 1";
 
@@ -2015,7 +2001,7 @@ sub all_years {
 
     my ( $self, $myconfig, $dbh2 ) = @_;
 
-    $dbh = $self->{dbh};
+    my $dbh = $self->{dbh};
 
     # get years
     my $query = qq|
@@ -2106,10 +2092,14 @@ sub create_links {
         $self->db_init($myconfig);
     }
 
-    $dbh = $self->{dbh};
+    my $dbh = $self->{dbh};
 
     my %xkeyref = ();
 
+    my $val;
+    my $ref;
+    my $key;
+
     # now get the account numbers
     $query = qq|SELECT accno, description, link
 				  FROM chart
@@ -2229,7 +2219,7 @@ sub create_links {
             $ref->{exchangerate} =
               $self->get_exchangerate( $dbh, $self->{currency},
                 $ref->{transdate}, $fld );
-            if ($form->{reverse}){
+            if ($self->{reverse}){
                 $ref->{amount} *= -1;
             }
 
@@ -2354,6 +2344,7 @@ sub current_date {
 
     my $dbh = $self->{dbh};
     my $query;
+    my @queryargs;
 
     $days *= 1;
     if ($thisdate) {
@@ -2379,9 +2370,9 @@ sub current_date {
         @queryargs = ();
     }
 
-    $sth = $dbh->prepare($query);
+    my $sth = $dbh->prepare($query);
     $sth->execute(@queryargs);
-    ($thisdate) = $sth->fetchrow_array;
+    my ($thisdate) = $sth->fetchrow_array;
     $thisdate;
 }
 
@@ -2430,7 +2421,7 @@ sub redo_rows {
     # fill rows
     foreach my $item ( sort { $a->{num} <=> $b->{num} } @ndx ) {
         $i++;
-        $j = $item->{ndx} - 1;
+        my $j = $item->{ndx} - 1;
         for ( @{$flds} ) { $self->{"${_}_$i"} = $new->[$j]->{$_} }
     }
 
@@ -2550,7 +2541,7 @@ sub update_status {
 					WHERE formname = ?
 					  AND trans_id = ?|;
 
-    $sth = $dbh->prepare($query);
+    my $sth = $dbh->prepare($query);
     $sth->execute( $self->{formname}, $self->{id} ) || $self->dberror($query);
 
     $sth->finish;
@@ -2583,7 +2574,7 @@ sub save_status {
 
     my ($self) = @_;
 
-    $dbh = $self->{dbh};
+    my $dbh = $self->{dbh};
 
     my $formnames  = $self->{printed};
     my $emailforms = $self->{emailed};
@@ -2598,6 +2589,9 @@ sub save_status {
     my %queued;
     my $formname;
 
+    my $printed;
+    my $emailed;
+
     if ( $self->{queued} ) {
 
         %queued = split / +/, $self->{queued};
@@ -2615,7 +2609,7 @@ sub save_status {
 					VALUES (?, ?, ?, ?, ?)|;
 
                 $sth = $dbh->prepare($query);
-                $sth->execute( $self->{id}, $pinted, $emailed,
+                $sth->execute( $self->{id}, $printed, $emailed,
                     $queued{$formname}, $formname )
                   || $self->dberror($query);
                 $sth->finish;
@@ -2666,7 +2660,7 @@ sub get_recurring {
 
     my ($self) = @_;
 
-    $dbh = $self->{dbh};
+    my $dbh = $self->{dbh};
     my $query = qq/
 		SELECT s.*, se.formname || ':' || se.format AS emaila,
 			se.message, sp.formname || ':' || 
@@ -2785,7 +2779,7 @@ sub save_recurring {
     $query = qq|DELETE FROM recurring
 				 WHERE id = ?|;
 
-    $sth = $dbh->prepare($query) || $self->dberror($query);
+    my $sth = $dbh->prepare($query) || $self->dberror($query);
     $sth->execute( $self->{id} ) || $self->dberror($query);
 
     $query = qq|DELETE FROM recurringemail
@@ -2954,7 +2948,7 @@ sub save_intnotes {
 
     my $query = qq|UPDATE $vc SET intnotes = ? WHERE id = ?|;
 
-    $sth = $dbh->prepare($query);
+    my $sth = $dbh->prepare($query);
     $sth->execute( $self->{intnotes}, $self->{id} ) || $self->dberror($query);
     $dbh->commit;
 }
@@ -3010,7 +3004,7 @@ sub update_defaults {
     my $query = qq|
 		SELECT value FROM defaults 
 		 WHERE setting_key = ? FOR UPDATE|;
-    $sth = $dbh->prepare($query);
+    my $sth = $dbh->prepare($query);
     $sth->execute($fld);
     ($_) = $sth->fetchrow_array();
 
@@ -3129,12 +3123,12 @@ sub update_defaults {
         }
     }
 
-    $query = qq|
+    my $query = qq|
 		UPDATE defaults
 		   SET value = ?
 		 WHERE setting_key = ?|;
 
-    $sth = $dbh->prepare($query);
+    my $sth = $dbh->prepare($query);
     $sth->execute( $dbvar, $fld ) || $self->dberror($query);
 
     $dbh->commit;
@@ -3384,6 +3378,8 @@ sub audittrail {
     if ( !$dbh ) {
         $dbh = $self->{dbh};
     }
+    my $sth;
+    my $query;
 
     # if we have an id add audittrail, otherwise get a new timestamp