=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; use LedgerSMB::Num2text; use base qw(LedgerSMB::DBObject); use strict; use Math::BigFloat lib => 'GMP'; use Data::Dumper; our $VERSION = '0.1.0'; =head1 METHODS =over =item LedgerSMB::DBObject::Payment->new() Inherited from LedgerSMB::DBObject. Please see that documnetation for details. =item $payment->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 __validate__ { my ($self) = shift @_; # If the account class is not set, we don't know if it is a payment or a # receipt. --CT if (!$self->{account_class}) { $self->error("account_class must be set") }; # We should try to re-engineer this so that we don't have to include SQL in # this file. --CT ($self->{current_date}) = $self->{dbh}->selectrow_array('select current_date'); } sub text_amount { use LedgerSMB::Num2text; my ($self, $value) = @_; $self->{locale} = $self->{_locale}; $self->init(); return $self->num2text($value); } sub get_metadata { my ($self) = @_; $self->list_open_projects(); @{$self->{departments}} = $self->exec_method(funcname => 'department_list'); $self->get_open_currencies(); $self->{currencies} = []; for my $c (@{$self->{openCurrencies}}){ push @{$self->{currencies}}, $c->{payments_get_open_currencies}; } @{$self->{businesses}} = $self->exec_method( funcname => 'business_type__list' ); @{$self->{debt_accounts}} = $self->exec_method( funcname => 'chart_get_ar_ap'); @{$self->{cash_accounts}} = $self->exec_method( funcname => 'chart_list_cash'); for my $ref(@{$self->{cash_accounts}}){ $ref->{text} = "$ref->{accno}--$ref->{description}"; } if ($self->{batch_id} && !defined $self->{batch_date}){ my ($ref) = $self->exec_method(funcname => 'voucher_get_batch'); $self->{batch_date} = $ref->{default_date}; } } sub search { my ($self) = @_; if ($self->{meta_number} && !$self->{credit_id}){ my ($ref) = $self->exec_method( funcname => 'entity_credit_get_id_by_meta_number' ); my @keys = keys %$ref; my $key = shift @keys; $self->{credit_id} = $ref->{$key}; } @{$self->{search_results}} = $self->exec_method( funcname => 'payment__search' ); return @{$self->{search_results}}; } sub get_open_accounts { my ($self) = @_; @{$self->{accounts}} = $self->exec_method(funcname => 'payment_get_open_accounts'); return @{$self->{accounts}}; } sub get_entity_credit_account{ my ($self) = @_; @{$self->{entity_accounts}} = $self->exec_method(funcname => 'payment_get_entity_accounts'); return @{$self->{entity_accounts}}; } =over =item $payment->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}} = $self->exec_method(funcname => 'payment_get_all_accounts'); return @{$self->{accounts}}; } =over =item $payment->reverse() This function reverses a payment. A payment is defined as one source ($payment->{source}) to one cash account ($payment->{cash_accno}) to one date ($payment->{date_paid}) to one vendor/customer ($payment->{credit_id}, $payment->{account_class}). This reverses the entries with that source. =back =cut sub reverse { my ($self) = @_; $self->exec_method(funcname => 'payment__reverse'); return $self->{dbh}->commit; } =over =item $payment->get_open_invoices() This function returns a list of open invoices depending on the $payment->{account_class}, $payment->{entity_id}, and $payment->{curr} 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}} = $self->exec_method(funcname => 'payment_get_open_invoices'); return @{$self->{open_invoices}}; } =over =item $payment->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}} = $self->exec_method(funcname => 'payment_get_all_contact_invoices'); # When arrays of complex types are supported by all versions of Postgres # that this application supports, we should look at doing type conversions # in DBObject so this sort of logic is unncessary. -- CT for my $contact (@{$self->{contacts}}){ my @invoices = $self->parse_array($contact->{invoices}); my $processed_invoices = []; for my $invoice (@invoices){ my $new_invoice = {}; for (qw(invoice_id invnumber invoice_date amount discount due)){ $new_invoice->{$_} = shift @$invoice; if ($_ =~ /^(amount|discount|due)$/){ $new_invoice->{$_} = Math::BigFloat->new($new_invoice->{$_}); } } push(@$processed_invoices, $new_invoice); } $contact->{invoice} = sort { $a->{invoice_date} cmp $b->{invoice_date} } @{ $processed_invoices }; $contact->{invoice} = $processed_invoices; } return @{$self->{contacts}}; } =over =item list_open_projects This method gets the current date attribute, and provides a list of open projects. The list is attached to $self->{projects} and returned. =back =cut sub list_open_projects { my ($self) = @_; @{$self->{projects}} = $self->call_procedure( procname => 'project_list_open', args => [$self->{current_date}] ); return @{$self->{projects}}; } =over =item list_departments This method gets the type of document as a parameter, and provides a list of departments of the required type. The list is attached to $self->{departments} and returned. =back =cut sub list_departments { my ($self) = shift @_; my @args = @_; @{$self->{departments}} = $self->call_procedure( procname => 'department_list', args => \@args ); return @{$self->{departments}}; } =over =item list_open_vc This method gets the type of vc (vendor or customer) as a parameter, and provides a list of departments of the required type. The list is attached to $self->{departments} and returned. =back =cut sub list_departments { my ($self) = shift @_; my @args = @_; @{$self->{departments}} = $self->call_procedure( procname => 'department_list', args => \@args ); return @{$self->{departments}}; } =over =item get_open_currencies This method gets a list of the open currencies inside the database, it requires that $self->{account_class} (must be 1 or 2) exist to work. =back =cut sub get_open_currencies { my ($self) = shift @_; @{$self->{openCurrencies}} = $self->exec_method( funcname => 'payments_get_open_currencies'); return @{$self->{openCurrencies}}; } =over =item list_accounting This method lists all accounts that match the role specified in account_class property and are availible to store the payment or receipts. =back =cut sub list_accounting { my ($self) = @_; @{$self->{pay_accounts}} = $self->exec_method( funcname => 'chart_list_cash'); return @{$self->{pay_accounts}}; } =item list_overpayment_accounting This method lists all accounts that match the role specified in account_class property and are availible to store an overpayment / advanced payment / pre-payment. =back =cut sub list_overpayment_accounting { my ($self) = @_; @{$self->{overpayment_accounts}} = $self->exec_method( funcname => 'chart_list_overpayment'); return @{$self->{overpayment_accounts}}; } =item get_sources This method builds all the possible sources of money, in the future it will look inside the DB. =back =cut sub get_sources { my ($self, $locale) = @_; @{$self->{cash_sources}} = ($locale->text('cash'), $locale->text('check'), $locale->text('deposit'), $locale->text('other')); return @{$self->{cash_sources}}; } =item get_exchange_rate(currency, date) This method gets the exchange rate for the specified currency and date =cut sub get_exchange_rate { my ($self) = shift @_; ($self->{currency}, $self->{date}) = @_; ($self->{exchangerate}) = $self->exec_method(funcname => 'currency_get_exchangerate'); return $self->{exchangerate}->{currency_get_exchangerate}; } =item get_default_currency This method gets the default currency =back =cut sub get_default_currency { my ($self) = shift @_; ($self->{default_currency}) = $self->call_procedure(procname => 'defaults_get_defaultcurrency'); return $self->{default_currency}->{defaults_get_defaultcurrency}; } =item get_current_date This method returns the system's current date =cut sub get_current_date { my ($self) = shift @_; return $self->{current_date}; } =item get_vc_info This method returns the contact informatino for a customer or vendor according to $self->{account_class} =cut sub get_vc_info { my ($self) = @_; @{$self->{vendor_customer_info}} = $self->exec_method(funcname => 'payment_get_vc_info'); return @{$self->{vendor_customer_info}}; } =item get_payment_detail_data This method sets appropriate project, department, etc. fields. =cut sub get_payment_detail_data { my ($self) = @_; $self->get_metadata(); if (!defined $self->{source_start}){ $self->error('No source start defined!'); } my $source_inc; my $source_src; $self->{source_start} =~ /(\d*)\D*$/; $source_src = $1; if ($source_src) { $source_inc = $source_src; } else { $source_inc = 0; } my $source_length = length($source_inc); @{$self->{contact_invoices}} = $self->exec_method( funcname => 'payment_get_all_contact_invoices'); for my $inv (@{$self->{contact_invoices}}) { if (($self->{action} ne 'update_payments') or (defined $self->{"id_$inv->{contact_id}"}) ) { my $source = $self->{source_start}; if (length($source_inc) < $source_length) { $source_inc = sprintf('%0*s', $source_length, $source_inc); } $source =~ s/$source_src(\D*)$/$source_inc$1/; ++ $source_inc; $inv->{source} = $source; $self->{"source_$inv->{contact_id}"} = $source; } else { # Clear source numbers every time. $inv->{source} = ""; $self->{"source_$inv->{contact_id}"} = ""; } my $tmp_invoices = $inv->{invoices}; $inv->{invoices} = []; @{$inv->{invoices}} = $self->_parse_array($tmp_invoices); @{$inv->{invoices}} = sort { $a->[2] cmp $b->[2] } @{ $inv->{invoices} }; for my $invoice (@{$inv->{invoices}}){ $invoice->[6] = Math::BigFloat->new($invoice->[6]); $invoice->[3] = Math::BigFloat->new($invoice->[3]); $invoice->[4] = Math::BigFloat->new($invoice->[4]); } } $self->{dbh}->commit; # Commit locks } sub post_bulk { my ($self) = @_; my $total_count = 0; my ($ref) = $self->call_procedure( procname => 'setting_get', args => ['queue_payments'], ); my $queue_payments = $ref->{setting_get}; if ($queue_payments){ my ($job_ref) = $self->exec_method( funcname => 'job__create' ); $self->{job_id} = $job_ref->{job__create}; ($self->{job}) = $self->exec_method( funcname => 'job__status' ); } $self->{payment_date} = $self->{datepaid}; for my $contact_row (1 .. $self->{contact_count}){ my $contact_id = $self->{"contact_$contact_row"}; next if (!$self->{"id_$contact_id"}); my $invoice_array = "{}"; # Pg Array for my $invoice_row (1 .. $self->{"invoice_count_$contact_id"}){ my $invoice_id = $self->{"invoice_${contact_id}_${invoice_row}"}; my $pay_amount = ($self->{"paid_$contact_id"} eq 'all' ) ? $self->{"net_$invoice_id"} : $self->{"payment_$invoice_id"}; next if ! $pay_amount; $pay_amount = $pay_amount * 1; my $invoice_subarray = "{$invoice_id,$pay_amount}"; if ($invoice_subarray !~ /^\{\d+\,\-?\d*\.?\d+\}$/){ $self->error("Invalid subarray: $invoice_subarray"); } $invoice_subarray =~ s/[^0123456789{},.-]//; if ($invoice_array eq '{}'){ # Omit comma $invoice_array = "{$invoice_subarray}"; } else { $invoice_array =~ s/\}$/,$invoice_subarray\}/; } } $self->{transactions} = $invoice_array; $self->{source} = $self->{"source_$contact_id"}; if ($queue_payments){ $self->{batch_class} = 3; $self->exec_method( funcname => 'payment_bulk_queue' ); } else { $self->exec_method(funcname => 'payment_bulk_post'); } } $self->{queue_payments} = $queue_payments; return $self->{dbh}->commit; } sub check_job { my ($self) = @_; ($self->{job}) = $self->exec_method(funcname => 'job__status'); } =item post_payment This method uses payment_post to store a payment (not a bulk payment) on the database. =cut sub post_payment { my ($self) = @_; # We have to check if it was a fx_payment $self->{currency} = $self->{curr}; if ("$self->{currency}" ne $self->get_default_currency()) { # First we have to check for an exchangerate on this date my $db_exchangerate = $self->get_exchange_rate($self->{curr},$self->{datepaid}); if (!$db_exchangerate) { # We have to set the exchangerate $self->call_procedure(procname => 'payments_set_exchangerate', args => ["$self->{account_class}", "$self->{exchangerate}" ,"$self->{curr}", "$self->{datepaid}"]); } elsif ($db_exchangerate != $self->{exchangerate} ) { # Something went wrong $self->error("Exchange rate inconsistency with database, please try again") } } my @TMParray = $self->exec_method(funcname => 'payment_post'); $self->{dbh}->commit(); $self->{payment_id} = $TMParray[0]->{payment_post}; return $self->{payment_id}; } =item gather_printable_info This method retrieves all the payment related info needed to build a document and print it. IT IS NECESSARY TO ALREADY HAVE payment_id on $self =cut sub gather_printable_info { my ($self) = @_; @{$self->{header_info}} = $self->exec_method(funcname => 'payment_gather_header_info'); @{$self->{line_info}} = $self->exec_method(funcname => 'payment_gather_line_info'); } 1;