DBLayer.pm 10 KB
Newer Older
Nigel Kukard's avatar
Nigel Kukard committed
1
# AWIT Database Data Object
Nigel Kukard's avatar
Nigel Kukard committed
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
# Copyright (C) 2014, AllWorldIT
#
# 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 3 of the License, or
# (at your option) any later version.
#
# 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.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

=encoding utf8

=head1 NAME

AWITPT::DB::DataObj - AWITPT Database Data Object

=head1 SYNOPSIS

	#
	# Create a child class
	#
	package AWITPT::DB::DataObj::myobject;
	use AWITPT::DB::DataObj 1.00;
30
	use parent 'AWITPT::DB::DataObj';
Nigel Kukard's avatar
Nigel Kukard committed
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64

	use strict;
	use warnings;

	our $VERSION = '1.00';

	# Return the configuration for this object
	sub config
	{
		my $config = {
			# Set table name
			'table' => "testtable",
			# Setup our data definition
			'properties' => {
				'ID' => {
					'options' => DATAOBJ_PROPERTY_ID
				},
				'Name' => {
					'validate' => { 'type' => 'text', 'length' => 2 }
				}
			}
		};
		return $config;
	}

=head1 DESCRIPTION

The AWITPT::DB::DataObj class provides an abstraction layer between a data definition and the underlying database, allowing easy
access to table data.

=cut


package AWITPT::DB::DataObj;
65
66
67
68
use parent 'Exporter';

use AWITPT::DataObj 3.000;
use base 'AWITPT::DataObj';
Nigel Kukard's avatar
Nigel Kukard committed
69
70
71
72

use strict;
use warnings;

73
our $VERSION = "2.000";
Nigel Kukard's avatar
Nigel Kukard committed
74
75

our (@ISA,@EXPORT,@EXPORT_OK);
76
# Re-export our parents constants
Nigel Kukard's avatar
Nigel Kukard committed
77
@EXPORT = qw(
Nigel Kukard's avatar
Nigel Kukard committed
78
79
	DATAOBJ_LOADONIDSET

Nigel Kukard's avatar
Nigel Kukard committed
80
81
82
83
	DATAOBJ_PROPERTY_READONLY
	DATAOBJ_PROPERTY_NOLOAD
	DATAOBJ_PROPERTY_ID
	DATAOBJ_PROPERTY_NOSAVE
Nigel Kukard's avatar
Nigel Kukard committed
84
85

	DATAOBJ_RELATION_READONLY
Nigel Kukard's avatar
Nigel Kukard committed
86
87
88
89
);
@EXPORT_OK = qw(
);

90

Nigel Kukard's avatar
Nigel Kukard committed
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
use AWITPT::Util 2.00 qw(
		hashifyLCtoMC
);
use AWITPT::DB::DBLayer;
use Data::Dumper;



=head1 METHODS

C<AWITPT::DB::DataObj> provides the below manipulation methods.

=cut



=head2 config

	# Data object configuration
	sub config
	{
		retrun {
			'table' => "mytable"
			'properties' => {
115
116
117
118
119
				'Description' => {
					<OPTIONS>,
					<VALIDATION>,
					<RELATIONS>
				}
Nigel Kukard's avatar
Nigel Kukard committed
120
121
122
123
			}
		}
	}

124
See L<AWITPT::DataObj> for options, validation and relations.
Nigel Kukard's avatar
Nigel Kukard committed
125

126
=back
Nigel Kukard's avatar
Nigel Kukard committed
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173

=cut



=head2 table

	print(STDERR "Table: ".$dataObj->table());

The C<table> method returns the data object table name.

=cut

# Return table name
sub table
{
	my $self = shift;


	return $self->{'_table'};
}



=head2 records

	my @records = $dataObj->records();

The C<records> method returns an array of data object records.

=cut

# Get records as an array of objects
sub records
{
	my $self = shift;


	# Do select query
	my ($sth,$numResults) = DBSelectSearch(
		sprintf("
				SELECT
					%s
				FROM
					%s
			",
			join(',',$self->_properties(DATAOBJ_PROPERTY_ALL ^ DATAOBJ_PROPERTY_NOLOAD)),
Nigel Kukard's avatar
Nigel Kukard committed
174
			$self->table()
Nigel Kukard's avatar
Nigel Kukard committed
175
176
177
178
179
		)
	);

	# Make sure we have a result
	if (!defined($numResults)) {
Nigel Kukard's avatar
Nigel Kukard committed
180
181
		my $error = AWITPT::DB::DBLayer::error();
		$self->_error("Database query failed: '$error'");
Nigel Kukard's avatar
Nigel Kukard committed
182
		$self->_log(DATAOBJ_LOG_WARNING,"Database query failed: %s",$error);
Nigel Kukard's avatar
Nigel Kukard committed
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
		return;
	}

	# Add each row as another record
	my @records;
	while (my $row = hashifyLCtoMC($sth->fetchrow_hashref(), $self->_properties(DATAOBJ_PROPERTY_ALL))) {
		# We use clone to clone the current child class, and reset to reset the object entirely
		my $record = $self->clone()->reset()->_loadHash($row);
		push(@records,$record);
	}

	return \@records;
}



