GL.pm 36.9 KB
Newer Older
1
# General ledger functions
2
# Copyright (C) 2009-2014, AllWorldIT
Nigel Kukard's avatar
Nigel Kukard committed
3
# Copyright (C) 2008, LinuxRulz
Nigel Kukard's avatar
Nigel Kukard committed
4
# Copyright (C) 2006-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::GL;
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
use awitpt::db::dblayer;
use awitpt::cache;
Nigel Kukard's avatar
Nigel Kukard committed
32

33
34
use Math::BigFloat;

35
36
37
38
39
40
41
42
43
44
45
46
# Exporter stuff
require Exporter;
our (@ISA,@EXPORT,@EXPORT_OK);
@ISA = qw(Exporter);
@EXPORT = qw(
	GL_TRANSTYPE_NORMAL
	GL_TRANSTYPE_YEAREND
	GL_TRANSTYPE_AUDIT
	GL_TRANSTYPE_AUDIT_YEAREND
);
@EXPORT_OK = ();

47

48
49
use constant {
	GL_TRANSTYPE_NORMAL	=>	1,
50
51
52
	GL_TRANSTYPE_YEAREND	=>	2,
	GL_TRANSTYPE_AUDIT	=>	4,
	GL_TRANSTYPE_AUDIT_YEAREND	=>	8
53
54
};

Nigel Kukard's avatar
Nigel Kukard committed
55
56
57
58

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

59
60
61
62
63
# Set current error message
# Args: error_message
sub setError
{
	my $err = shift;
64
65
	my ($package,$filename,$line) = caller;
	my (undef,undef,undef,$subroutine) = caller(1);
66
67

	# Set error
68
	$error = "$subroutine($line): $err";
69
70
}

Nigel Kukard's avatar
Nigel Kukard committed
71
72
73
74
75
76
77
78
79
80
81
82
83
84
# Return current error message
# Args: none
sub Error
{
	my $err = $error;

	# Reset error
	$error = "";

	# Return error
	return $err;
}


85
86
87
88
# Backend function to build account item hash
sub sanitizeRawGLAccountItem
{
	my $rawData = shift;
89
90


91
	my $item;
Nigel Kukard's avatar
Nigel Kukard committed
92
	$item->{'ID'} = $rawData->{'ID'};
93

Nigel Kukard's avatar
Nigel Kukard committed
94
	$item->{'Number'} = getGLAccountNumberFromID($rawData->{'ID'});
95

Nigel Kukard's avatar
Nigel Kukard committed
96
	$item->{'ParentGLAccountID'} = $rawData->{'ParentGLAccountID'};
Nigel Kukard's avatar
Nigel Kukard committed
97
98
99
100
101
	$item->{'Name'} = $rawData->{'Name'};
	$item->{'FinCatCode'} = $rawData->{'FinCatCode'};
	$item->{'FinCatDescription'} = $rawData->{'FinCatDescription'};
	$item->{'RwCatCode'} = $rawData->{'RwCatCode'};
	$item->{'RwCatDescription'} = $rawData->{'RwCatDescription'};
102
103
104
105
106
107
108
109
110
111

	return $item;
}



# Backend function to build GL transaction item hash
sub sanitizeRawGLTransactionItem
{
	my $rawData = shift;
112
113


114
115
	my $item;

Nigel Kukard's avatar
Nigel Kukard committed
116
117
118
	$item->{'ID'} = $rawData->{'ID'};
	$item->{'TransactionDate'} = $rawData->{'TransactionDate'};
	$item->{'Reference'} = $rawData->{'Reference'};
119
	$item->{'Type'} = $rawData->{'Type'};
Nigel Kukard's avatar
Nigel Kukard committed
120
	$item->{'Posted'} = $rawData->{'Posted'};
121
122
123
124
125
126

	return $item;
}



Nigel Kukard's avatar
Nigel Kukard committed
127
# Check if GL account ID exists
128
# Backend function, takes 1 parameter which is the GL account ID
Nigel Kukard's avatar
Nigel Kukard committed
129
sub GLAccountIDExists
130
131
132
133
{
	my $GLAccID = shift;


134
135
136
	# Select account count
	my $rows = DBSelectNumResults("FROM gl_accounts WHERE ID = ".DBQuote($GLAccID));
	if (!defined($rows)) {
137
		setError(awitpt::db::dblayer::Error());
Nigel Kukard's avatar
Nigel Kukard committed
138
		return ERR_DB;
139
140
141
	}

	# Check we got a result
142
	if ($rows < 1) {
143
		setError("Error finding GL account '$GLAccID'");
Nigel Kukard's avatar
Nigel Kukard committed
144
		return ERR_NOTFOUND;
145
146
147
148
149
150
	}

	return 1;
}


