GL.pm 36.2 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



Nigel Kukard's avatar
Nigel Kukard committed
23
package wiaflos::server::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;
Nigel Kukard's avatar
Nigel Kukard committed
30
use wiaflos::server::dblayer;
31
use wiaflos::server::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)) {
Nigel Kukard's avatar
Nigel Kukard committed
137
138
		setError(wiaflos::server::dblayer::Error());
		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)) {
Nigel Kukard's avatar
Nigel Kukard committed
168
169
		setError(wiaflos::server::dblayer::Error());
		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)) {
Nigel Kukard's avatar
Nigel Kukard committed
186
187
		setError(wiaflos::server::dblayer::Error());
		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
204
205
206
207
208
209
	# Check cache
	my ($cache_res,$cache) = cacheGetKeyPair('GL/Number-to-AccountID',$GLAccNumber);
	if ($cache_res != RES_OK) {
		setError(wiaflos::server::cache::Error());
		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) {
Nigel Kukard's avatar
Nigel Kukard committed
218
219
		setError(wiaflos::server::dblayer::Error());
		return ERR_DB;
220
221
222
	}

	# Fetch rows, while we not found anything
223
224
	my $GLAccID;
	while ((my $row = $sth->fetchrow_hashref()) && !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
248
249
250
251
	# Cache this
	$cache_res = cacheStoreKeyPair('GL/Number-to-AccountID',$GLAccNumber,$GLAccID);
	if ($cache_res != RES_OK) {
		setError(wiaflos::server::cache::Error());
		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) {
Nigel Kukard's avatar
Nigel Kukard committed
272
273
		setError(wiaflos::server::dblayer::Error());
		return ERR_DB;
274
275
	}

276
277
278
	my $row = $sth->fetchrow_hashref();
	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) {
Nigel Kukard's avatar
Nigel Kukard committed
305
306
		setError(wiaflos::server::dblayer::Error());
		return ERR_DB;
307
308
	}

309
310
311
	my $row = $sth->fetchrow_hashref();
	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
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
			ID, Code, Description
		FROM
			gl_reportwriter_categories
	");
	if (!$sth) {
		setError(wiaflos::server::dblayer::Error());
		return ERR_DB;
	}

	# Fetch rows
	my @entries;
	while (my $row = $sth->fetchrow_hashref()) {
		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
364
365
366
367
368
369
	# Check cache
	my ($cache_res,$cache) = cacheGetKeyPair('GL/AccountID-to-Number',$accID);
	if ($cache_res != RES_OK) {
		setError(wiaflos::server::cache::Error());
		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) {
Nigel Kukard's avatar
Nigel Kukard committed
380
381
		setError(wiaflos::server::dblayer::Error());
		return undef;
Nigel Kukard's avatar
Nigel Kukard committed
382
383
	}

384
	# Grab row & free
Nigel Kukard's avatar
Nigel Kukard committed
385
	my $row = $sth->fetchrow_hashref();
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
406
407
408
409
410
	# Cache this
	$cache_res = cacheStoreKeyPair('GL/AccountID-to-Number',$accID,$accnum);
	if ($cache_res != RES_OK) {
		setError(wiaflos::server::cache::Error());
		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) {
Nigel Kukard's avatar
Nigel Kukard committed
435
436
		setError(wiaflos::server::dblayer::Error());
		return ERR_DB;
437
438
439
440
441
442
	}

	# Grab row
	my $row = $sth->fetchrow_hashref();
	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
			gl_financial_categories.Code AS FinCatCode, gl_financial_categories.Description AS FinCatDescription,
517
			gl_reportwriter_categories.Code AS RwCatCode, gl_reportwriter_categories.Description AS RwCatDescription
Nigel Kukard's avatar
Nigel Kukard committed
518
		FROM
519
			gl_accounts, gl_financial_categories, gl_reportwriter_categories
Nigel Kukard's avatar
Nigel Kukard committed
520
		WHERE
521
			gl_financial_categories.ID = gl_accounts.FinCatID
522
			AND gl_reportwriter_categories.ID = gl_accounts.RwCatID
Nigel Kukard's avatar
Nigel Kukard committed
523
	");
Nigel Kukard's avatar
Nigel Kukard committed
524
	if (!$sth) {
Nigel Kukard's avatar
Nigel Kukard committed
525
526
		setError(wiaflos::server::dblayer::Error());
		return ERR_DB;
Nigel Kukard's avatar
Nigel Kukard committed
527
528
529
530
	}

	# Fetch rows
	while (my $row = $sth->fetchrow_hashref()) {
Nigel Kukard's avatar
Nigel Kukard committed
531
		my $account = sanitizeRawGLAccountItem($row);
Nigel Kukard's avatar
Nigel Kukard committed
532

Nigel Kukard's avatar
Nigel Kukard committed
533
		push(@accounts,$account);
534
	}
Nigel Kukard's avatar
Nigel Kukard committed
535

536
	DBFreeRes($sth);
Nigel Kukard's avatar
Nigel Kukard committed
537

538
539
	return \@accounts;
}
Nigel Kukard's avatar
Nigel Kukard committed
540

541
542
543

# Return a hash containing account details
# Parameters:
Nigel Kukard's avatar
Nigel Kukard committed
544
#		AccountID		- GL account ID
Nigel Kukard's avatar
Nigel Kukard committed
545
546
#		AccountNumber	- GL account reference
sub getGLAccount
547
548
549
550
551
{
	my ($data) = @_;


	my $GLAccID;
Nigel Kukard's avatar
Nigel Kukard committed
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568

	# 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'};
	}
569

Nigel Kukard's avatar
Nigel Kukard committed
570
571
572
573
	# Verify account ID
	if (!$GLAccID || $GLAccID < 1) {
		setError("No (or invalid) account number or ID provided");
		return ERR_PARAM;
574
575
576
	}

	my $sth = DBSelect("
577
		SELECT
Nigel Kukard's avatar
Nigel Kukard committed
578
			gl_accounts.ID, gl_accounts.ParentGLAccountID, gl_accounts.Code, gl_accounts.Name,
579
			gl_financial_categories.Code AS FinCatCode, gl_financial_categories.Description AS FinCatDescription,
580
			gl_reportwriter_categories.Code AS RwCatCode, gl_reportwriter_categories.Description AS RwCatDescription
581
		FROM
582
			gl_accounts, gl_financial_categories, gl_reportwriter_categories
583
584
		WHERE
			gl_accounts.ID = ".DBQuote($GLAccID)."
585
			AND gl_financial_categories.ID = gl_accounts.FinCatID
586
			AND gl_reportwriter_categories.ID = gl_accounts.RwCatID
587
	");
Nigel Kukard's avatar
Nigel Kukard committed
588
	if (!$sth) {
Nigel Kukard's avatar
Nigel Kukard committed
589
590
		setError(wiaflos::server::dblayer::Error());
		return ERR_DB;
Nigel Kukard's avatar
Nigel Kukard committed
591
592
	}

593
594
595
596
	# Fetch row
	my $row = $sth->fetchrow_hashref();
	DBFreeRes($sth);

597
	# Check we got a result
598
	if (!defined($row)) {
599
		setError("Error finding account '$GLAccID'");
Nigel Kukard's avatar
Nigel Kukard committed
600
		return ERR_NOTFOUND;
601
602
	}

Nigel Kukard's avatar
Nigel Kukard committed
603

Nigel Kukard's avatar
Nigel Kukard committed
604
	return sanitizeRawGLAccountItem($row);
605
606
607
}


Nigel Kukard's avatar
Nigel Kukard committed
608
# Return the next sub account code
609
# Parameters:
Nigel Kukard's avatar
Nigel Kukard committed
610
611
#		AccountNumber	- GL account reference
sub getNextGLSubAccountCode
612
613
614
615
{
	my ($data) = @_;


Nigel Kukard's avatar
Nigel Kukard committed
616
617
618
619
	# Verify GL account number
	if (!defined($data->{'AccountNumber'}) || $data->{'AccountNumber'} eq "") {
		setError("No (or invalid) GL account number provided");
		return ERR_PARAM;
620
621
622
623
	}

	# Check GL account exists
	my $GLAccID;
Nigel Kukard's avatar
Nigel Kukard committed
624
	if (($GLAccID = getGLAccountIDFromNumber($data->{'AccountNumber'})) < 1) {
625
		setError(Error());
626
627
628
629
630
		return $GLAccID;
	}

	# Select last account
	my $sth = DBSelect("
631
		SELECT
Nigel Kukard's avatar
Nigel Kukard committed
632
			Code
633
634
635
		FROM
			gl_accounts
		WHERE
636
			ParentGLAccountID = ".DBQuote($GLAccID)."
Nigel Kukard's avatar
Nigel Kukard committed
637
		ORDER BY Code DESC
638
639
		LIMIT 1
	");
Nigel Kukard's avatar
Nigel Kukard committed
640
	if (!$sth) {
Nigel Kukard's avatar
Nigel Kukard committed
641
642
		setError(wiaflos::server::dblayer::Error());
		return ERR_DB;
643
644
645
646
647
648
	}

	# Fetch row
	my $row = $sth->fetchrow_hashref();
	DBFreeRes($sth);

649
650
651
652
653
	# Check we got a result, if not return 1
	if (!defined($row)) {
		return 1;
	}

Nigel Kukard's avatar
Nigel Kukard committed
654
	return $row->{'Code'} + 1;
Nigel Kukard's avatar
Nigel Kukard committed
655
656
657
}


658
## @fn getGLTransactions($data)
Nigel Kukard's avatar
Nigel Kukard committed
659
# Return an array of general ledger transactions
660
661
662
663
664
#
# @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
665
# @li Type Optional transaction type
666
667
668
669
670
671
#
# @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
672
# @li Type Transaction type
Nigel Kukard's avatar
Nigel Kukard committed
673
sub getGLTransactions
Nigel Kukard's avatar
Nigel Kukard committed
674
{
675
676
	my $data = shift;

Nigel Kukard's avatar
Nigel Kukard committed
677
678
	my @transactions = ();

679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
	# 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'})." ";
	}

701
	# Check if we're filtering on type
702
	my $typeFilter = GL_TRANSTYPE_NORMAL;
703
704
705
706
	if (defined($data->{'Type'}) && $data->{'Type'} ne "") {
		$typeFilter = $data->{'Type'};
	}

Nigel Kukard's avatar
Nigel Kukard committed
707
708
	# Return list of GL transactions
	my $sth = DBSelect("
709
710
		SELECT
			gl_transactions.ID, gl_transactions.TransactionDate, gl_transactions.Reference,
711
			gl_transactions.Type,
712
			gl_transactions.Posted
Nigel Kukard's avatar
Nigel Kukard committed
713
		FROM
714
715
716
717
718
			gl_transactions $extraTables
		WHERE
			1 = 1
			$extraSQL
		$extraEndSQL
Nigel Kukard's avatar
Nigel Kukard committed
719
	");
Nigel Kukard's avatar
Nigel Kukard committed
720
	if (!$sth) {
Nigel Kukard's avatar
Nigel Kukard committed
721
722
		setError(wiaflos::server::dblayer::Error());
		return ERR_DB;
Nigel Kukard's avatar
Nigel Kukard committed
723
724
725
726
	}

	# Fetch rows
	while (my $row = $sth->fetchrow_hashref()) {
727
		# Check filter, if this is not one of our items, continue
728
		if (! ($typeFilter & $row->{'Type'})) {
729
730
731
			next;
		}

Nigel Kukard's avatar
Nigel Kukard committed
732
		my $transaction = sanitizeRawGLTransactionItem($row);
Nigel Kukard's avatar
Nigel Kukard committed
733

Nigel Kukard's avatar
Nigel Kukard committed
734
		push(@transactions,$transaction);
Nigel Kukard's avatar
Nigel Kukard committed
735
736
737
738
739
740
741
742
	}

	DBFreeRes($sth);

	return \@transactions;
}


743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
# 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("
759
		SELECT
760
761
762
763
764
765
766
			ID, TransactionDate, Reference, Posted
		FROM
			gl_transactions
		WHERE
			ID = ".DBQuote($detail->{'ID'})."
	");
	if (!$sth) {
Nigel Kukard's avatar
Nigel Kukard committed
767
768
		setError(wiaflos::server::dblayer::Error());
		return ERR_DB;
769
770
771
772
	}

	# Fetch rows
	my $row = $sth->fetchrow_hashref();
773

774
775
776
777
778
779
780
781
782
783
784
785
	DBFreeRes($sth);

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

	return sanitizeRawGLTransactionItem($row);
}


786
## @fn createGLTransaction($data)
Nigel Kukard's avatar
Nigel Kukard committed
787
# Create GL transaction
788
789
790
791
792
793
794
#
# @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
795
sub createGLTransaction
Nigel Kukard's avatar
Nigel Kukard committed
796
{
797
	my ($detail) = @_;
Nigel Kukard's avatar
Nigel Kukard committed
798

Nigel Kukard's avatar
Nigel Kukard committed
799

800
801
802
803
	# Extra SQL we may need
	my $extraColumns = "";
	my $extraValues = "";

Nigel Kukard's avatar
Nigel Kukard committed
804
	# Verify date
805
	if (!defined($detail->{'Date'}) || $detail->{'Date'} eq "") {
806
		setError("No date provided for GL transaction");
Nigel Kukard's avatar
Nigel Kukard committed
807
		return ERR_PARAM;
Nigel Kukard's avatar
Nigel Kukard committed
808
809
810
	}

	# Verify reference
Nigel Kukard's avatar
Nigel Kukard committed
811
	if (!defined($detail->{'Reference'}) || $detail->{'Reference'} eq "") {
812
		setError("No reference provided for GL transaction");
Nigel Kukard's avatar
Nigel Kukard committed
813
		return ERR_PARAM;
Nigel Kukard's avatar
Nigel Kukard committed
814
	}
815

816
817
818
819
820
821
	# Verify type
	if (defined($detail->{'Type'}) && $detail->{'Type'} ne "") {
		$extraColumns .= ",Type";
		$extraValues .= ",".DBQuote($detail->{'Type'});
	}

Nigel Kukard's avatar
Nigel Kukard committed
822
823
	# Create GL transaction
	my $sth = DBDo("
824
		INSERT INTO gl_transactions
825
				(TransactionDate,Reference$extraColumns)
Nigel Kukard's avatar
Nigel Kukard committed
826
827
			VALUES
				(
828
					".DBQuote($detail->{'Date'}).",
Nigel Kukard's avatar
Nigel Kukard committed
829
					".DBQuote($detail->{'Reference'})."
830
					$extraValues
Nigel Kukard's avatar
Nigel Kukard committed
831
832
				)
	");
Nigel Kukard's avatar
Nigel Kukard committed
833
	if (!$sth) {
Nigel Kukard's avatar
Nigel Kukard committed
834
835
		setError(wiaflos::server::dblayer::Error());
		return ERR_DB;
Nigel Kukard's avatar
Nigel Kukard committed
836
837
838
839
840
841
842
843
844
	}

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

	return $ID;
}


Nigel Kukard's avatar
Nigel Kukard committed
845
# Link GL transaction using account number instead of ID
846
# Parameters:
847
#		ID				- Transaction ID
Nigel Kukard's avatar
Nigel Kukard committed
848
#		GLAccountNumber	- GL account number
849
#		Amount			- Amount to post
Nigel Kukard's avatar
Nigel Kukard committed
850
851
#		Reference		- Transaction reference
sub linkGLTransactionByAccountNumber
852
853
854
855
856
857
{
	my ($data) = @_;


	# Check GL account exists
	my $GLAccID;
Nigel Kukard's avatar
Nigel Kukard committed
858
	if (($GLAccID = getGLAccountIDFromNumber($data->{'GLAccountNumber'})) < 1) {
859
		setError(Error());
860
861
		return $GLAccID;
	}
862

863
	# Add ID
Nigel Kukard's avatar
Nigel Kukard committed
864
	$data->{'GLAccountID'} = $GLAccID;
865
866

	# And Link
Nigel Kukard's avatar
Nigel Kukard committed
867
	return linkGLTransaction($data);
868
869
870
}


Nigel Kukard's avatar
Nigel Kukard committed
871
# Link GL transaction
872
# Parameters:
873
#		ID				- Transaction ID
Nigel Kukard's avatar
Nigel Kukard committed
874
#		GLAccountID		- GL account ID
875
#		Amount			- Amount to post
Nigel Kukard's avatar
Nigel Kukard committed
876
877
#		Reference		- Transaction reference
sub linkGLTransaction
Nigel Kukard's avatar
Nigel Kukard committed
878
{
879
	my ($data) = @_;
Nigel Kukard's avatar
Nigel Kukard committed
880

Nigel Kukard's avatar
Nigel Kukard committed
881
882

	# Verify params
883
	if (!defined($data->{'ID'}) || $data->{'ID'} < 1) {
884
		setError("Transaction ID not provided");
Nigel Kukard's avatar
Nigel Kukard committed
885
		return ERR_PARAM;
Nigel Kukard's avatar
Nigel Kukard committed
886
887
	}

Nigel Kukard's avatar
Nigel Kukard committed
888
	if (!defined($data->{'GLAccountID'}) || $data->{'GLAccountID'} < 1) {
889
		setError("Account ID not provided for transaction '".$data->{'ID'}."'");
Nigel Kukard's avatar
Nigel Kukard committed
890
		return ERR_PARAM;
891
	}
Nigel Kukard's avatar
Nigel Kukard committed
892

893
894
895
896
897
898
899
900
901
902
	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
903
		return ERR_PARAM;
Nigel Kukard's avatar
Nigel Kukard committed
904
905
	}

906
907
908
909
910
911
912
913
	# Lets get some account info
	my $params;
	$params->{'AccountID'} = $data->{'GLAccountID'};
	my $account = getGLAccount($params);
	if (ref $account ne "HASH") {
		return $account;
	}

914
	# Pull in amount
915
	my $cleanAmount = Math::BigFloat->new();
Nigel Kukard's avatar
Nigel Kukard committed
916
	$cleanAmount->precision(-2);
917
918
919
920
921
922

	# 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();
923
924
925
926
927
928
929
930
		# 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;
			}
		}