=head2 load

	$dataObj->load($id);

	$dataObj->load('Name' => 'Joe Soap');

Nigel Kukard's avatar
Nigel Kukard committed
205
The C<load> method is used to load a single record from the database. It has 2 forms of invocation, either by specifying one
Nigel Kukard's avatar
Nigel Kukard committed
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
parameter which is assumed to be the value of the ID field, or by specifying a hash of key-value pairs.

Only the first matching record is returned, if multiple records exist the result can be any one of them being returned.

=cut

# Load Record
# - The load defaults to loading on ID, but a hash can be provided to load on various matches
sub load
{
	my ($self,@params) = @_;


	my %matches;

	# One param means that we're just grabbing an ID
	if (@params == 1) {
		$matches{'ID'} = shift(@params);
	# More params, means we grabbing based on a "search"
	} else {
		%matches = @params;
	}

	# Build SQL statement
	my @whereItems;
	my @whereValues;
	foreach my $column (keys %matches) {
		push(@whereItems,"$column = ?");
		push(@whereValues,$matches{$column});
	}

	# Do SQL select
	my $sth = DBSelect(
		sprintf('
				SELECT
					%s
				FROM
					%s
				WHERE
					%s
			',
			join(',',$self->_properties(DATAOBJ_PROPERTY_ALL ^ DATAOBJ_PROPERTY_NOLOAD)),
Nigel Kukard's avatar
Nigel Kukard committed
248
			$self->table(),
Nigel Kukard's avatar
Nigel Kukard committed
249
250
251
252
253
			join(' AND ',@whereItems)
		),
		@whereValues
	);

Nigel Kukard's avatar
Nigel Kukard committed
254
255
256
257
	# Check result
	if (!defined($sth)) {
		my $error = AWITPT::DB::DBLayer::error();
		$self->_error("Database query failed: '$error'");
Nigel Kukard's avatar
Nigel Kukard committed
258
		$self->_log(DATAOBJ_LOG_WARNING,"Database query failed: %s",$error);
Nigel Kukard's avatar
Nigel Kukard committed
259
260
261
		return;
	}

Nigel Kukard's avatar
Nigel Kukard committed
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
	# Grab row
	my $row = hashifyLCtoMC($sth->fetchrow_hashref(),$self->_properties(DATAOBJ_PROPERTY_ALL));

	$self->_loadHash($row);

	return $self;
}



=head2 commit

	$dataObj->commit();

The C<commit> method is used to commit the record to the database, this means updating it if it exists or inserting it if it does
not yet exist.


On success this method will return the L<AWITPT::DB::DBLayer> result for DBUpdate or DBInsert. When no data has changed a string
containing "0E0" will be returned. On error undef on will be returned.

=cut

# Commit record to database
sub commit
{
	my $self = shift;


	# Abort if we don't have updates
	my $changed = $self->changed();
	my %data;

	# Loop with changed and add to data
	foreach my $propertyName ($self->_properties(DATAOBJ_PROPERTY_ALL ^ DATAOBJ_PROPERTY_NOSAVE)) {
		# If its a changed item add it to the data we going to pass to the DB
		if (exists($changed->{$propertyName})) {
			$data{$propertyName} = $changed->{$propertyName};
		}
	}
Nigel Kukard's avatar
Nigel Kukard committed
302
	# If we have no values which changed, return 0E0
Nigel Kukard's avatar
Nigel Kukard committed
303
304
305
306
307
308
309
310
311
312
	if (!%data) {
		return "0E0";
	}

	# We have an ID so its an update
	my $res;
	if (my $id = $self->getID()) {

		# Update database record
		if (!defined($res = DBUpdate($self->table(),$id,%data))) {
Nigel Kukard's avatar
Nigel Kukard committed
313
314
			my $error = AWITPT::DB::DBLayer::error();
			$self->_error("Database update failed: '$error'");
Nigel Kukard's avatar
Nigel Kukard committed
315
			$self->_log(DATAOBJ_LOG_WARNING,"Database update failed: %s",$error);
Nigel Kukard's avatar
Nigel Kukard committed
316
317
318
			return;
		}

Nigel Kukard's avatar
Nigel Kukard committed
319
		$self->_log(DATAOBJ_LOG_DEBUG2,"Updating table '%s' row ID '%s' with: %s",$self->table(),$id,Dumper(\%data));
Nigel Kukard's avatar
Nigel Kukard committed
320
321
322
323
324
325
326


	# No ID means its an insert
	} else {

		# Insert database record
		if (!defined($res = DBInsert($self->table(),%data))) {
Nigel Kukard's avatar
Nigel Kukard committed
327
328
			my $error = AWITPT::DB::DBLayer::error();
			$self->_error("Database insert failed: '$error'");
Nigel Kukard's avatar
Nigel Kukard committed
329
			$self->_log(DATAOBJ_LOG_WARNING,"Database insert failed: %s",$error);
Nigel Kukard's avatar
Nigel Kukard committed
330
331
332
			return;
		}

Nigel Kukard's avatar
Nigel Kukard committed
333
		$self->_log(DATAOBJ_LOG_DEBUG2,"Inserting into table '%s' row ID '%s' with: %s",$self->table(),$res,Dumper(\%data));
Nigel Kukard's avatar
Nigel Kukard committed
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
		$self->_set('ID',$res);

	}

	return $res;
}