Nigel Kukard's avatar
Nigel Kukard committed
151
152
# Check if a GL account code exists
sub GLAccountCodeExists
153
{
Nigel Kukard's avatar
Nigel Kukard committed
154
	my ($parentID,$code) = @_;
155
156
	my $extra_sql = "";

157

158
159
	# If we have a parent use it
	if (defined($parentID) && $parentID ne "") {
Nigel Kukard's avatar
Nigel Kukard committed
160
		$extra_sql .= " AND ParentGLAccountID = ".DBQuote($parentID);
161
	} else {
Nigel Kukard's avatar
Nigel Kukard committed
162
		$extra_sql .= " AND ParentGLAccountID IS NULL";
163
	}
164

165
166
167
	# Select account count
	my $rows = DBSelectNumResults("FROM gl_accounts WHERE Code = ".DBQuote($code)." $extra_sql");
	if (!defined($rows)) {
168
		setError(awitpt::db::dblayer::Error());
Nigel Kukard's avatar
Nigel Kukard committed
169
		return ERR_DB;
170
171
172
173
174
175
	}

	return $rows > 0 ? 1 : 0;
}


176
177
# Check if transaction exists
# Backend function, takes 1 parameter which is the transaction ID
Nigel Kukard's avatar
Nigel Kukard committed
178
sub GLTransactionIDExists
179
180
181
182
{
	my $transActID = shift;


183
184
185
	# Select transaction count
	my $rows = DBSelectNumResults("FROM gl_transactions WHERE ID = ".DBQuote($transActID));
	if (!defined($rows)) {
186
		setError(awitpt::db::dblayer::Error());
Nigel Kukard's avatar
Nigel Kukard committed
187
		return ERR_DB;
188
189
	}

190
	return $rows > 0 ? 1 : 0;
191
192
193
}