931
	} elsif (defined($data->{'Debit'})) {
932
933
934
935
936
937
938
939
940
941
		$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;
			}
		}

942
943
944
945
	} elsif (defined($data->{'Amount'})) {
		$cleanAmount->badd($data->{'Amount'});
	}

Nigel Kukard's avatar
Nigel Kukard committed
946
	#NK - wtf .... should we or shouldn't we check?
947
	# still not sure, its disabled for a reason I guess ... ??
948
949
950
951
#	if ($cleanAmount->is_zero()) {
#		setError("Amount cannot be zero");
#		return ERR_AMTZERO;
#	}
952

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

Nigel Kukard's avatar
Nigel Kukard committed
956
957
	# Return list of GL transactions
	my $sth = DBSelect("
958
		SELECT
959
			Posted
Nigel Kukard's avatar
Nigel Kukard committed
960
961
962
		FROM
			gl_transactions
		WHERE
963
			ID = ".DBQuote($data->{'ID'})."
Nigel Kukard's avatar
Nigel Kukard committed
964
	");
Nigel Kukard's avatar
Nigel Kukard committed
965
	if (!$sth) {
Nigel Kukard's avatar
Nigel Kukard committed
966
967
		setError(wiaflos::server::dblayer::Error());
		return ERR_DB;
Nigel Kukard's avatar
Nigel Kukard committed
968
969
	}

970
971
972
	my $row = $sth->fetchrow_hashref();
	DBFreeRes($sth);

Nigel Kukard's avatar
Nigel Kukard committed
973
	# Check we got a result
974
	if (!defined($row)) {
975
		setError("Error finding transaction '".$data->{'ID'}."'");
Nigel Kukard's avatar
Nigel Kukard committed
976
		return ERR_NOTFOUND;
Nigel Kukard's avatar
Nigel Kukard committed
977
978
979
980
	}

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

Nigel Kukard's avatar
Nigel Kukard committed
985
	# Create GL entry
Nigel Kukard's avatar
Nigel Kukard committed
986
	$sth = DBDo("
987
988
		INSERT INTO gl_entries
				(GLTransactionID,GLAccountID,Reference,Amount)
Nigel Kukard's avatar
Nigel Kukard committed
989
990
			VALUES
				(
991
					".DBQuote($data->{'ID'}).",
Nigel Kukard's avatar
Nigel Kukard committed
992
					".DBQuote($data->{'GLAccountID'}).",
Nigel Kukard's avatar
Nigel Kukard committed
993
					$ref,
994
					".DBQuote($cleanAmount->bstr())."
Nigel Kukard's avatar
Nigel Kukard committed
995
996
				)
	");
Nigel Kukard's avatar
Nigel Kukard committed
997
	if (!$sth) {
Nigel Kukard's avatar
Nigel Kukard committed
998
999
		setError(wiaflos::server::dblayer::Error());
		return ERR_DB;
Nigel Kukard's avatar
Nigel Kukard committed
1000
	}
For faster browsing, not all history is shown. View entire blame