=head2 remove

	$dataObj->remove();

	$dataObj->remove('Name' => "Sam", 'Surname' => "Soap");

Nigel Kukard's avatar
Nigel Kukard committed
349
350
The C<remove> method is used to remove the data object from the database. The function can take an optional set of parameters which
will be used in the SQL DELETE WHERE statement instead of using the current object ID.
Nigel Kukard's avatar
Nigel Kukard committed
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397

If no paremeters are given the current object ID is removed and the ID property removed from the data object. If a set of optional
parameters is given, the ID property is NOT removed.

=cut

# Remove Record
# - The remove defaults to removing on ID, but a hash can be provided to load on various matches
sub remove
{
	my ($self,@params) = @_;


	my %matches;

	# Are we going to remove the ID from this object at the end on success?
	my $removeID = 0;

	# If we don't have any params, we removing ourselves
	if (!@params) {
		# We can only remove ourselves if our ID is set
		my $id = $self->getID();
		if (defined($id) && $id > 0) {
			$matches{'ID'} = $self->getID();
			$removeID = 1;
		} else {
			$self->_error("Failed to remove object, no ID set");
			return;
		}

	# One param means that we're just deleting by ID
	} elsif (@params == 1) {
		$matches{'ID'} = shift(@params);

	# More params, means we grabbing based on a "search"
	} else {
		%matches = @params;
	}

	# Build SQL statement
	my @whereItems;
	my @whereValues;
	foreach my $column (keys %matches) {
		push(@whereItems,"$column = ?");
		push(@whereValues,$matches{$column});
	}

Nigel Kukard's avatar
Nigel Kukard committed
398
	$self->_log(DATAOBJ_LOG_DEBUG2,"Removing record from table '%s' with: %s",$self->table(),Dumper(\%matches));
Nigel Kukard's avatar
Nigel Kukard committed
399
400
401
402
403
404
405
406
407

	# Do SQL delete
	my $rows = DBDo(
		sprintf('
				DELETE FROM
					%s
				WHERE
					%s
			',
Nigel Kukard's avatar
Nigel Kukard committed
408
			$self->table(),
Nigel Kukard's avatar
Nigel Kukard committed
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
			join(' AND ',@whereItems)
		),
		@whereValues
	);

	# Make sure we got something back
	if (!defined($rows)) {
		$self->_error("Database remove failed: ".AWITPT::DB::DBLayer::error());
		return;
	}

	# If we should remove the ID signifying we not in the db, then do it
	if ($removeID) {
		$self->_set('ID',undef);
	}

	# Return number removed
	return $rows;
}



#
# INTERNAL METHODS BELOW
#



# Reset internals of the object
sub _init
{
Nigel Kukard's avatar
Nigel Kukard committed
440
	my ($self,@params) = @_;
Nigel Kukard's avatar
Nigel Kukard committed
441
442


443
	# Initialize parent, VERY important
Nigel Kukard's avatar
Nigel Kukard committed
444
	$self->SUPER::_init(@params);
Nigel Kukard's avatar
Nigel Kukard committed
445

446
447
	# Grab our configuration so we can initialize our customizations
	my $config = $self->config();
Nigel Kukard's avatar
Nigel Kukard committed
448
449
450
451

	# First, lets see if we have a mandatory table to set
	if (!defined($config->{'table'})) {
		$self->_log(DATAOBJ_LOG_ERROR,"No 'table' defined!");
452
		return;
Nigel Kukard's avatar
Nigel Kukard committed
453
454
455
	}
	# Set the table name
	$self->{'_table'} = $config->{'table'};
456
	$self->_addInternalProperty('_table');
Nigel Kukard's avatar
Nigel Kukard committed
457
458
459
460
461
462
463
464
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

	return $self;
}




1;
__END__

=head1 AUTHORS

Nigel Kukard E<lt>nkukard@lbsd.netE<gt>

=head1 BUGS

All bugs should be reported via the project issue tracker
L<http://gitlab.devlabs.linuxassist.net/awit-frameworks/awit-perl-toolkit/issues/>.

=head1 LICENSE AND COPYRIGHT

Copyright (C) 2014, AllWorldIT

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 3 of the License, or
(at your option) any later version.

=head1 SEE ALSO

L<AWITPT::DB::DBLayer>.

=cut