Payments.pm 21.2 KB
Newer Older
1
# Supplier invoice payments
2
# Copyright (C) 2009-2014, AllWorldIT
3
# Copyright (C) 2008, LinuxRulz
Nigel Kukard's avatar
Nigel Kukard committed
4
# Copyright (C) 2007 Nigel Kukard  <nkukard@lbsd.net>
5
#
6
7
8
9
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
10
#
11
12
13
14
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
15
#
16
17
18
19
# You should have received a copy of the GNU General Public License along
# with this program; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

Nigel Kukard's avatar
Nigel Kukard committed
20
21
22



23
package wiaflos::server::core::Payments;
Nigel Kukard's avatar
Nigel Kukard committed
24
25

use strict;
Nigel Kukard's avatar
Nigel Kukard committed
26
27
use warnings;

Nigel Kukard's avatar
Nigel Kukard committed
28

Nigel Kukard's avatar
Nigel Kukard committed
29
use wiaflos::constants;
30
31
32
use awitpt::db::dblayer;
use wiaflos::server::core::Suppliers;
use wiaflos::server::core::GL;
Nigel Kukard's avatar
Nigel Kukard committed
33

34
35
36
use Math::BigFloat;


Nigel Kukard's avatar
Nigel Kukard committed
37
38
39
40
41
42
43
44
45

# Our current error message
my $error = "";

# Set current error message
# Args: error_message
sub setError
{
	my $err = shift;
46
47
	my ($package,$filename,$line) = caller;
	my (undef,undef,undef,$subroutine) = caller(1);
Nigel Kukard's avatar
Nigel Kukard committed
48
49

	# Set error
50
	$error = "$subroutine($line): $err";
Nigel Kukard's avatar
Nigel Kukard committed
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
}

# Return current error message
# Args: none
sub Error
{
	my $err = $error;

	# Reset error
	$error = "";

	# Return error
	return $err;
}


67
68
69
70
71
72
73
# Check if payment exists
# Backend function, takes 1 parameter which is the payment ID
sub supplierPaymentExists
{
	my $paymentID = shift;


74
75
76
	# Select payment count
	my $rows = DBSelectNumResults("FROM payments WHERE ID = ".DBQuote($paymentID));
	if (!defined($rows)) {
77
		setError(awitpt::db::dblayer::Error());
Nigel Kukard's avatar
Nigel Kukard committed
78
		return ERR_DB;
79
80
	}

81
	return $rows > 0 ? 1 : 0;
82
83
84
}


Nigel Kukard's avatar
Nigel Kukard committed
85
# Check if payment number exists
86
sub supplierPaymentNumberExists
87
{
Nigel Kukard's avatar
Nigel Kukard committed
88
	my $number = shift;
89
90


91
92
	# Sanitize
	$number = uc($number);
93
	$number =~ s#^PMT/##;
94

95
	# Select payment count
Nigel Kukard's avatar
Nigel Kukard committed
96
	my $rows = DBSelectNumResults("FROM payments WHERE Number = ".DBQuote($number));
97
	if (!defined($rows)) {
98
		setError(awitpt::db::dblayer::Error());
Nigel Kukard's avatar
Nigel Kukard committed
99
		return ERR_DB;
100
101
102
103
104
105
	}

	return $rows > 0 ? 1 : 0;
}


