[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
SF.net SVN: ledger-smb: [1606] trunk
- Subject: SF.net SVN: ledger-smb: [1606] trunk
- From: ..hidden..
- Date: Fri, 14 Sep 2007 18:56:40 -0700
Revision: 1606
http://ledger-smb.svn.sourceforge.net/ledger-smb/?rev=1606&view=rev
Author: einhverfr
Date: 2007-09-14 18:56:39 -0700 (Fri, 14 Sep 2007)
Log Message:
-----------
Form.pm now uses strit mode except in the constructor
Modified Paths:
--------------
trunk/LedgerSMB/DBObject/Payment.pm
trunk/LedgerSMB/Form.pm
trunk/sql/modules/Payment.sql
Modified: trunk/LedgerSMB/DBObject/Payment.pm
===================================================================
--- trunk/LedgerSMB/DBObject/Payment.pm 2007-09-15 01:30:47 UTC (rev 1605)
+++ trunk/LedgerSMB/DBObject/Payment.pm 2007-09-15 01:56:39 UTC (rev 1606)
@@ -1,7 +1,21 @@
-=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
package LedgerSMB::DBObject::Payment;
@@ -10,6 +24,31 @@
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 @@
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 @@
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 @@
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}} =
Modified: trunk/LedgerSMB/Form.pm
===================================================================
--- trunk/LedgerSMB/Form.pm 2007-09-15 01:30:47 UTC (rev 1605)
+++ trunk/LedgerSMB/Form.pm 2007-09-15 01:56:39 UTC (rev 1606)
@@ -67,7 +67,6 @@
use charnames ':full';
use open ':utf8';
-
package Form;
=item new Form([$argstr])
@@ -85,6 +84,9 @@
=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 @@
$a[0] .= " $self->{direction}";
}
- $sortorder = join ',', @a;
+ my $sortorder = join ',', @a;
$sortorder;
}
@@ -843,7 +845,7 @@
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 @@
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 @@
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 @@
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 @@
$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 @@
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 @@
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 @@
my @templist;
my @elements;
my $query;
+ my $did_insert;
my $ins_values;
+ my $sth;
if ($linenum) {
$linenum = "_$linenum";
}
@@ -1254,10 +1239,10 @@
}
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 @@
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 @@
my ( $self, $dbh, $curr, $transdate, $fld ) = @_;
my $exchangerate = 1;
+ my $sth;
if ($transdate) {
my $query = qq|
@@ -1561,7 +1547,7 @@
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 @@
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 @@
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 @@
$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 @@
my ( $self, $myconfig, $dbh2, $vc ) = @_;
- $dbh = $self->{dbh};
+ my $dbh = $self->{dbh};
my $where = "1 = 1";
@@ -2015,7 +2001,7 @@
my ( $self, $myconfig, $dbh2 ) = @_;
- $dbh = $self->{dbh};
+ my $dbh = $self->{dbh};
# get years
my $query = qq|
@@ -2106,10 +2092,14 @@
$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 @@
$ref->{exchangerate} =
$self->get_exchangerate( $dbh, $self->{currency},
$ref->{transdate}, $fld );
- if ($form->{reverse}){
+ if ($self->{reverse}){
$ref->{amount} *= -1;
}
@@ -2354,6 +2344,7 @@
my $dbh = $self->{dbh};
my $query;
+ my @queryargs;
$days *= 1;
if ($thisdate) {
@@ -2379,9 +2370,9 @@
@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 @@
# 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 @@
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 @@
my ($self) = @_;
- $dbh = $self->{dbh};
+ my $dbh = $self->{dbh};
my $formnames = $self->{printed};
my $emailforms = $self->{emailed};
@@ -2598,6 +2589,9 @@
my %queued;
my $formname;
+ my $printed;
+ my $emailed;
+
if ( $self->{queued} ) {
%queued = split / +/, $self->{queued};
@@ -2615,7 +2609,7 @@
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 @@
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 @@
$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 @@
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 @@
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 @@
}
}
- $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 @@
if ( !$dbh ) {
$dbh = $self->{dbh};
}
+ my $sth;
+ my $query;
# if we have an id add audittrail, otherwise get a new timestamp
Modified: trunk/sql/modules/Payment.sql
===================================================================
--- trunk/sql/modules/Payment.sql 2007-09-15 01:30:47 UTC (rev 1605)
+++ trunk/sql/modules/Payment.sql 2007-09-15 01:56:39 UTC (rev 1606)
@@ -27,7 +27,7 @@
$$ This function takes a single argument (1 for vendor, 2 for customer as
always) and returns all entities with open accounts of the appropriate type. $$;
-CREATE OR REPLACE FUNCTION get_all_accounts(in_account_class int)
+CREATE OR REPLACE FUNCTION payment_get_all_accounts(in_account_class int)
RETURNS SETOF entity AS
$$
DECLARE out_entity entity%ROWTYPE;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.