diff options
Diffstat (limited to 'LedgerSMB')
| -rw-r--r-- | LedgerSMB/DBObject/Payment.pm | 108 | ||||
| -rw-r--r-- | LedgerSMB/Form.pm | 114 |
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 |