Nigel Kukard's avatar
Nigel Kukard committed
106
107
# Return payment id from number
sub getPaymentIDFromNumber
Nigel Kukard's avatar
Nigel Kukard committed
108
{
Nigel Kukard's avatar
Nigel Kukard committed
109
	my $number = shift;
Nigel Kukard's avatar
Nigel Kukard committed
110
111


112
113
	# Sanitize
	$number = uc($number);
114
	$number =~ s#^PMT/##;
115

Nigel Kukard's avatar
Nigel Kukard committed
116
117
	# Select payment
	my $sth = DBSelect("
118
		SELECT
Nigel Kukard's avatar
Nigel Kukard committed
119
120
121
122
			ID
		FROM
			payments
		WHERE
Nigel Kukard's avatar
Nigel Kukard committed
123
			Number = ".DBQuote($number)."
Nigel Kukard's avatar
Nigel Kukard committed
124
	");
125
	if (!$sth) {
126
		setError(awitpt::db::dblayer::Error());
Nigel Kukard's avatar
Nigel Kukard committed
127
		return ERR_DB;
Nigel Kukard's avatar
Nigel Kukard committed
128
129
	}

130
	my $row = hashifyLCtoMC($sth->fetchrow_hashref(),qw( ID ));
131
132
	DBFreeRes($sth);

Nigel Kukard's avatar
Nigel Kukard committed
133
	# Check we got a result
134
	if (!defined($row)) {
135
		setError("Error finding payment '$number'");
136
		return ERR_NOTFOUND;
Nigel Kukard's avatar
Nigel Kukard committed
137
138
139
140
141
142
143
	}

	return $row->{'ID'};
}



Nigel Kukard's avatar
Nigel Kukard committed
144

145
146
147
148
# Backend function to build item hash
sub sanitizeRawItem
{
	my $rawData = shift;
149
150


151
152
153
154
155
	my $item;
	$item->{'ID'} = $rawData->{'ID'};


	# Pull in supplier data
Nigel Kukard's avatar
Nigel Kukard committed
156
	$item->{'SupplierID'} = $rawData->{'SupplierID'};
157

Nigel Kukard's avatar
Nigel Kukard committed
158
159
	my $data;
	$data->{'ID'} = $rawData->{'SupplierID'};
160
	my $supplier = wiaflos::server::core::Suppliers::getSupplier($data);
Nigel Kukard's avatar
Nigel Kukard committed
161
	$item->{'SupplierCode'} = $supplier->{'Code'};
162

163
164

	# Pull in GL account info
Nigel Kukard's avatar
Nigel Kukard committed
165
	$item->{'GLAccountID'} = $rawData->{'GLAccountID'};
166
	$item->{'GLAccountNumber'} = wiaflos::server::core::GL::getGLAccountNumberFromID($rawData->{'GLAccountID'});
167

Nigel Kukard's avatar
Nigel Kukard committed
168
	$item->{'Number'} = "PMT/".uc($rawData->{'Number'});
169

Nigel Kukard's avatar
Nigel Kukard committed
170
171
172
	$item->{'TransactionDate'} = $rawData->{'TransactionDate'};
	$item->{'Reference'} = $rawData->{'Reference'};
	$item->{'Amount'} = $rawData->{'Amount'};
173

Nigel Kukard's avatar
Nigel Kukard committed
174
	$item->{'GLTransactionID'} = $rawData->{'GLTransactionID'};
Nigel Kukard's avatar
Nigel Kukard committed
175
	$item->{'Posted'} = defined($rawData->{'GLTransactionID'}) ? 1 : 0;
176

177
	$item->{'Closed'} = $rawData->{'Closed'};
178
179
180
181
182

	return $item;
}


183
184
185
186
# Backend function to build item hash
sub sanitizeRawAllocationItem
{
	my $rawData = shift;
187
188


189
	my $item;
190

191
192
193
	$item->{'ID'} = $rawData->{'ID'};


Nigel Kukard's avatar
Nigel Kukard committed
194
195
	$item->{'PaymentID'} = $rawData->{'PaymentID'};

196
197
198
   	# Pull in invoice data
	$item->{'SupplierInvoiceID'} = $rawData->{'SupplierInvoiceID'};

199

200
	my $data;
Nigel Kukard's avatar
Nigel Kukard committed
201
	$data->{'ID'} = $rawData->{'SupplierInvoiceID'};
202
	my $invoice = wiaflos::server::core::Purchasing::getSupplierInvoice($data);
Nigel Kukard's avatar
Nigel Kukard committed
203
	$item->{'SupplierInvoiceNumber'} = $invoice->{'Number'};
204

205

Nigel Kukard's avatar
Nigel Kukard committed
206
	$item->{'Amount'} = $rawData->{'Amount'};
207

Nigel Kukard's avatar
Nigel Kukard committed
208
	$item->{'Posted'} = defined($rawData->{'SupplierInvoiceTransactionID'}) ? 1 : 0;
209
210
211
212
213

	return $item;
}


Nigel Kukard's avatar
Nigel Kukard committed
214
215
# Create payment
# Parameters:
Nigel Kukard's avatar
Nigel Kukard committed
216
217
218
#		SupplierCode	- Supplier code
#		GLAccountNumber	- GL account where money was paid from
#		Number	- Reference for this payment
Nigel Kukard's avatar
Nigel Kukard committed
219
#		Date		- Date of payment
Nigel Kukard's avatar
Nigel Kukard committed
220
#		Reference			- GL account entry reference (bank statement reference for example)
Nigel Kukard's avatar
Nigel Kukard committed
221
222
223
224
225
226
#		Amount		- Amount
sub createPayment
{
	my ($detail) = @_;


227
228
229
230
231
232
	# Verify payment number
	if (!defined($detail->{'Number'}) || $detail->{'Number'} eq "") {
		setError("No (or invalid) payment number provided");
		return ERR_PARAM;
	}
	# Sanitize
233
	(my $paymentNumber = uc($detail->{'Number'})) =~ s#^PMT/##;
234

Nigel Kukard's avatar
Nigel Kukard committed
235
	# Verify supplier ref
Nigel Kukard's avatar
Nigel Kukard committed
236
	if (!defined($detail->{'SupplierCode'}) || $detail->{'SupplierCode'} eq "") {
237
		setError("No (or invalid) supplier code provided for payment '".$detail->{'Number'}."'");
Nigel Kukard's avatar
Nigel Kukard committed
238
		return ERR_PARAM;
Nigel Kukard's avatar
Nigel Kukard committed
239
240
241
	}

	# Verify GL account
Nigel Kukard's avatar
Nigel Kukard committed
242
	if (!defined($detail->{'GLAccountNumber'}) || $detail->{'GLAccountNumber'} eq "") {
243
		setError("No (or invalid) GL account provided for payment '".$detail->{'Number'}."'");
Nigel Kukard's avatar
Nigel Kukard committed
244
		return ERR_PARAM;
Nigel Kukard's avatar
Nigel Kukard committed
245
246
247
248
	}

	# Verify date
	if (!defined($detail->{'Date'}) || $detail->{'Date'} eq "") {
249
		setError("No (or invalid) date provided for payment '".$detail->{'Number'}."'");
Nigel Kukard's avatar
Nigel Kukard committed
250
		return ERR_PARAM;
Nigel Kukard's avatar
Nigel Kukard committed
251
252
	}

Nigel Kukard's avatar
Nigel Kukard committed
253
254
	# Verify reference
	if (!defined($detail->{'Reference'}) || $detail->{'Reference'} eq "") {
255
		setError("No (or invalid) reference provided for payment '".$detail->{'Number'}."'");
Nigel Kukard's avatar
Nigel Kukard committed
256
		return ERR_PARAM;
Nigel Kukard's avatar
Nigel Kukard committed
257
258
259
260
	}

	# Amount
	if (!defined($detail->{'Amount'}) || $detail->{'Amount'} eq "") {
261
		setError("No (or invalid) amount account provided for payment '".$detail->{'Number'}."'");
Nigel Kukard's avatar
Nigel Kukard committed
262
		return ERR_PARAM;
Nigel Kukard's avatar
Nigel Kukard committed
263
264
265
266
	}

	# Check if supplier exists
	my $supplierID;
267
268
	if (($supplierID = wiaflos::server::core::Suppliers::getSupplierIDFromCode($detail->{'SupplierCode'})) < 0) {
		setError(wiaflos::server::core::Suppliers::Error());
Nigel Kukard's avatar
Nigel Kukard committed
269
270
271
272
		return $supplierID;
	}

	# Check GL account exists
Nigel Kukard's avatar
Nigel Kukard committed
273
	my $GLAccountID;
274
275
	if (($GLAccountID = wiaflos::server::core::GL::getGLAccountIDFromNumber($detail->{'GLAccountNumber'})) < 1) {
		setError(wiaflos::server::core::GL::Error());
Nigel Kukard's avatar
Nigel Kukard committed
276
		return $GLAccountID;
Nigel Kukard's avatar
Nigel Kukard committed
277
278
	}

279
	# Check for conflicts
280
281
	if (supplierPaymentNumberExists($paymentNumber)) {
		setError("Payment number '$paymentNumber' already exists");
Nigel Kukard's avatar
Nigel Kukard committed
282
		return ERR_CONFLICT;
283
284
	}

Nigel Kukard's avatar
Nigel Kukard committed
285
286
	# Create payment
	my $sth = DBDo("
287
		INSERT INTO payments
288
				(SupplierID,GLAccountID,Number,TransactionDate,Reference,Amount,Closed)
Nigel Kukard's avatar
Nigel Kukard committed
289
290
291
			VALUES
				(
					".DBQuote($supplierID).",
Nigel Kukard's avatar
Nigel Kukard committed
292
					".DBQuote($GLAccountID).",
293
					".DBQuote($paymentNumber).",
Nigel Kukard's avatar
Nigel Kukard committed
294
					".DBQuote($detail->{'Date'}).",
Nigel Kukard's avatar
Nigel Kukard committed
295
					".DBQuote($detail->{'Reference'}).",
296
297
					".DBQuote($detail->{'Amount'}).",
					0
Nigel Kukard's avatar
Nigel Kukard committed
298
299
				)
	");
Nigel Kukard's avatar
Nigel Kukard committed
300
	if (!$sth) {
301
		setError(awitpt::db::dblayer::Error());
Nigel Kukard's avatar
Nigel Kukard committed
302
		return ERR_DB;
Nigel Kukard's avatar
Nigel Kukard committed
303
304
305
306
307
308
309
310
311
	}

	# Grab last ID
	my $ID = DBLastInsertID("payments","ID");

	return $ID;
}


312
# Return an array of payments
313
314
# Optional
#		Type - "open", "all"
315
316
sub getPayments
{
317
318
	my ($detail) = @_;
	my $type = defined($detail->{'Type'}) ? $detail->{'Type'} : "open";
319
320
321
322
323
	my @payments = ();


	# Return list of payments
	my $sth = DBSelect("
324
		SELECT
325
326
			ID, SupplierID, GLAccountID, Number, TransactionDate,
			Reference, Amount, Closed
327
328
329
		FROM
			payments
	");
Nigel Kukard's avatar
Nigel Kukard committed
330
	if (!$sth) {
331
		setError(awitpt::db::dblayer::Error());
Nigel Kukard's avatar
Nigel Kukard committed
332
		return ERR_DB;
333
334
335
	}

	# Fetch rows
336
337
338
339
	while (my $row = hashifyLCtoMC($sth->fetchrow_hashref(),
			qw( ID SupplierID GLAccountID Number TransactionDate
				Reference Amount Closed )
	)) {
340
		# Check what kind of payments we want
Nigel Kukard's avatar
Nigel Kukard committed
341
		if (($type eq "open") && $row->{'Closed'} eq "0") {
Nigel Kukard's avatar
Nigel Kukard committed
342
			push(@payments,sanitizeRawItem($row));
343
		} elsif ($type eq "all") {
Nigel Kukard's avatar
Nigel Kukard committed
344
			push(@payments,sanitizeRawItem($row));
345
		}
346
347
348
349
350
351
352
353
	}

	DBFreeRes($sth);

	return \@payments;
}


354
355
# Return an payment hash
# Optional:
Nigel Kukard's avatar
Nigel Kukard committed
356
357
#		Number	- Payment number
#		ID		- Payment ID
358
359
360
361
362
363
364
365
sub getPayment
{
	my ($detail) = @_;


	my $paymentID;

	# Check which 'mode' we operating in
Nigel Kukard's avatar
Nigel Kukard committed
366
	if (!defined($detail->{'ID'}) || $detail->{'ID'} < 1) {
367
		# Verify payment number
Nigel Kukard's avatar
Nigel Kukard committed
368
369
370
		if (!defined($detail->{'Number'}) || $detail->{'Number'} eq "") {
			setError("No (or invalid) payment number provided");
			return ERR_PARAM;
371
372
373
		}

		# Check if payment exists
374
		if (($paymentID = getPaymentIDFromNumber($detail->{'Number'})) < 1) {
375
			setError(Error());
376
377
378
			return $paymentID;
		}
	} else {
Nigel Kukard's avatar
Nigel Kukard committed
379
		$paymentID = $detail->{'ID'};
380
	}
381

382
383
	# Verify payment ID
	if (!$paymentID || $paymentID < 1) {
Nigel Kukard's avatar
Nigel Kukard committed
384
385
		setError("No (or invalid) payment number/id provided");
		return ERR_PARAM;
386
387
388
389
	}

	# Return list of payments
	my $sth = DBSelect("
390
		SELECT
391
			ID, SupplierID, GLAccountID, Number, TransactionDate, Reference, Amount, GLTransactionID, Closed
392
393
394
395
396
		FROM
			payments
		WHERE
			payments.ID = ".DBQuote($paymentID)."
	");
Nigel Kukard's avatar
Nigel Kukard committed
397
	if (!$sth) {
398
		setError(awitpt::db::dblayer::Error());
Nigel Kukard's avatar
Nigel Kukard committed
399
		return ERR_DB;
400
401
402
	}

	# Fetch rows
403
404
405
	my $row = hashifyLCtoMC($sth->fetchrow_hashref(),
			qw( ID SupplierID GLAccountID Number TransactionDate Reference Amount GLTransactionID Closed )
	);
406
407
408
409
410
411
	DBFreeRes($sth);

	return sanitizeRawItem($row);
}


Nigel Kukard's avatar
Nigel Kukard committed
412
# One can now post the payment, which sets GLTransactionID
413
# Parameters:
Nigel Kukard's avatar
Nigel Kukard committed
414
#		Number	- Payment number
415
416
417
418
419
420
sub postPayment
{
	my ($detail) = @_;


	# Verify payment number
Nigel Kukard's avatar
Nigel Kukard committed
421
422
423
	if (!defined($detail->{'Number'}) || $detail->{'Number'} eq "") {
		setError("No (or invalid) payment number provided");
		return ERR_PARAM;
424
425
426
	}

	my $data;
427

428
429
	# Check if payment exists & pull in
	$data = undef;
Nigel Kukard's avatar
Nigel Kukard committed
430
	$data->{'Number'} = $detail->{'Number'};
431
432
	my $payment = getPayment($data);
	if (ref $payment ne "HASH") {
433
		setError(Error());
434
435
436
		return $payment;
	}

437
438
	# Make sure payment is not posted
	if ($payment->{'Posted'} eq "1") {
439
		setError("Payment '".$payment->{'Number'}."' already posted");
Nigel Kukard's avatar
Nigel Kukard committed
440
		return ERR_POSTED;
441
442
	}

443
444
	# Pull in supplier
	$data = undef;
Nigel Kukard's avatar
Nigel Kukard committed
445
	$data->{'ID'} = $payment->{'SupplierID'};
446
	my $supplier = wiaflos::server::core::Suppliers::getSupplier($data);
447
	if (ref $supplier ne "HASH") {
448
		setError(wiaflos::server::core::Suppliers::Error());
449
450
451
452
453
454
		return $payment;
	}

	DBBegin();

	# Create transaction
455
	my $transactionRef = sprintf('Payment: %s',$payment->{'Number'});
456
	$data = undef;
Nigel Kukard's avatar
Nigel Kukard committed
457
458
	$data->{'Date'} = $payment->{'TransactionDate'};
	$data->{'Reference'} = $transactionRef;
459
	my $GLTransactionID = wiaflos::server::core::GL::createGLTransaction($data);
Nigel Kukard's avatar
Nigel Kukard committed
460
	if ($GLTransactionID < 1) {
461
		setError(wiaflos::server::core::GL::Error());
462
		DBRollback();
Nigel Kukard's avatar
Nigel Kukard committed
463
		return $GLTransactionID;
464
465
466
467
	}

	# Pull in amount
	my $transValue = Math::BigFloat->new($payment->{'Amount'});
468
	$transValue->precision(-2);
469
470
471

	# Link to supplier GL account
	$data = undef;
472
	$data->{'ID'} = $GLTransactionID;
Nigel Kukard's avatar
Nigel Kukard committed
473
	$data->{'GLAccountID'} = $supplier->{'GLAccountID'};
474
	$data->{'Amount'} = $transValue->bstr();
475
476
	if ((my $res = wiaflos::server::core::GL::linkGLTransaction($data)) < 1) {
		setError(wiaflos::server::core::GL::Error());
477
478
479
480
481
482
483
484
485
		DBRollback();
		return $res;
	}

	# Negate for other side
	$transValue->bmul(-1);

	# Link from GL
	$data = undef;
486
	$data->{'ID'} = $GLTransactionID;
Nigel Kukard's avatar
Nigel Kukard committed
487
488
	$data->{'Reference'} = $payment->{'Reference'};
	$data->{'GLAccountID'} = $payment->{'GLAccountID'};
489
	$data->{'Amount'} = $transValue->bstr();
490
491
	if ((my $res = wiaflos::server::core::GL::linkGLTransaction($data)) < 1) {
		setError(wiaflos::server::core::GL::Error());
492
493
494
495
496
497
498
499
		DBRollback();
		return $res;
	}

	# Post payment
	my $sth = DBDo("
		UPDATE payments
		SET
Nigel Kukard's avatar
Nigel Kukard committed
500
			GLTransactionID = ".DBQuote($GLTransactionID)."
501
		WHERE
502
			ID = ".DBQuote($payment->{'ID'})."
503
	");
Nigel Kukard's avatar
Nigel Kukard committed
504
	if (!$sth) {
505
		setError(awitpt::db::dblayer::Error());
506
		DBRollback();
Nigel Kukard's avatar
Nigel Kukard committed
507
		return ERR_DB;
508
509
510
511
	}

	# Post transaction
	$data = undef;
Nigel Kukard's avatar
Nigel Kukard committed
512
	$data->{'ID'} = $GLTransactionID;
513
514
	if ((my $res = wiaflos::server::core::GL::postGLTransaction($data)) != 0) {
		setError(wiaflos::server::core::GL::Error());
515
516
517
518
519
520
		DBRollback();
		return $res;
	}

	DBCommit();

Nigel Kukard's avatar
Nigel Kukard committed
521
	return $GLTransactionID;
522
523
524
}


Nigel Kukard's avatar
Nigel Kukard committed
525
526
# Create allocation
# Parameters:
Nigel Kukard's avatar
Nigel Kukard committed
527
528
#		PaymentNumber	- Payment number
#		SupplierInvoiceNumber	- Supplier invoice number
Nigel Kukard's avatar
Nigel Kukard committed
529
#		Amount		- Amount
Nigel Kukard's avatar
Nigel Kukard committed
530
sub createPaymentAllocation
Nigel Kukard's avatar
Nigel Kukard committed
531
532
533
534
{
	my ($detail) = @_;


Nigel Kukard's avatar
Nigel Kukard committed
535
	# Verify payment number
Nigel Kukard's avatar
Nigel Kukard committed
536
	if (!defined($detail->{'PaymentNumber'}) || $detail->{'PaymentNumber'} eq "") {
537
		setError("No (or invalid) payment number provided");
Nigel Kukard's avatar
Nigel Kukard committed
538
		return ERR_PARAM;
Nigel Kukard's avatar
Nigel Kukard committed
539
540
541
	}

	# Verify invoice number
Nigel Kukard's avatar
Nigel Kukard committed
542
	if (!defined($detail->{'SupplierInvoiceNumber'}) || $detail->{'SupplierInvoiceNumber'} eq "") {
543
		setError("No (or invalid) supplier invoice number provided for payment '".$detail->{'PaymentNumber'}."'");
Nigel Kukard's avatar
Nigel Kukard committed
544
		return ERR_PARAM;
Nigel Kukard's avatar
Nigel Kukard committed
545
546
547
548
	}

	# Amount
	if (!defined($detail->{'Amount'}) || $detail->{'Amount'} eq "") {
549
		setError("No (or invalid) amount account provided for payment '".$detail->{'PaymentNumber'}."'");
Nigel Kukard's avatar
Nigel Kukard committed
550
		return ERR_PARAM;
Nigel Kukard's avatar
Nigel Kukard committed
551
	}
552
	my $allocAmount = Math::BigFloat->new($detail->{'Amount'});
553
	$allocAmount->precision(-2);
554
	if ($allocAmount->is_zero()) {
555
		setError("Allocation amount cannot be zero on payment '".$detail->{'PaymentNumber'}."'");
Nigel Kukard's avatar
Nigel Kukard committed
556
		return ERR_AMTZERO;
557
	}
Nigel Kukard's avatar
Nigel Kukard committed
558

559
560
561
562
	my $data;

	# Check if payment exists & pull in
	$data = undef;
Nigel Kukard's avatar
Nigel Kukard committed
563
	$data->{'Number'} = $detail->{'PaymentNumber'};
564
565
	my $payment = getPayment($data);
	if (ref $payment ne "HASH" ) {
566
		setError(Error());
567
568
569
570
571
572
		return $payment;
	}

	# Make sure payment is posted
	if ($payment->{'Posted'} ne "1") {
		setError("Requested payment not posted");
Nigel Kukard's avatar
Nigel Kukard committed
573
		return ERR_POSTED;
Nigel Kukard's avatar
Nigel Kukard committed
574
575
576
	}

	# Grab invoice
577
	$data = undef;
578
	$data->{'Number'} = $detail->{'SupplierInvoiceNumber'};
579
	my $invoice = wiaflos::server::core::Purchasing::getSupplierInvoice($data);
Nigel Kukard's avatar
Nigel Kukard committed
580
	if (ref $invoice ne "HASH") {
581
		setError(wiaflos::server::core::Purchasing::Error());
Nigel Kukard's avatar
Nigel Kukard committed
582
583
584
		return $invoice;
	}

Nigel Kukard's avatar
Nigel Kukard committed
585
586
587
588
589
590
	# Invoice must be posted before we can allocate a payment
	if ($invoice->{'Posted'} ne "1") {
		setError("Cannot allocate a payment to supplier invoice '".$invoice->{'Number'}."' as its not posted");
		return ERR_POSTED;
	}

591
592
	# Grab allocations
	$data = undef;
Nigel Kukard's avatar
Nigel Kukard committed
593
	$data->{'PaymentID'} = $payment->{'ID'};
594
	my $allocs = getPaymentAllocations($data);
595
596
597
	if (ref $allocs ne "ARRAY") {
		return $allocs;
	}
Nigel Kukard's avatar
Nigel Kukard committed
598

599
600
	# Check if we either balance to 0 or have left over
	my $paymentBalance = Math::BigFloat->new($payment->{'Amount'});
601
	$paymentBalance->precision(-2);
602
603
604
605
606
	foreach my $alloc (@{$allocs}) {
		$paymentBalance->bsub($alloc->{'Amount'});
	}
	$paymentBalance->bsub($detail->{'Amount'});
	if ($paymentBalance->is_neg()) {
Nigel Kukard's avatar
Nigel Kukard committed
607
		setError("Creating this allocation will exceed payment '".$detail->{'PaymentNumber'}."' amount by ".$paymentBalance->bstr());
Nigel Kukard's avatar
Nigel Kukard committed
608
		return ERR_OVERALLOC;
609
	}
Nigel Kukard's avatar
Nigel Kukard committed
610
611
612

	# Create payment allocation
	my $sth = DBDo("
613
		INSERT INTO payment_allocations
614
				(PaymentID,SupplierInvoiceID,Amount)
Nigel Kukard's avatar
Nigel Kukard committed
615
616
			VALUES
				(
617
					".DBQuote($payment->{'ID'}).",
618
					".DBQuote($invoice->{'ID'}).",
Nigel Kukard's avatar
Nigel Kukard committed
619
620
621
					".DBQuote($detail->{'Amount'})."
				)
	");
Nigel Kukard's avatar
Nigel Kukard committed
622
	if (!$sth) {
623
		setError(awitpt::db::dblayer::Error());
Nigel Kukard's avatar
Nigel Kukard committed
624
625
		DBRollback();
		return ERR_DB;
Nigel Kukard's avatar
Nigel Kukard committed
626
627
628
	}

	# Grab last ID
629
630
	my $ID = DBLastInsertID("payment_allocations","ID");

Nigel Kukard's avatar
Nigel Kukard committed
631
632
633
634
635

	return $ID;
}


636
637
# Return an array of payment allocations
# Parameters:
Nigel Kukard's avatar
Nigel Kukard committed
638
#		PaymentNumber	- Payment number
639
640
#		PaymentID	- Payment ID
#		SupplierInvoiceID	- Supplier invoice ID
Nigel Kukard's avatar
Nigel Kukard committed
641
sub getPaymentAllocations
642
643
{
	my ($detail) = @_;
644

645
646
647
	my @allocations = ();


648
649
	# SQL query string to use
	my $query = "";
650

651
652
653
	# ID mode
	if (defined($detail->{'PaymentID'}) && $detail->{'PaymentID'} > 0) {
		$query .= "PaymentID = ".$detail->{'PaymentID'};
654

655
	# Payment ref mode
Nigel Kukard's avatar
Nigel Kukard committed
656
	} elsif (defined($detail->{'PaymentNumber'}) && $detail->{'PaymentNumber'} ne "") {
657
658
659
		my $paymentID;

		# Check if payment exists
Nigel Kukard's avatar
Nigel Kukard committed
660
		if (($paymentID = getPaymentIDFromNumber($detail->{'PaymentNumber'})) < 1) {
661
			setError(Error());
662
663
			return $paymentID;
		}
664

665
666
667
668
669
670
671
		$query .= "PaymentID = ".DBQuote($paymentID);

	# Invoice ID mode
	} elsif (defined($detail->{'SupplierInvoiceID'}) && $detail->{'SupplierInvoiceID'} ne "") {
		$query .= "SupplierInvoiceID = ".DBQuote($detail->{'SupplierInvoiceID'});

	} else {
672
		setError("No acceptable parameters provided when getting payment allocations");
Nigel Kukard's avatar
Nigel Kukard committed
673
		return ERR_USAGE;
674
	}
675

676
677
	# Return list of payment allocations
	my $sth = DBSelect("
678
		SELECT
Nigel Kukard's avatar
Nigel Kukard committed
679
			ID, SupplierInvoiceID, Amount, SupplierInvoiceTransactionID
680
		FROM
681
			payment_allocations
682
		WHERE
683
			$query
684
	");
Nigel Kukard's avatar
Nigel Kukard committed
685
	if (!$sth) {
686
		setError(awitpt::db::dblayer::Error());
Nigel Kukard's avatar
Nigel Kukard committed
687
		return ERR_DB;
688
689
690
	}

	# Fetch rows
691
692
693
	while (my $row = hashifyLCtoMC($sth->fetchrow_hashref(),
			qw( ID SupplierInvoiceID Amount SupplierInvoiceTransactionID )
	)) {
Nigel Kukard's avatar
Nigel Kukard committed
694
		push(@allocations,sanitizeRawAllocationItem($row));
695
696
697
698
699
700
701
702
	}

	DBFreeRes($sth);

	return \@allocations;
}


703
704
# Return an hash containing a allocation
# Parameters:
Nigel Kukard's avatar
Nigel Kukard committed
705
706
#		ID	- Allocation ID
sub getPaymentAllocation
707
708
709
710
{
	my ($detail) = @_;

	# Verify allocation id
Nigel Kukard's avatar
Nigel Kukard committed
711
	if (!defined($detail->{'ID'}) || $detail->{'ID'} eq "") {
712
		setError("No (or invalid) allocation ID provided");
Nigel Kukard's avatar
Nigel Kukard committed
713
		return ERR_PARAM;
714
715
716
717
	}

	# Return allocation
	my $sth = DBSelect("
718
		SELECT
Nigel Kukard's avatar
Nigel Kukard committed
719
			ID, PaymentID, SupplierInvoiceID, Amount, SupplierInvoiceTransactionID
720
		FROM
721
			payment_allocations
722
		WHERE
Nigel Kukard's avatar
Nigel Kukard committed
723
			ID = ".DBQuote($detail->{'ID'})."
724
725
	");
	if (!$sth) {
726
		setError(awitpt::db::dblayer::Error());
Nigel Kukard's avatar
Nigel Kukard committed
727
		return ERR_DB;
728
729
730
	}

	# Fetch rows
731
732
	my $row = hashifyLCtoMC($sth->fetchrow_hashref(),
			qw( ID PaymentID SupplierInvoiceID Amount SupplierInvoiceTransactionID ));
733
734
735
736
737
738
739
740
	DBFreeRes($sth);

	return sanitizeRawAllocationItem($row);
}


# One can now post the allocation, which checks the invoice if its totally paid
# Parameters:
Nigel Kukard's avatar
Nigel Kukard committed
741
742
#		ID	- Payment allocation ID
sub postPaymentAllocation
743
744
745
746
747
{
	my ($detail) = @_;


	# Verify allocation ID
Nigel Kukard's avatar
Nigel Kukard committed
748
	if (!defined($detail->{'ID'}) || $detail->{'ID'} eq "") {
749
		setError("No (or invalid) allocation ID provided");
Nigel Kukard's avatar
Nigel Kukard committed
750
		return ERR_PARAM;
751
752
753
	}

	my $data;
754

755
756
	# Check if allocation exists & pull in
	$data = undef;
Nigel Kukard's avatar
Nigel Kukard committed
757
758
	$data->{'ID'} = $detail->{'ID'};
	my $allocation = getPaymentAllocation($data);
759
	if (ref $allocation ne "HASH") {
760
		setError(Error());
761
762
763
		return $allocation;
	}

764
765
766
767
768
769
770
771
772
	# Get corrosponding payment
	$data = undef;
	$data->{'ID'} = $allocation->{'PaymentID'};
	my $payment = getPayment($data);
	if (ref $payment ne "HASH") {
		setError(Error());
		return $payment;
	}

773
774
775
776
777
778
	# Make sure allocation is not posted
	if ($allocation->{'Posted'} ne "0") {
		setError("Allocation '".$allocation->{'ID'}."' on payment '".$payment->{'Number'}."' already posted");
		return ERR_POSTED;
	}

779
780
	# Grab invoice
	$data = undef;
781
	$data->{'ID'} = $allocation->{'SupplierInvoiceID'};
782
	my $invoice = wiaflos::server::core::Purchasing::getSupplierInvoice($data);
783
	if (ref $invoice ne "HASH") {
784
		setError(wiaflos::server::core::Purchasing::Error());
785
786
787
788
789
		return $invoice;
	}

	# Make sure invoice is not paid
	if ($invoice->{'Paid'} ne "0") {
Nigel Kukard's avatar
Nigel Kukard committed
790
		setError("Supplier invoice '".$invoice->{'Number'}."' already paid");
Nigel Kukard's avatar
Nigel Kukard committed
791
		return ERR_PAID;
792
793
	}

794
795
	# Make sure invoice is posted
	if ($invoice->{'Posted'} ne "1") {
Nigel Kukard's avatar
Nigel Kukard committed
796
		setError("Supplier invoice '".$invoice->{'Number'}."' not posted");
Nigel Kukard's avatar
Nigel Kukard committed
797
		return ERR_POSTED;
798
799
	}

800
801
802
	# Grab allocations
	$data = undef;
	$data->{'SupplierInvoiceID'} = $allocation->{'SupplierInvoiceID'};
803
	my $allocs = getPaymentAllocations($data);
804
	if (ref $allocs ne "ARRAY") {
805
		setError(Error());
806
807
808
809
		return $allocs;
	}

	# Check if we either balance to 0 or have left over
810
	my $invBalance = Math::BigFloat->new($invoice->{'Total'});
811
	$invBalance->precision(-2);
Nigel Kukard's avatar
Nigel Kukard committed
812
813
814
	foreach my $item (@{$allocs}) {
		if ($item->{'Posted'} eq "1") {
			$invBalance->bsub($item->{'Amount'});
815
816
		}
	}
817
	# Check invoice balance if its negative, this is if we've overallocated
818
819
	$invBalance->bsub($allocation->{'Amount'});
	if ($invBalance->is_neg()) {
820
		setError("Posting the allocation will end up in a balance of '".$invBalance->bstr()."' on invoice '".$invoice->{'Number'}."'");
Nigel Kukard's avatar
Nigel Kukard committed
821
		return ERR_NOBALANCE;
822
823
	}

824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
	# Grab payment allocations
	$data = undef;
	$data->{'PaymentID'} = $payment->{'ID'};
	my $paymentAllocations = getPaymentAllocations($data);
	if (ref $paymentAllocations ne "ARRAY") {
		setError(Error());
		return $paymentAllocations;
	}
	# Add up payment balance
	my $paymentBalance = Math::BigFloat->new($payment->{'Amount'});
	foreach my $alloc (@{$paymentAllocations}) {
		if ($alloc->{'Posted'} eq "1") {
			$paymentBalance->bsub($alloc->{'Amount'});
		}
	}
	# Check payment balance if its negative, this is if we've overallocated
	$paymentBalance->bsub($allocation->{'Amount'});
	if ($paymentBalance->is_neg()) {
		setError("Posting the allocation will end up in a balance of '".$paymentBalance->bstr()."' on payment '".$payment->{'Number'}."'");
		return ERR_OVERALLOC;
	}

846
847
	DBBegin();

848
849
850
851
	# If we equal out our payment, mark it as being closed
	if ($paymentBalance->is_zero()) {
		# Close it off
		my $sth = DBDo("
852
			UPDATE
853
854
855
856
857
858
859
				payments
			SET
				Closed = 1
			WHERE
				ID = ".DBQuote($payment->{'ID'})."
		");
		if (!$sth) {
860
			setError(awitpt::db::dblayer::Error());
Nigel Kukard's avatar
Nigel Kukard committed
861
862
			DBRollback();
			return ERR_DB;
863
864
865
		}
	}

Nigel Kukard's avatar
Nigel Kukard committed
866
867
868
869
870
	# Create supplier invoice transaction
	$data = undef;
	$data->{'ID'} = $invoice->{'ID'};
	$data->{'Amount'} = Math::BigFloat->new($allocation->{'Amount'})->bneg();
	$data->{'PaymentAllocationID'} = $allocation->{'ID'};
871
	my $supplierInvoiceTransactionID = wiaflos::server::core::Purchasing::allocateSupplierInvoiceTransaction($data);
Nigel Kukard's avatar
Nigel Kukard committed
872
	if ($supplierInvoiceTransactionID < 1) {
873
		setError(wiaflos::server::core::Purchasing::Error());
Nigel Kukard's avatar
Nigel Kukard committed
874
875
876
877
		DBRollback();
		return $supplierInvoiceTransactionID;
	}

878
879
	# Post allocation
	my $sth = DBDo("
880
		UPDATE payment_allocations
881
		SET
Nigel Kukard's avatar
Nigel Kukard committed
882
			SupplierInvoiceTransactionID = ".DBQuote($supplierInvoiceTransactionID)."
883
884
885
		WHERE
			ID = ".DBQuote($allocation->{'ID'})."
	");
Nigel Kukard's avatar
Nigel Kukard committed
886
	if (!$sth) {
887
		setError(awitpt::db::dblayer::Error());
888
		DBRollback();
Nigel Kukard's avatar
Nigel Kukard committed
889
		return ERR_DB;
890
891
892
893
	}

	DBCommit();

Nigel Kukard's avatar
Nigel Kukard committed
894
	return RES_OK;
895
896
897
898
}



Nigel Kukard's avatar
Nigel Kukard committed
899
900
1;
# vim: ts=4