Commit 6d019948 authored by Nigel Kukard's avatar Nigel Kukard
Browse files

Merge branch 'nkwork1' into 'master'

More work on DataObj

See merge request !20
parents 26d09a12 81ead811
Pipeline #1246 passed with stages
in 3 minutes
...@@ -36,7 +36,7 @@ WriteMakefile( ...@@ -36,7 +36,7 @@ WriteMakefile(
'MAN3PODS' => { 'MAN3PODS' => {
'lib/AWITPT/DataObj.pm' => '$(INST_MAN3DIR)/AWITPT::DataObj.3', 'lib/AWITPT/DataObj.pm' => '$(INST_MAN3DIR)/AWITPT::DataObj.3',
'lib/AWITPT/DB/DataObj.pm' => '$(INST_MAN3DIR)/AWITPT::DB::DataObj.3', 'lib/AWITPT/DataObj/Backend/DBLayer.pm' => '$(INST_MAN3DIR)/AWITPT::DataObj::Backend::DBLayer.3',
'lib/AWITPT/Util/ConvertTSQL.pm' => '$(INST_MAN3DIR)/AWITPT::Util::ConvertTSQL.3', 'lib/AWITPT/Util/ConvertTSQL.pm' => '$(INST_MAN3DIR)/AWITPT::Util::ConvertTSQL.3',
'lib/AWITPT/Util/ConvertTSQL/client.pm' => '$(INST_MAN3DIR)/AWITPT::Util::ConvertTSQL::client.3', 'lib/AWITPT/Util/ConvertTSQL/client.pm' => '$(INST_MAN3DIR)/AWITPT::Util::ConvertTSQL::client.3',
'lib/AWITPT/Util/ConvertTSQL/MySQL.pm' => '$(INST_MAN3DIR)/AWITPT::Util::ConvertTSQL::MySQL.3', 'lib/AWITPT/Util/ConvertTSQL/MySQL.pm' => '$(INST_MAN3DIR)/AWITPT::Util::ConvertTSQL::MySQL.3',
......
This diff is collapsed.
# Database independent layer module # Database independent layer module
# Copyright (C) 2009-2014, AllWorldIT # Copyright (C) 2009-2017, AllWorldIT
# Copyright (C) 2008, LinuxRulz # Copyright (C) 2008, LinuxRulz
# Copyright (C) 2005-2007 Nigel Kukard <nkukard@lbsd.net> # Copyright (C) 2005-2007 Nigel Kukard <nkukard@lbsd.net>
# #
...@@ -28,7 +28,7 @@ package AWITPT::DB::DBILayer; ...@@ -28,7 +28,7 @@ package AWITPT::DB::DBILayer;
use strict; use strict;
use warnings; use warnings;
our $VERSION = "1.00"; our $VERSION = 1.01;
use DBI; use DBI;
......
# Common database layer module # Common database layer module
# Copyright (C) 2009-2014, AllWorldIT # Copyright (C) 2009-2017, AllWorldIT
# Copyright (C) 2008, LinuxRulz # Copyright (C) 2008, LinuxRulz
# Copyright (C) 2005-2007 Nigel Kukard <nkukard@lbsd.net> # Copyright (C) 2005-2007 Nigel Kukard <nkukard@lbsd.net>
# #
...@@ -22,12 +22,14 @@ ...@@ -22,12 +22,14 @@
## @class AWITPT::DB::DBLayer ## @class AWITPT::DB::DBLayer
# Database layer module which makes life a bit esier # Database layer module which makes life a bit esier
package AWITPT::DB::DBLayer; package AWITPT::DB::DBLayer;
use parent 'Exporter';
use strict; use strict;
use warnings; use warnings;
our $VERSION = '2.000'; use parent 'Exporter';
our $VERSION = 2.01;
# Exporter stuff # Exporter stuff
our (@EXPORT); our (@EXPORT);
...@@ -384,7 +386,7 @@ sub DBLastInsertID ...@@ -384,7 +386,7 @@ sub DBLastInsertID
} }
my $res; my $res;
if (!($res = $dbh->lastInsertID(undef,undef,$table,$column))) { if (!($res = $dbh->lastInsertID($table,$column))) {
_error("Error getting last inserted id: ".$dbh->error()); _error("Error getting last inserted id: ".$dbh->error());
return; return;
} }
......
# AWIT Data Object # AWIT Data Object
# Copyright (C) 2014, AllWorldIT # Copyright (C) 2014-2017, AllWorldIT
# #
# This program is free software: you can redistribute it and/or modify # 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 # it under the terms of the GNU General Public License as published by
...@@ -26,12 +26,13 @@ AWITPT::DataObj - AWITPT Database Data Object ...@@ -26,12 +26,13 @@ AWITPT::DataObj - AWITPT Database Data Object
# Create a child class # Create a child class
# #
package AWITPT::DataObj::myobject; package AWITPT::DataObj::myobject;
use AWITPT::DataObj 1.00;
use base 'AWITPT::DataObj';
use strict; use strict;
use warnings; use warnings;
use AWITPT::DataObj 1.00;
use parent, -norequire 'AWITPT::DataObj';
our $VERSION = '1.000'; our $VERSION = '1.000';
# Return the configuration for this object # Return the configuration for this object
...@@ -60,22 +61,26 @@ access to data. ...@@ -60,22 +61,26 @@ access to data.
package AWITPT::DataObj; package AWITPT::DataObj;
use parent 'Exporter';
use strict; use strict;
use warnings; use warnings;
our $VERSION = "3.000"; use AWITPT::Object 1.01;
use parent -norequire, 'AWITPT::Object';
our $VERSION = 3.01;
our (@EXPORT,@EXPORT_OK); our (@EXPORT,@EXPORT_OK);
@EXPORT = qw( @EXPORT = qw(
DATAOBJ_LOADONIDSET DATAOBJ_LOADONIDSET
DATAOBJ_PROPERTY_ALL
DATAOBJ_PROPERTY_READONLY DATAOBJ_PROPERTY_READONLY
DATAOBJ_PROPERTY_NOLOAD DATAOBJ_PROPERTY_NOLOAD
DATAOBJ_PROPERTY_ID
DATAOBJ_PROPERTY_NOSAVE DATAOBJ_PROPERTY_NOSAVE
DATAOBJ_PROPERTY_ID
DATAOBJ_PROPERTY_REQUIRED
DATAOBJ_PROPERTY_ALL
DATAOBJ_RELATION_READONLY DATAOBJ_RELATION_READONLY
...@@ -100,8 +105,13 @@ use constant { ...@@ -100,8 +105,13 @@ use constant {
'DATAOBJ_PROPERTY_NOLOAD' => 2, 'DATAOBJ_PROPERTY_NOLOAD' => 2,
# Do not save this field to DB # Do not save this field to DB
'DATAOBJ_PROPERTY_NOSAVE' => 4, 'DATAOBJ_PROPERTY_NOSAVE' => 4,
# Combination of above
# Combination of READONLY and NOSAVE
'DATAOBJ_PROPERTY_ID' => 5, 'DATAOBJ_PROPERTY_ID' => 5,
# This property must be set before doing a commit
'DATAOBJ_PROPERTY_REQUIRED' => 8,
# Match property # Match property
'DATAOBJ_PROPERTY_ALL' => 255, 'DATAOBJ_PROPERTY_ALL' => 255,
...@@ -137,7 +147,7 @@ use Data::Dumper; ...@@ -137,7 +147,7 @@ use Data::Dumper;
=head1 METHODS =head1 METHODS
C<AWITPT::DataObj> provides the below manipulation methods. C<AWITPT::DataObj> provides the below manipulation methods, together with those inherited from C<AWITPT::Object>.
=cut =cut
...@@ -145,7 +155,7 @@ C<AWITPT::DataObj> provides the below manipulation methods. ...@@ -145,7 +155,7 @@ C<AWITPT::DataObj> provides the below manipulation methods.
=head2 new =head2 new
my $obj = AWITPT::DataObj::myobject->new(); my $obj = AWITPT::DataObj::myobject->new([$options]);
The C<new> method is used to instantiate the object. The C<new> method is used to instantiate the object.
...@@ -171,23 +181,7 @@ This property will cause the object to load when a DATAOBJ_PROPERTY_ID is set. ...@@ -171,23 +181,7 @@ This property will cause the object to load when a DATAOBJ_PROPERTY_ID is set.
=cut =cut
# Class instantiation # The new() method is inherited from AWITPT::Object.
sub new
{
my ($class,@params) = @_;
# These are our internal properties
my $self = {
};
# Build our class
bless($self, $class);
# And initialize
$self->_init(@params);
return $self;
}
...@@ -229,19 +223,29 @@ Below is a list of supported options: ...@@ -229,19 +223,29 @@ Below is a list of supported options:
=over =over
=item * =item *
B<DATAOBJ_PROPERTY_READONLY> B<DATAOBJ_PROPERTY_ID>
Internal use, this property cannot be set This is the unique ID property of the object, only ONE of these can be specified!
=item * =item *
B<DATAOBJ_PROPERTY_NOLOAD> B<DATAOBJ_PROPERTY_NOLOAD>
This property is not loaded from the database This property will not be loaded.
=item * =item *
B<DATAOBJ_PROPERTY_NOSAVE> B<DATAOBJ_PROPERTY_NOSAVE>
This property is not saved to the database This property is not saved.
=item *
B<DATAOBJ_PROPERTY_READONLY>
Ensure this property cannot be set using ->setXXX().
=item *
B<DATAOBJ_PROPERTY_REQUIRED>
This property must be set before using ->commit().
=back =back
...@@ -492,7 +496,6 @@ sub set ...@@ -492,7 +496,6 @@ sub set
# Check if we should insted do a load if we're have DATAOBJ_LOADONIDSET and we're an ID property # Check if we should insted do a load if we're have DATAOBJ_LOADONIDSET and we're an ID property
if ($self->{'_options'} & DATAOBJ_LOADONIDSET && $property->{'options'} & DATAOBJ_PROPERTY_ID == DATAOBJ_PROPERTY_ID) { if ($self->{'_options'} & DATAOBJ_LOADONIDSET && $property->{'options'} & DATAOBJ_PROPERTY_ID == DATAOBJ_PROPERTY_ID) {
warn " - - - LOAD ID:".prettyUndef($value);
# As this is a object set to load when set, and set as a ID # As this is a object set to load when set, and set as a ID
if (!defined($self->load($property->{'name'} => $value))) { if (!defined($self->load($property->{'name'} => $value))) {
return; return;
...@@ -805,7 +808,7 @@ sub asHash ...@@ -805,7 +808,7 @@ sub asHash
# Build up reply # Build up reply
my %data; my %data;
foreach my $property ($self->_properties(DATAOBJ_PROPERTY_ALL)) { foreach my $property ($self->_properties()) {
# We allow retrieval of data if the get method has been overridden # We allow retrieval of data if the get method has been overridden
my $method = "get$property"; my $method = "get$property";
$data{$property} = $self->$method($property); $data{$property} = $self->$method($property);
...@@ -1008,7 +1011,7 @@ sub dataLoaded ...@@ -1008,7 +1011,7 @@ sub dataLoaded
The C<commit> method is used to commit the record, this means updating it if it exists or inserting it if it does not yet exist. The C<commit> method is used to commit the record, this means updating it if it exists or inserting it if it does not yet exist.
NOTE: This method must be implemented by child classes. NOTE: This method must be implemented by child classes and must call the super class $self->SUPER::commit(@params).
=cut =cut
...@@ -1017,10 +1020,15 @@ sub commit ...@@ -1017,10 +1020,15 @@ sub commit
{ {
my $self = shift; my $self = shift;
# Loop with changed and add to data
foreach my $propertyName ($self->_propertiesWithOnly(DATAOBJ_PROPERTY_REQUIRED)) {
# Check if this property is set
if (!defined($self->_get($propertyName))) {
$self->_log(DATAOBJ_LOG_ERROR,"Property '%s' must be set before calling commit()",$propertyName);
}
}
$self->_log(DATAOBJ_LOG_ERROR,"The 'commit' method needs to be implemented"); return $self;
return;
} }
...@@ -1094,7 +1102,7 @@ sub clone ...@@ -1094,7 +1102,7 @@ sub clone
my ($self,@data) = @_; my ($self,@data) = @_;
$self->_log(DATAOBJ_LOG_DEBUG,"Cloning %s",ref($self)); $self->_log(DATAOBJ_LOG_DEBUG,"Cloning");
# Setup our internals # Setup our internals
my $clone = { my $clone = {
...@@ -1186,16 +1194,20 @@ sub _init ...@@ -1186,16 +1194,20 @@ sub _init
my ($self,@params) = @_; my ($self,@params) = @_;
# Call parent to init
$self->SUPER::_init(@params);
# Grab our configuration # Grab our configuration
my $config = $self->config(); my $config = $self->config();
$self->_log(DATAOBJ_LOG_DEBUG,"Initializing object '%s'",ref($self)); $self->_log(DATAOBJ_LOG_DEBUG,"Initializing object");
# Set everything blank before we begin # Set everything blank before we begin
$self->{'_options'} = 0; $self->{'_options'} = 0;
$self->{'_relations'} = { }; $self->{'_relations'} = { };
$self->{'_relations_map'} = { }; $self->{'_relations_map'} = { };
$self->{'_properties'} = {}; $self->{'_properties'} = { };
$self->{'_property_id'} = undef;
# If we have an odd number of params, chop off the first one as our options # If we have an odd number of params, chop off the first one as our options
if (@params % 2) { if (@params % 2) {
...@@ -1209,6 +1221,19 @@ sub _init ...@@ -1209,6 +1221,19 @@ sub _init
$self->_log(DATAOBJ_LOG_DEBUG2," - Processing property '%s'",$propertyName); $self->_log(DATAOBJ_LOG_DEBUG2," - Processing property '%s'",$propertyName);
# Process options if we have any
if (defined(my $options = $propertyConfig->{'options'})) {
# Check if this is an ID property, if it is, set the internal attribute
if ($options & DATAOBJ_PROPERTY_ID == DATAOBJ_PROPERTY_ID) {
if (defined($self->{'_property_id'})) {
$self->_log(DATAOBJ_LOG_ERROR,
"Multiple properties with DATAOBJ_PROPERTY_ID set, ignoring for property '%s'",$propertyName);
} else {
$self->{'_property_id'} = $propertyName;
}
}
}
# Check format of property # Check format of property
if (!($propertyName =~ /^[A-Z][A-Za-z0-9]+$/)) { if (!($propertyName =~ /^[A-Z][A-Za-z0-9]+$/)) {
$self->_log(DATAOBJ_LOG_ERROR,"Property '%s' has an invalid name",$propertyName); $self->_log(DATAOBJ_LOG_ERROR,"Property '%s' has an invalid name",$propertyName);
...@@ -1222,9 +1247,7 @@ sub _init ...@@ -1222,9 +1247,7 @@ sub _init
my $property = $self->{'_properties'}->{$propertyName}; my $property = $self->{'_properties'}->{$propertyName};
# Check if we have validation criteria # Check if we have validation criteria
if (defined($propertyConfig->{'validate'})) { if (defined(my $validateOptions = $propertyConfig->{'validate'})) {
my $validateOptions = $propertyConfig->{'validate'};
# Loop with validation options # Loop with validation options
foreach my $validateOption (keys %{$validateOptions}) { foreach my $validateOption (keys %{$validateOptions}) {
...@@ -1312,13 +1335,13 @@ sub _init ...@@ -1312,13 +1335,13 @@ sub _init
# Check we have everything # Check we have everything
if (!defined($class)) { if (!defined($class)) {
$self->_log(DATAOBJ_LOG_ERROR,"DataObj '%s' relation '%s' has no attribute 'class'",ref($self),$relationName); $self->_log(DATAOBJ_LOG_ERROR,"Relation '%s' has no attribute 'class'",$relationName);
} }
if (!defined($type)) { if (!defined($type)) {
$self->_log(DATAOBJ_LOG_ERROR,"DataObj '%s' relation '%s' has no attribute 'type'",ref($self),$relationName); $self->_log(DATAOBJ_LOG_ERROR,"Relation '%s' has no attribute 'type'",$relationName);
} }
if (!defined($associations)) { if (!defined($associations)) {
$self->_log(DATAOBJ_LOG_ERROR,"DataObj '%s' relation '%s' has no attribute 'associate'",ref($self),$relationName); $self->_log(DATAOBJ_LOG_ERROR,"Relation '%s' has no attribute 'associate'",$relationName);
} }
$self->_log(DATAOBJ_LOG_DEBUG2," - Relation '%s' => '%s' [%s]",$relationName,$class,$type); $self->_log(DATAOBJ_LOG_DEBUG2," - Relation '%s' => '%s' [%s]",$relationName,$class,$type);
...@@ -1434,6 +1457,17 @@ sub _error ...@@ -1434,6 +1457,17 @@ sub _error
# Return the DATAOBJ_PROPERTY_ID property
sub _property_id
{
my $self = shift;
return $self->{'_property_id'};
}
# Return the property hash of a given property # Return the property hash of a given property
sub _propertyByName sub _propertyByName
{ {
...@@ -1452,9 +1486,12 @@ sub _propertyByName ...@@ -1452,9 +1486,12 @@ sub _propertyByName
# Get properties # Get properties
# Without options returns an array of all object properties.
# If the $match option is specified it is AND'd against the property options, if there is a non 0 result, the property is returned.
# If the $resultTest option is specified, the return from the AND is tested against this to see if it matches.
sub _properties sub _properties
{ {
my ($self,$match) = @_; my ($self,$match,$resultTest) = @_;
my @properties; my @properties;
...@@ -1463,10 +1500,33 @@ sub _properties ...@@ -1463,10 +1500,33 @@ sub _properties
foreach my $propertyName (keys %{$self->{'_properties'}}) { foreach my $propertyName (keys %{$self->{'_properties'}}) {
my $property = $self->{'_properties'}->{$propertyName}; my $property = $self->{'_properties'}->{$propertyName};
# Check if there is no match criteria, or the criteria matches # If there is no match specified, it means all
if (!defined($match) || $match == 0 || !($property->{'options'} & ~$match)) { if (!defined($match)) {
push(@properties,$propertyName); goto ADD_PROPERTY;
}
# AND the match against the options
my $resultBits = $property->{'options'} & $match;
# If we do infact have a resultTest specified, check it
if (defined($resultTest)) {
# NK: We cannot add this to the IF above, as we have an else on the above test below
if ($resultBits == $resultTest) {
goto ADD_PROPERTY;
}
# If we do not have a result test, check if we got something back, if so, its a match
} elsif ($resultBits) {
goto ADD_PROPERTY;
} }
# Nothing matches, so go to next property
next;
# Something matched and we ended up here
ADD_PROPERTY:
push(@properties,$propertyName);
} }
return @properties; return @properties;
...@@ -1474,6 +1534,28 @@ sub _properties ...@@ -1474,6 +1534,28 @@ sub _properties
# Helper function, Returns items with only an option set
sub _propertiesWithOnly
{
my ($self,$option) = @_;
return $self->_properties($option,$option);
}
# Helper function, returns items without an option set
sub _propertiesWithout
{
my ($self,$option) = @_;
return $self->_properties(DATAOBJ_PROPERTY_ALL &~ $option);
}
# Set property, as this is an internal function it can set ANY property # Set property, as this is an internal function it can set ANY property
sub _set sub _set
{ {
...@@ -1512,14 +1594,13 @@ sub _set ...@@ -1512,14 +1594,13 @@ sub _set
# Grab destination property name # Grab destination property name
my $relationPropertyName = $self->_relationPropertyName($property,$relationName); my $relationPropertyName = $self->_relationPropertyName($property,$relationName);
warn sprintf(" - THIS IS A RELATION '%s' [%s => %s] ",$property->{'name'},$relationName,$relationPropertyName);
# Check if we actually managed to set something, if not just return undef # Check if we actually managed to set something, if not just return undef
if (!defined($self->_relation($relationName)->set($relationPropertyName,$value))) { if (!defined($self->_relation($relationName)->set($relationPropertyName,$value))) {
return; return;
} }
} }
$self->_log(DATAOBJ_LOG_DEBUG,"Property '%s' set to '%s'",$property->{'name'},$value); $self->_log(DATAOBJ_LOG_DEBUG,"Property '%s' set to %s",$property->{'name'},defined($value) ? "'$value'" : '-undef-');
$self->{'_data'}->{$property->{'name'}} = $value; $self->{'_data'}->{$property->{'name'}} = $value;
return $self; return $self;
...@@ -1536,7 +1617,7 @@ sub _get ...@@ -1536,7 +1617,7 @@ sub _get
# No matter what the case, we will still find our property # No matter what the case, we will still find our property
if (my $property = $self->_propertyByName($propertyName)) { if (my $property = $self->_propertyByName($propertyName)) {
my $value = $self->{'_data'}->{$property->{'name'}}; my $value = $self->{'_data'}->{$property->{'name'}};
$self->_log(DATAOBJ_LOG_DEBUG,"Property '%s' retrieved value '%s'",$propertyName,prettyUndef($value)); $self->_log(DATAOBJ_LOG_DEBUG,"Property '%s' retrieved value %s",$propertyName,defined($value) ? "'$value'" : '-undef-');
return $value; return $value;
} }
...@@ -1668,7 +1749,7 @@ L<http://gitlab.devlabs.linuxassist.net/awit-frameworks/awit-perl-toolkit/issues ...@@ -1668,7 +1749,7 @@ L<http://gitlab.devlabs.linuxassist.net/awit-frameworks/awit-perl-toolkit/issues
=head1 LICENSE AND COPYRIGHT =head1 LICENSE AND COPYRIGHT
Copyright (C) 2014, AllWorldIT Copyright (C) 2014-2017, AllWorldIT
This program is free software: you can redistribute it and/or modify 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 it under the terms of the GNU General Public License as published by
......
# AWIT Database Data Object # AWITPT DataObj backend for DBLayer