Nigel Kukard's avatar
Nigel Kukard committed
194
195
196
# Get GL account ID from GL account number
# Backend function, takes a GL account number and returns the GL account ID
sub getGLAccountIDFromNumber
197
{
Nigel Kukard's avatar
Nigel Kukard committed
198
	my $GLAccNumber = shift;
199
200


201
202
203
	# Check cache
	my ($cache_res,$cache) = cacheGetKeyPair('GL/Number-to-AccountID',$GLAccNumber);
	if ($cache_res != RES_OK) {
204
		setError(awitpt::cache::Error());
205
206
207
208
209
		return $cache_res;
	}
	return $cache if (defined($cache));


210
211
	# Pull list of GL accounts
	my $sth = DBSelect("
212
		SELECT
Nigel Kukard's avatar
Nigel Kukard committed
213
			ID, Code
214
215
216
		FROM
			gl_accounts
	");
Nigel Kukard's avatar
Nigel Kukard committed
217
	if (!$sth) {
218
		setError(awitpt::db::dblayer::Error());
Nigel Kukard's avatar
Nigel Kukard committed
219
		return ERR_DB;
220
221
222
	}

	# Fetch rows, while we not found anything
223
	my $GLAccID;
224
	while ((my $row = hashifyLCtoMC($sth->fetchrow_hashref(),qw( ID Code ))) && !defined($GLAccID)) {
Nigel Kukard's avatar
Nigel Kukard committed
225
226
		my $tmpGLAccNumber = getGLAccountNumberFromID($row->{'ID'});
		# If not defined b0rk out
Nigel Kukard's avatar
Nigel Kukard committed
227
		if (!defined($tmpGLAccNumber)) {
228
			DBFreeRes($sth);
Nigel Kukard's avatar
Nigel Kukard committed
229
			return ERR_UNKNOWN;
230
231
232
		}

		# Check if we found it
Nigel Kukard's avatar
Nigel Kukard committed
233
		if ($GLAccNumber eq $tmpGLAccNumber) {
234
235
236
237
238
239
			$GLAccID = $row->{'ID'};
		}
	}

	DBFreeRes($sth);

240
	if (!defined($GLAccID)) {
241
		setError("Error finding GL account '$GLAccNumber'");
242
243
		return ERR_NOTFOUND;
	}
244

245
246
247
	# Cache this
	$cache_res = cacheStoreKeyPair('GL/Number-to-AccountID',$GLAccNumber,$GLAccID);
	if ($cache_res != RES_OK) {
248
		setError(awitpt::cache::Error());
249
250
251
		return $cache_res;
	}

252
253
254
255
	return $GLAccID;
}


Nigel Kukard's avatar
Nigel Kukard committed
256
257
# Return financial category ID from code
sub getGLFinCatIDFromCode
258
{
Nigel Kukard's avatar
Nigel Kukard committed
259
	my $finCatCode = shift;
260
261
262
263


	# Select financial category
	my $sth = DBSelect("
264
		SELECT
265
266
			ID
		FROM
267
			gl_financial_categories
268
		WHERE
Nigel Kukard's avatar
Nigel Kukard committed
269
			Code = ".DBQuote($finCatCode)."
270
	");
Nigel Kukard's avatar
Nigel Kukard committed
271
	if (!$sth) {
272
		setError(awitpt::db::dblayer::Error());
Nigel Kukard's avatar
Nigel Kukard committed
273
		return ERR_DB;
274
275
	}

276
	my $row = hashifyLCtoMC($sth->fetchrow_hashref(),qw( ID ));
277
278
	DBFreeRes($sth);

279
	# Check we got a result
280
	if (!defined($row)) {
281
		setError("Error finding financial category '$finCatCode'");
Nigel Kukard's avatar
Nigel Kukard committed
282
		return ERR_NOTFOUND;
283
284
285
286
287
288
	}

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


Nigel Kukard's avatar
Nigel Kukard committed
289
290
# Return reporting category ID from code
sub getGLRwCatIDFromCode
291
{
Nigel Kukard's avatar
Nigel Kukard committed
292
	my $rwCatCode = shift;
293
294
295
296


	# Select reporting category
	my $sth = DBSelect("
297
		SELECT
298
299
			ID
		FROM
300
			gl_reportwriter_categories
301
		WHERE
Nigel Kukard's avatar
Nigel Kukard committed
302
			Code = ".DBQuote($rwCatCode)."
303
	");
Nigel Kukard's avatar
Nigel Kukard committed
304
	if (!$sth) {
305
		setError(awitpt::db::dblayer::Error());
Nigel Kukard's avatar
Nigel Kukard committed
306
		return ERR_DB;
307
308
	}

309
	my $row = hashifyLCtoMC($sth->fetchrow_hashref(),qw( ID ));
310
311
	DBFreeRes($sth);

312
	# Check we got a result
313
	if (!defined($row)) {
314
		setError("Error finding reporting category '$rwCatCode'");
Nigel Kukard's avatar
Nigel Kukard committed
315
		return ERR_NOTFOUND;
316
317
318
319
320
321
	}

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


322
323
324
325
326
# Return report writer categories
sub getGLRwCats
{
	# Select reporting category
	my $sth = DBSelect("
327
		SELECT
328
329
330
331
332
			ID, Code, Description
		FROM
			gl_reportwriter_categories
	");
	if (!$sth) {
333
		setError(awitpt::db::dblayer::Error());
334
335
336
337
338
		return ERR_DB;
	}

	# Fetch rows
	my @entries;
339
	while (my $row = hashifyLCtoMC($sth->fetchrow_hashref(),qw( ID Code Description ))) {
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
		my $entry;

		$entry->{'ID'} = $row->{'ID'};
		$entry->{'Code'} = $row->{'Code'};
		$entry->{'Description'} = $row->{'Description'};

		push(@entries,$entry);
	}

	DBFreeRes($sth);

	return \@entries;
}


355
# Resolve the full GL account reference
Nigel Kukard's avatar
Nigel Kukard committed
356
sub getGLAccountNumberFromID
Nigel Kukard's avatar
Nigel Kukard committed
357
358
359
{
	my $accID = shift;

360

361
362
363
	# Check cache
	my ($cache_res,$cache) = cacheGetKeyPair('GL/AccountID-to-Number',$accID);
	if ($cache_res != RES_OK) {
364
		setError(awitpt::cache::Error());
365
366
367
368
369
		return $cache_res;
	}
	return $cache if (defined($cache));


Nigel Kukard's avatar
Nigel Kukard committed
370
371
	# Return account ref & parent
	my $sth = DBSelect("
372
		SELECT
373
			Code, ParentGLAccountID
Nigel Kukard's avatar
Nigel Kukard committed
374
375
376
		FROM
			gl_accounts
		WHERE
377
			ID = ".DBQuote($accID)."
Nigel Kukard's avatar
Nigel Kukard committed
378
	");
Nigel Kukard's avatar
Nigel Kukard committed
379
	if (!$sth) {
380
		setError(awitpt::db::dblayer::Error());
Nigel Kukard's avatar
Nigel Kukard committed
381
		return undef;
Nigel Kukard's avatar
Nigel Kukard committed
382
383
	}

384
	# Grab row & free
385
	my $row = hashifyLCtoMC($sth->fetchrow_hashref(),qw( Code ParentGLAccountID ));
386
	DBFreeRes($sth);
Nigel Kukard's avatar
Nigel Kukard committed
387

Nigel Kukard's avatar
Nigel Kukard committed
388
389
	# Get parent acc number ... or if we the parent, return our acc number
	my $accnum = "";
Nigel Kukard's avatar
Nigel Kukard committed
390
	# If we have parent, get its ref
391
	if (defined($row->{'ParentGLAccountID'})) {
Nigel Kukard's avatar
Nigel Kukard committed
392
		# Check return value
393
		if (my $ret = getGLAccountNumberFromID($row->{'ParentGLAccountID'})) {
Nigel Kukard's avatar
Nigel Kukard committed
394
			# And add ref to our ref
Nigel Kukard's avatar
Nigel Kukard committed
395
			$accnum = "$ret:".$row->{'Code'};
Nigel Kukard's avatar
Nigel Kukard committed
396
397
398
		} else {
			return undef;
		}
Nigel Kukard's avatar
Nigel Kukard committed
399
	} else {
Nigel Kukard's avatar
Nigel Kukard committed
400
		$accnum = $row->{'Code'};
Nigel Kukard's avatar
Nigel Kukard committed
401
402
	}

403
404
405
	# Cache this
	$cache_res = cacheStoreKeyPair('GL/AccountID-to-Number',$accID,$accnum);
	if ($cache_res != RES_OK) {
406
		setError(awitpt::cache::Error());
407
408
409
410
		return $cache_res;
	}


Nigel Kukard's avatar
Nigel Kukard committed
411
	return $accnum;
Nigel Kukard's avatar
Nigel Kukard committed
412
413
414
}


415
416
417
418
# Check GL account financial category
# Returns:
#	1	- match
#	0	- no match
Nigel Kukard's avatar
Nigel Kukard committed
419
sub checkGLAccountFinCat
420
{
Nigel Kukard's avatar
Nigel Kukard committed
421
	my ($GLAccID,$finCatCode) = @_;
422
423
424
425


	# Check and return GL account financial category
	my $sth = DBSelect("
426
		SELECT
427
			gl_financial_categories.Code
428
		FROM
429
			gl_financial_categories, gl_accounts
430
431
		WHERE
			gl_accounts.ID = ".DBQuote($GLAccID)."
432
			AND gl_financial_categories.ID = gl_accounts.FinCatID
433
	");
Nigel Kukard's avatar
Nigel Kukard committed
434
	if (!$sth) {
435
		setError(awitpt::db::dblayer::Error());
Nigel Kukard's avatar
Nigel Kukard committed
436
		return ERR_DB;
437
438
439
	}

	# Grab row
440
	my $row = hashifyLCtoMC($sth->fetchrow_hashref(),qw( Code ));
441
442
	DBFreeRes($sth);

443
444
	# Check we got a result
	if (!defined($row)) {
445
		setError("Error finding GL account '$GLAccID'");
446
447
448
		return ERR_NOTFOUND;
	}

Nigel Kukard's avatar
Nigel Kukard committed
449
	return $row->{'Code'} eq $finCatCode ? 1 : 0;
450
451
452
453
}



Nigel Kukard's avatar
Nigel Kukard committed
454
455
456
457
458
459
460
461
462
463
## @fn getGLAccountTree
# Resolve the set of accounts into a tree
#
# @returns Array ref of hash refs, @see getGLAccounts with the additional items...
# @li Children Array ref of hash refs, children of this account
# @li Level Depth level of this account
sub getGLAccountTree
{
	# Grab account list
	my $accounts = getGLAccounts();
Nigel Kukard's avatar
Nigel Kukard committed
464
	if (ref($accounts) ne "ARRAY") {
Nigel Kukard's avatar
Nigel Kukard committed
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
		return $accounts;
	}

	my %accountsByID;
	my @paccounts; # Parent accounts
	foreach my $account (@{$accounts}) {
		# Generate our rows by ID table
		$accountsByID{$account->{'ID'}} = $account;
		# Check if we're a parent account
		push(@paccounts,$account) if (!defined($account->{'ParentGLAccountID'}));
	}
	# Resolve children
	foreach my $account (@{$accounts}) {
		# Make sure we're a child and not a parent
		if (defined($account->{'ParentGLAccountID'})) {
			# This is the account parent
			my $parent = $accountsByID{$account->{'ParentGLAccountID'}};
			# Attach us as a child
			push(@{$parent->{'Children'}}, $account);
		}
	}
	# Resolve levels
	foreach my $parent (@paccounts) {
		# Resolve the account level
		sub resolveLevel {
			my ($raccount,$plevel) = @_;

			# We 1 level down
			$raccount->{'Level'} = $plevel + 1;
			# Loop with children
			foreach my $caccount (@{$raccount->{'Children'}}) {
				resolveLevel($caccount,$raccount->{'Level'});
			}
		}
		# Parents are level 0, so we set this to -1
		resolveLevel($parent,-1);
501
	}
Nigel Kukard's avatar
Nigel Kukard committed
502
503
504
505
506

	return \@paccounts;
}


Nigel Kukard's avatar
Nigel Kukard committed
507
# Return an array of general ledger accounts
Nigel Kukard's avatar
Nigel Kukard committed
508
sub getGLAccounts
Nigel Kukard's avatar
Nigel Kukard committed
509
510
511
512
513
{
	my @accounts = ();

	# Return list of GL accounts
	my $sth = DBSelect("
514
		SELECT
Nigel Kukard's avatar
Nigel Kukard committed
515
			gl_accounts.ID, gl_accounts.ParentGLAccountID, gl_accounts.Code, gl_accounts.Name,
516

517
			gl_financial_categories.Code AS FinCatCode, gl_financial_categories.Description AS FinCatDescription,
518

519
			gl_reportwriter_categories.Code AS RwCatCode, gl_reportwriter_categories.Description AS RwCatDescription
520

Nigel Kukard's avatar
Nigel Kukard committed
521
		FROM
522
			gl_accounts, gl_financial_categories, gl_reportwriter_categories
523

Nigel Kukard's avatar
Nigel Kukard committed
524
		WHERE
525
			gl_financial_categories.ID = gl_accounts.FinCatID
526
			AND gl_reportwriter_categories.ID = gl_accounts.RwCatID
Nigel Kukard's avatar
Nigel Kukard committed
527
	");
Nigel Kukard's avatar
Nigel Kukard committed
528
	if (!$sth) {
529
		setError(awitpt::db::dblayer::Error());
Nigel Kukard's avatar
Nigel Kukard committed
530
		return ERR_DB;
Nigel Kukard's avatar
Nigel Kukard committed
531
532
533
	}

	# Fetch rows
534
535
536
	while (my $row = hashifyLCtoMC($sth->fetchrow_hashref(),
			qw( ID ParentGLAccountID Code Name FinCatCode FinCatDescription RwCatCode RwCatDescription )
	)) {
Nigel Kukard's avatar
Nigel Kukard committed
537
		my $account = sanitizeRawGLAccountItem($row);
Nigel Kukard's avatar
Nigel Kukard committed
538

Nigel Kukard's avatar
Nigel Kukard committed
539
		push(@accounts,$account);
540
	}
Nigel Kukard's avatar
Nigel Kukard committed
541

542
	DBFreeRes($sth);
Nigel Kukard's avatar
Nigel Kukard committed
543

544
545
	return \@accounts;
}
Nigel Kukard's avatar
Nigel Kukard committed
546

547
548
549

# Return a hash containing account details
# Parameters:
Nigel Kukard's avatar
Nigel Kukard committed
550
#		AccountID		- GL account ID
Nigel Kukard's avatar
Nigel Kukard committed
551
552
#		AccountNumber	- GL account reference
sub getGLAccount
553
554
555
556
557
{
	my ($data) = @_;


	my $GLAccID;
Nigel Kukard's avatar
Nigel Kukard committed
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574

	# Check which 'mode' we operating in
	if (!defined($data->{'AccountID'}) || $data->{'AccountID'} < 1) {
		# Verify GL account ref
		if (!defined($data->{'AccountNumber'}) || $data->{'AccountNumber'} eq "") {
			setError("No (or invalid) account number provided");
			return ERR_PARAM;
		}

		# Check if account number exists
		if (($GLAccID = getGLAccountIDFromNumber($data->{'AccountNumber'})) < 1) {
			setError(Error());
			return $GLAccID;
		}
	} else {
		$GLAccID = $data->{'AccountID'};
	}
575

Nigel Kukard's avatar
Nigel Kukard committed
576
577
578
579
	# Verify account ID
	if (!$GLAccID || $GLAccID < 1) {
		setError("No (or invalid) account number or ID provided");
		return ERR_PARAM;
580
581
582
	}

	my $sth = DBSelect("
583
		SELECT
Nigel Kukard's avatar
Nigel Kukard committed
584
			gl_accounts.ID, gl_accounts.ParentGLAccountID, gl_accounts.Code, gl_accounts.Name,
585

586
			gl_financial_categories.Code AS FinCatCode, gl_financial_categories.Description AS FinCatDescription,
587

588
			gl_reportwriter_categories.Code AS RwCatCode, gl_reportwriter_categories.Description AS RwCatDescription
589

590
		FROM
591
			gl_accounts, gl_financial_categories, gl_reportwriter_categories
592

593
594
		WHERE
			gl_accounts.ID = ".DBQuote($GLAccID)."
595
			AND gl_financial_categories.ID = gl_accounts.FinCatID
596
			AND gl_reportwriter_categories.ID = gl_accounts.RwCatID
597
	");
Nigel Kukard's avatar
Nigel Kukard committed
598
	if (!$sth) {
599
		setError(awitpt::db::dblayer::Error());
Nigel Kukard's avatar
Nigel Kukard committed
600
		return ERR_DB;
Nigel Kukard's avatar
Nigel Kukard committed
601
602
	}

603
	# Fetch row
604
605
606
	my $row = hashifyLCtoMC($sth->fetchrow_hashref(),
			qw( ID ParentGLAccountID Code Name FinCatCode FinCatDescription RwCatCode RwCatDescription )
	);
607
608
	DBFreeRes($sth);

609
	# Check we got a result
610
	if (!defined($row)) {
611
		setError("Error finding account '$GLAccID'");
Nigel Kukard's avatar
Nigel Kukard committed
612
		return ERR_NOTFOUND;
613
614
	}

Nigel Kukard's avatar
Nigel Kukard committed
615

Nigel Kukard's avatar
Nigel Kukard committed
616
	return sanitizeRawGLAccountItem($row);
617
618
619
}


Nigel Kukard's avatar
Nigel Kukard committed
620
# Return the next sub account code
621
# Parameters:
Nigel Kukard's avatar
Nigel Kukard committed
622
623
#		AccountNumber	- GL account reference
sub getNextGLSubAccountCode
624
625
626
627
{
	my ($data) = @_;


Nigel Kukard's avatar
Nigel Kukard committed
628
629
630
631
	# Verify GL account number
	if (!defined($data->{'AccountNumber'}) || $data->{'AccountNumber'} eq "") {
		setError("No (or invalid) GL account number provided");
		return ERR_PARAM;
632
633
634
635
	}

	# Check GL account exists
	my $GLAccID;
Nigel Kukard's avatar
Nigel Kukard committed
636
	if (($GLAccID = getGLAccountIDFromNumber($data->{'AccountNumber'})) < 1) {
637
		setError(Error());
638
639
640
641
642
		return $GLAccID;
	}

	# Select last account
	my $sth = DBSelect("
643
		SELECT
Nigel Kukard's avatar
Nigel Kukard committed
644
			Code
645
646
647
		FROM
			gl_accounts
		WHERE
648
			ParentGLAccountID = ".DBQuote($GLAccID)."
Nigel Kukard's avatar
Nigel Kukard committed
649
		ORDER BY Code DESC
650
651
		LIMIT 1
	");
Nigel Kukard's avatar
Nigel Kukard committed
652
	if (!$sth) {
653
		setError(awitpt::db::dblayer::Error());
Nigel Kukard's avatar
Nigel Kukard committed
654
		return ERR_DB;
655
656
657
	}

	# Fetch row
658
	my $row = hashifyLCtoMC($sth->fetchrow_hashref(), qw( Code ));
659
660
	DBFreeRes($sth);

661
662
663
664
665
	# Check we got a result, if not return 1
	if (!defined($row)) {
		return 1;
	}

Nigel Kukard's avatar
Nigel Kukard committed
666
	return $row->{'Code'} + 1;
Nigel Kukard's avatar
Nigel Kukard committed
667
668
669
}


670
## @fn getGLTransactions($data)
Nigel Kukard's avatar
Nigel Kukard committed
671
# Return an array of general ledger transactions
672
673
674
675
676
#
# @param data Parameter hash ref
# @li AccountID Limit transactions to those relating to this account
# @li StartDate	Optional start date
# @li EndDate Optional end date
677
# @li Type Optional transaction type
678
679
680
681
682
683
#
# @returns Array ref of hash refs
# @li ID GL entry ID
# @li TransactionDate Transaction date
# @li Reference GL entry reference
# @li Posted 0 if unposted, 1 if posted
684
# @li Type Transaction type
Nigel Kukard's avatar
Nigel Kukard committed
685
sub getGLTransactions
Nigel Kukard's avatar
Nigel Kukard committed
686
{
687
688
	my $data = shift;

Nigel Kukard's avatar
Nigel Kukard committed
689
690
	my @transactions = ();

691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
	# Extra SQL we may need
	my $extraSQL = "";
	my $extraTables = "";
	my $extraEndSQL = "";

	# Check if we have an account ID
	if (defined($data->{'AccountID'}) && $data->{'AccountID'} > 0) {
		$extraTables .= ", gl_entries";
		$extraSQL .= "AND gl_entries.GLAccountID = ".DBQuote($data->{'AccountID'})." ";
		$extraSQL .= "AND gl_entries.GLTransactionID = gl_transactions.ID ";
		$extraEndSQL .= "GROUP BY gl_transactions.ID ";
	}

	# Check if we must use the start date
	if (defined($data->{'StartDate'}) && $data->{'StartDate'} ne "") {
		$extraSQL .= "AND gl_transactions.TransactionDate >= ".DBQuote($data->{'StartDate'})." ";
	}
	# Check if we must use the end date
	if (defined($data->{'EndDate'}) && $data->{'EndDate'} ne "") {
		$extraSQL .= "AND gl_transactions.TransactionDate <= ".DBQuote($data->{'EndDate'})." ";
	}

713
	# Check if we're filtering on type
714
	my $typeFilter = GL_TRANSTYPE_NORMAL;
715
716
717
718
	if (defined($data->{'Type'}) && $data->{'Type'} ne "") {
		$typeFilter = $data->{'Type'};
	}

Nigel Kukard's avatar
Nigel Kukard committed
719
720
	# Return list of GL transactions
	my $sth = DBSelect("
721
		SELECT
722
			ID, TransactionDate, Reference, Type, Posted
Nigel Kukard's avatar
Nigel Kukard committed
723
		FROM
724
725
726
727
728
			gl_transactions $extraTables
		WHERE
			1 = 1
			$extraSQL
		$extraEndSQL
Nigel Kukard's avatar
Nigel Kukard committed
729
	");
Nigel Kukard's avatar
Nigel Kukard committed
730
	if (!$sth) {
731
		setError(awitpt::db::dblayer::Error());
Nigel Kukard's avatar
Nigel Kukard committed
732
		return ERR_DB;
Nigel Kukard's avatar
Nigel Kukard committed
733
734
735
	}

	# Fetch rows
736
	while (my $row = hashifyLCtoMC($sth->fetchrow_hashref(), qw( ID TransactionDate Reference Type Posted ))) {
737
		# Check filter, if this is not one of our items, continue
738
		if (! ($typeFilter & $row->{'Type'})) {
739
740
741
			next;
		}

Nigel Kukard's avatar
Nigel Kukard committed
742
		my $transaction = sanitizeRawGLTransactionItem($row);
Nigel Kukard's avatar
Nigel Kukard committed
743

Nigel Kukard's avatar
Nigel Kukard committed
744
		push(@transactions,$transaction);
Nigel Kukard's avatar
Nigel Kukard committed
745
746
747
748
749
750
751
752
	}

	DBFreeRes($sth);

	return \@transactions;
}


753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
# Return a hash containing a GL transaction
# Parameters:
#		ID	- Transaction ID
sub getGLTransaction
{
	my ($detail) = @_;


	# Verify params
	if (!defined($detail->{'ID'}) || $detail->{'ID'} < 1) {
		setError("Transaction ID not provided");
		return ERR_PARAM;
	}

	# Return list of GL transactions
	my $sth = DBSelect("
769
		SELECT
770
771
772
773
774
775
776
			ID, TransactionDate, Reference, Posted
		FROM
			gl_transactions
		WHERE
			ID = ".DBQuote($detail->{'ID'})."
	");
	if (!$sth) {
777
		setError(awitpt::db::dblayer::Error());
Nigel Kukard's avatar
Nigel Kukard committed
778
		return ERR_DB;
779
780
781
	}

	# Fetch rows
782
	my $row = hashifyLCtoMC($sth->fetchrow_hashref(),qw( ID TransactionDate Reference Posted ));
783
784
785
786
787
788
789
790
791
792
793
794
	DBFreeRes($sth);

	# Check we got a result
	if (!$row) {
		setError("GL transaction '".$detail->{'ID'}."' not found");
		return ERR_NOTFOUND;
	}

	return sanitizeRawGLTransactionItem($row);
}


795
## @fn createGLTransaction($data)
Nigel Kukard's avatar
Nigel Kukard committed
796
# Create GL transaction
797
798
799
800
801
802
803
#
# @param data Parameter hash ref
# @li Date Date of transaction
# @li Reference Reference of transaction
# @li Type Optional transaction type
#
# @returns Transaction ID
Nigel Kukard's avatar
Nigel Kukard committed
804
sub createGLTransaction
Nigel Kukard's avatar
Nigel Kukard committed
805
{
806
	my ($detail) = @_;
Nigel Kukard's avatar
Nigel Kukard committed
807

Nigel Kukard's avatar
Nigel Kukard committed
808

809
810
811
812
	# Extra SQL we may need
	my $extraColumns = "";
	my $extraValues = "";

Nigel Kukard's avatar
Nigel Kukard committed
813
	# Verify date
814
	if (!defined($detail->{'Date'}) || $detail->{'Date'} eq "") {
815
		setError("No date provided for GL transaction");
Nigel Kukard's avatar
Nigel Kukard committed
816
		return ERR_PARAM;
Nigel Kukard's avatar
Nigel Kukard committed
817
818
819
	}

	# Verify reference
Nigel Kukard's avatar
Nigel Kukard committed
820
	if (!defined($detail->{'Reference'}) || $detail->{'Reference'} eq "") {
821
		setError("No reference provided for GL transaction");
Nigel Kukard's avatar
Nigel Kukard committed
822
		return ERR_PARAM;
Nigel Kukard's avatar
Nigel Kukard committed
823
	}
824

825
826
827
828
829
830
	# Verify type
	if (defined($detail->{'Type'}) && $detail->{'Type'} ne "") {
		$extraColumns .= ",Type";
		$extraValues .= ",".DBQuote($detail->{'Type'});
	}

Nigel Kukard's avatar
Nigel Kukard committed
831
832
	# Create GL transaction
	my $sth = DBDo("
833
		INSERT INTO gl_transactions
834
				(TransactionDate,Reference$extraColumns)
Nigel Kukard's avatar
Nigel Kukard committed
835
836
			VALUES
				(
837
					".DBQuote($detail->{'Date'}).",
Nigel Kukard's avatar
Nigel Kukard committed
838
					".DBQuote($detail->{'Reference'})."
839
					$extraValues
Nigel Kukard's avatar
Nigel Kukard committed
840
841
				)
	");
Nigel Kukard's avatar
Nigel Kukard committed
842
	if (!$sth) {
843
		setError(awitpt::db::dblayer::Error());
Nigel Kukard's avatar
Nigel Kukard committed
844
		return ERR_DB;
Nigel Kukard's avatar
Nigel Kukard committed
845
846
847
848
849
850
851
852
853
	}

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

	return $ID;
}


Nigel Kukard's avatar
Nigel Kukard committed
854
# Link GL transaction using account number instead of ID
855
# Parameters:
856
#		ID				- Transaction ID
Nigel Kukard's avatar
Nigel Kukard committed
857
#		GLAccountNumber	- GL account number
858
#		Amount			- Amount to post
Nigel Kukard's avatar
Nigel Kukard committed
859
860
#		Reference		- Transaction reference
sub linkGLTransactionByAccountNumber
861
862
863
864
865
866
{
	my ($data) = @_;


	# Check GL account exists
	my $GLAccID;
Nigel Kukard's avatar
Nigel Kukard committed
867
	if (($GLAccID = getGLAccountIDFromNumber($data->{'GLAccountNumber'})) < 1) {
868
		setError(Error());
869
870
		return $GLAccID;
	}
871

872
	# Add ID
Nigel Kukard's avatar
Nigel Kukard committed
873
	$data->{'GLAccountID'} = $GLAccID;
874
875

	# And Link
Nigel Kukard's avatar
Nigel Kukard committed
876
	return linkGLTransaction($data);
877
878
879
}


Nigel Kukard's avatar
Nigel Kukard committed
880
# Link GL transaction
881
# Parameters:
882
#		ID				- Transaction ID
Nigel Kukard's avatar
Nigel Kukard committed
883
#		GLAccountID		- GL account ID
884
#		Amount			- Amount to post
Nigel Kukard's avatar
Nigel Kukard committed
885
886
#		Reference		- Transaction reference
sub linkGLTransaction
Nigel Kukard's avatar
Nigel Kukard committed
887
{
888
	my ($data) = @_;
Nigel Kukard's avatar
Nigel Kukard committed
889

Nigel Kukard's avatar
Nigel Kukard committed
890
891

	# Verify params
892
	if (!defined($data->{'ID'}) || $data->{'ID'} < 1) {
893
		setError("Transaction ID not provided");
Nigel Kukard's avatar
Nigel Kukard committed
894
		return ERR_PARAM;
Nigel Kukard's avatar
Nigel Kukard committed
895
896
	}

Nigel Kukard's avatar
Nigel Kukard committed
897
	if (!defined($data->{'GLAccountID'}) || $data->{'GLAccountID'} < 1) {
898
		setError("Account ID not provided for transaction '".$data->{'ID'}."'");
Nigel Kukard's avatar
Nigel Kukard committed
899
		return ERR_PARAM;
900
	}
Nigel Kukard's avatar
Nigel Kukard committed
901

902
903
904
905
906
907
908
909
910
911
	if (!defined($data->{'Amount'}) && !defined($data->{'Credit'}) && !defined($data->{'Debit'})) {
		setError("Amount or Credit or Debit must be specified");
		return ERR_PARAM;
	}
	if (defined($data->{'Credit'}) && defined($data->{'Debit'})) {
		setError("Parameter 'Credit' and 'Debit' cannot be specified for the same transcation");
		return ERR_PARAM;
	}
	if ((defined($data->{'Credit'}) && defined($data->{'Amount'})) || (defined($data->{'Debit'}) && defined($data->{'Amount'}))) {
		setError("Parameter 'Credit'/'Debit' is incompatible with 'Amount'");
Nigel Kukard's avatar
Nigel Kukard committed
912
		return ERR_PARAM;
Nigel Kukard's avatar
Nigel Kukard committed
913
914
	}

915
916
917
918
919
920
921
922
	# Lets get some account info
	my $params;
	$params->{'AccountID'} = $data->{'GLAccountID'};
	my $account = getGLAccount($params);
	if (ref $account ne "HASH") {
		return $account;
	}

923
	# Pull in amount
924
	my $cleanAmount = Math::BigFloat->new();
Nigel Kukard's avatar
Nigel Kukard committed
925
	$cleanAmount->precision(-2);
926
927
928
929
930
931

	# Lets see what we going to pull in...
	# We use ABS to get positive value no matte what
	# We use bneg() to negate this in case of a debit
	if (defined($data->{'Credit'})) {
		$cleanAmount->badd($data->{'Credit'})->babs();
932
933
934
935
936
937
938
939
		# NK: Credit vs. Debit based on account type, are we going to reverse this?
		foreach my $finCatCode ("A01", "B01", "D01", "E01") {
			# Check for match
			if ($account->{'FinCatCode'} eq $finCatCode) {
				$cleanAmount->bneg();
				last;
			}
		}
940
	} elsif (defined($data->{'Debit'})) {
941
942
943
944
945
946
947
948
949
950
		$cleanAmount->bsub($data->{'Debit'})->babs();

		# NK: Credit vs. Debit based on account type, are we going to reverse this?
		foreach my $finCatCode ("B01","C01","D01") {
			# Check for match
			if ($account->{'FinCatCode'} eq $finCatCode) {
				last;
			}
		}

951
952
953
954
	} elsif (defined($data->{'Amount'})) {
		$cleanAmount->badd($data->{'Amount'});
	}

Nigel Kukard's avatar
Nigel Kukard committed
955
	#NK - wtf .... should we or shouldn't we check?
956
	# still not sure, its disabled for a reason I guess ... ??
957
958
959
960
#	if ($cleanAmount->is_zero()) {
#		setError("Amount cannot be zero");
#		return ERR_AMTZERO;
#	}
961

Nigel Kukard's avatar
Nigel Kukard committed
962
	# Decide what to do with ref
Nigel Kukard's avatar
Nigel Kukard committed
963
	my $ref = defined($data->{'Reference'}) ? DBQuote($data->{'Reference'}) : "NULL";
Nigel Kukard's avatar
Nigel Kukard committed
964

Nigel Kukard's avatar
Nigel Kukard committed
965
966
	# Return list of GL transactions
	my $sth = DBSelect("
967
		SELECT
968
			Posted
Nigel Kukard's avatar
Nigel Kukard committed
969
970
971
		FROM
			gl_transactions
		WHERE
972
			ID = ".DBQuote($data->{'ID'})."
Nigel Kukard's avatar
Nigel Kukard committed
973
	");
Nigel Kukard's avatar
Nigel Kukard committed
974
	if (!$sth) {
975
		setError(awitpt::db::dblayer::Error());
Nigel Kukard's avatar
Nigel Kukard committed
976
		return ERR_DB;
Nigel Kukard's avatar
Nigel Kukard committed
977
978
	}

979
	my $row = hashifyLCtoMC($sth->fetchrow_hashref(),qw( Posted ));
980
981
	DBFreeRes($sth);

Nigel Kukard's avatar
Nigel Kukard committed
982
	# Check we got a result
983
	if (!defined($row)) {
984
		setError("Error finding transaction '".$data->{'ID'}."'");
Nigel Kukard's avatar
Nigel Kukard committed
985
		return ERR_NOTFOUND;
Nigel Kukard's avatar
Nigel Kukard committed
986
987
988
989
	}

	# Check if we not posted
	if ($row->{'Posted'} == '1') {
990
		setError("Cannot link to a posted transaction '".$data->{'ID'}."'");
Nigel Kukard's avatar
Nigel Kukard committed
991
		return ERR_POSTED;
Nigel Kukard's avatar
Nigel Kukard committed
992
993
	}

Nigel Kukard's avatar
Nigel Kukard committed
994
	# Create GL entry
Nigel Kukard's avatar
Nigel Kukard committed
995
	$sth = DBDo("
996
997
		INSERT INTO gl_entries
				(GLTransactionID,GLAccountID,Reference,Amount)
Nigel Kukard's avatar
Nigel Kukard committed
998
999
			VALUES
				(
1000
					".DBQuote($data->{'ID'}).",
For faster browsing, not all history is shown. View entire blame