Skip to content
GitLab
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
Expand all Show whitespace changes
Inline Side-by-side
Makefile.PL
View file @ 6d019948
......@@ -36,7 +36,7 @@ WriteMakefile(
'MAN3PODS' => {
'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/client.pm' => '$(INST_MAN3DIR)/AWITPT::Util::ConvertTSQL::client.3',
'lib/AWITPT/Util/ConvertTSQL/MySQL.pm' => '$(INST_MAN3DIR)/AWITPT::Util::ConvertTSQL::MySQL.3',
......
doxygen/Doxyfile deleted 100644 → 0
View file @ 26d09a12
This diff is collapsed.
lib/AWITPT/DB/DBILayer.pm
View file @ 6d019948
# Database independent layer module
# Copyright (C) 2009-2014, AllWorldIT
# Copyright (C) 2009-2017, AllWorldIT
# Copyright (C) 2008, LinuxRulz
# Copyright (C) 2005-2007 Nigel Kukard <nkukard@lbsd.net>
#
......@@ -28,7 +28,7 @@ package AWITPT::DB::DBILayer;
use strict;
use warnings;
our $VERSION = "1.00";
our $VERSION = 1.01;
use DBI;
......
lib/AWITPT/DB/DBLayer.pm
View file @ 6d019948
# Common database layer module
# Copyright (C) 2009-2014, AllWorldIT
# Copyright (C) 2009-2017, AllWorldIT
# Copyright (C) 2008, LinuxRulz
# Copyright (C) 2005-2007 Nigel Kukard <nkukard@lbsd.net>
#
......@@ -22,12 +22,14 @@
## @class AWITPT::DB::DBLayer
# Database layer module which makes life a bit esier
package AWITPT::DB::DBLayer;
use parent 'Exporter';
use strict;
use warnings;
our $VERSION = '2.000';
use parent 'Exporter';
our $VERSION = 2.01;
# Exporter stuff
our (@EXPORT);
......@@ -384,7 +386,7 @@ sub DBLastInsertID
}
my $res;
if (!($res = $dbh->lastInsertID(undef,undef,$table,$column))) {
if (!($res = $dbh->lastInsertID($table,$column))) {
_error("Error getting last inserted id: ".$dbh->error());
return;
}
......
lib/AWITPT/DataObj.pm
View file @ 6d019948
# AWIT Data Object
# Copyright (C) 2014, AllWorldIT
# Copyright (C) 2014-2017, 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
......@@ -26,12 +26,13 @@ AWITPT::DataObj - AWITPT Database Data Object
# Create a child class
#
package AWITPT::DataObj::myobject;
use AWITPT::DataObj 1.00;
use base 'AWITPT::DataObj';
use strict;
use warnings;
use AWITPT::DataObj 1.00;
use parent, -norequire 'AWITPT::DataObj';
our $VERSION = '1.000';
# Return the configuration for this object
......@@ -60,22 +61,26 @@ access to data.
package AWITPT::DataObj;
use parent 'Exporter';
use strict;
use warnings;
our $VERSION = "3.000";
use AWITPT::Object 1.01;
use parent -norequire, 'AWITPT::Object';
our $VERSION = 3.01;
our (@EXPORT,@EXPORT_OK);
@EXPORT = qw(
DATAOBJ_LOADONIDSET
DATAOBJ_PROPERTY_ALL
DATAOBJ_PROPERTY_READONLY
DATAOBJ_PROPERTY_NOLOAD
DATAOBJ_PROPERTY_ID
DATAOBJ_PROPERTY_NOSAVE
DATAOBJ_PROPERTY_ID
DATAOBJ_PROPERTY_REQUIRED
DATAOBJ_PROPERTY_ALL
DATAOBJ_RELATION_READONLY
......@@ -100,8 +105,13 @@ use constant {
'DATAOBJ_PROPERTY_NOLOAD' => 2,
# Do not save this field to DB
'DATAOBJ_PROPERTY_NOSAVE' => 4,
# Combination of above
# Combination of READONLY and NOSAVE
'DATAOBJ_PROPERTY_ID' => 5,
# This property must be set before doing a commit
'DATAOBJ_PROPERTY_REQUIRED' => 8,
# Match property
'DATAOBJ_PROPERTY_ALL' => 255,
......@@ -137,7 +147,7 @@ use Data::Dumper;
=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
......@@ -145,7 +155,7 @@ C<AWITPT::DataObj> provides the below manipulation methods.
=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.
......@@ -171,23 +181,7 @@ This property will cause the object to load when a DATAOBJ_PROPERTY_ID is set.
=cut
# Class instantiation
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;
}
# The new() method is inherited from AWITPT::Object.
......@@ -229,19 +223,29 @@ Below is a list of supported options:
=over
=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 *
B<DATAOBJ_PROPERTY_NOLOAD>
This property is not loaded from the database
This property will not be loaded.
=item *
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
......@@ -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
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
if (!defined($self->load($property->{'name'} => $value))) {
return;
......@@ -805,7 +808,7 @@ sub asHash
# Build up reply
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
my $method = "get$property";
$data{$property} = $self->$method($property);
......@@ -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.
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
......@@ -1017,10 +1020,15 @@ sub commit
{
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;
return $self;
}
......@@ -1094,7 +1102,7 @@ sub clone
my ($self,@data) = @_;
$self->_log(DATAOBJ_LOG_DEBUG,"Cloning %s",ref($self));
$self->_log(DATAOBJ_LOG_DEBUG,"Cloning");
# Setup our internals
my $clone = {
......@@ -1186,16 +1194,20 @@ sub _init
my ($self,@params) = @_;
# Call parent to init
$self->SUPER::_init(@params);
# Grab our configuration
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
$self->{'_options'} = 0;
$self->{'_relations'} = { };
$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 (@params % 2) {
......@@ -1209,6 +1221,19 @@ sub _init
$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
if (!($propertyName =~ /^[A-Z][A-Za-z0-9]+$/)) {
$self->_log(DATAOBJ_LOG_ERROR,"Property '%s' has an invalid name",$propertyName);
......@@ -1222,9 +1247,7 @@ sub _init
my $property = $self->{'_properties'}->{$propertyName};
# Check if we have validation criteria
if (defined($propertyConfig->{'validate'})) {
my $validateOptions = $propertyConfig->{'validate'};
if (defined(my $validateOptions = $propertyConfig->{'validate'})) {
# Loop with validation options
foreach my $validateOption (keys %{$validateOptions}) {
......@@ -1312,13 +1335,13 @@ sub _init
# Check we have everything
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)) {
$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)) {
$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);
......@@ -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
sub _propertyByName
{
......@@ -1452,9 +1486,12 @@ sub _propertyByName
# 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
{
my ($self,$match) = @_;
my ($self,$match,$resultTest) = @_;
my @properties;
......@@ -1463,10 +1500,33 @@ sub _properties
foreach my $propertyName (keys %{$self->{'_properties'}}) {
my $property = $self->{'_properties'}->{$propertyName};
# Check if there is no match criteria, or the criteria matches
if (!defined($match) || $match == 0 || !($property->{'options'} & ~$match)) {
push(@properties,$propertyName);
# If there is no match specified, it means all
if (!defined($match)) {
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;
......@@ -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
sub _set
{
......@@ -1512,14 +1594,13 @@ sub _set
# Grab destination property name
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
if (!defined($self->_relation($relationName)->set($relationPropertyName,$value))) {
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;
return $self;
......@@ -1536,7 +1617,7 @@ sub _get
# No matter what the case, we will still find our property
if (my $property = $self->_propertyByName($propertyName)) {
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;
}
......@@ -1668,7 +1749,7 @@ L<http://gitlab.devlabs.linuxassist.net/awit-frameworks/awit-perl-toolkit/issues
=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
it under the terms of the GNU General Public License as published by
......
lib/AWITPT/DB/DataObj.pm → lib/AWITPT/DataObj/Backend/DBLayer.pm
View file @ 6d019948
# AWIT Database Data Object
# Copyright (C) 2014, AllWorldIT
# AWITPT DataObj backend for DBLayer
# Copyright (C) 2014-2017, 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
......@@ -18,20 +18,21 @@
=head1 NAME
AWITPT::DB::DataObj - AWITPT Database Data Object
AWITPT::DataObj::Backend::DBLayer - AWITPT DataObj backend for DBLayer
=head1 SYNOPSIS
#
# Create a child class
#
package AWITPT::DB::DataObj::myobject;
use AWITPT::DB::DataObj 1.00;
use parent 'AWITPT::DB::DataObj';
package DataObj::myobject;
use strict;
use warnings;
use AWITPT::DataObj::Backend::DBLayer 1.00;
use parent, -norequire 'AWITPT::DataObj::Backend::DBLayer';
our $VERSION = '1.00';
# Return the configuration for this object
......@@ -40,6 +41,8 @@ AWITPT::DB::DataObj - AWITPT Database Data Object
my $config = {
# Set table name
'table' => "testtable",
# Optional: set column mapping
'table_columns' => { 'Property1' => "property_column", 'Property2' => "property_column2" },
# Setup our data definition
'properties' => {
'ID' => {
......@@ -55,34 +58,25 @@ AWITPT::DB::DataObj - AWITPT Database Data Object
=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.
The C<AWITPT::DataObj::Backend::DBLayer> class provides an abstraction layer between a data definition and the underlying database, allowing easy
access to table data. This class inherits all methods from C<AWITPT::DataObj>.
=cut
package AWITPT::DB::DataObj;
use parent 'Exporter';
use AWITPT::DataObj 3.000;
use base 'AWITPT::DataObj';
package AWITPT::DataObj::Backend::DBLayer;
use strict;
use warnings;
our $VERSION = "2.000";
use AWITPT::DataObj 3.01;
use parent -norequire, 'AWITPT::DataObj';
our (@ISA,@EXPORT,@EXPORT_OK);
# Re-export our parents constants
@EXPORT = qw(
DATAOBJ_LOADONIDSET
DATAOBJ_PROPERTY_READONLY
DATAOBJ_PROPERTY_NOLOAD
DATAOBJ_PROPERTY_ID
DATAOBJ_PROPERTY_NOSAVE
our $VERSION = 2.01;
DATAOBJ_RELATION_READONLY
our (@ISA,@EXPORT,@EXPORT_OK);
@EXPORT = qw(
);
@EXPORT_OK = qw(
);
......@@ -98,7 +92,7 @@ use Data::Dumper;
=head1 METHODS
C<AWITPT::DB::DataObj> provides the below manipulation methods.
C<AWITPT::DataObj::Backend::DBLayer> provides the below manipulation methods.
=cut
......@@ -111,6 +105,7 @@ C<AWITPT::DB::DataObj> provides the below manipulation methods.
{
retrun {
'table' => "mytable"
'table_columns' => { 'Property1' => "property_column", 'Property2' => "property_column2" },
'properties' => {
'Description' => {
<OPTIONS>,
......@@ -121,7 +116,22 @@ C<AWITPT::DB::DataObj> provides the below manipulation methods.
}
}
See L<AWITPT::DataObj> for options, validation and relations.
See L<AWITPT::DataObj> for additional options, validation and relations.
=head3 Table Name
The table name is specified using the 'table' configuration option.
'table' => "tableNameHere'
=head3 Table Column Mapping
Sometimes properties do not have the same column name. In this case we can specify a property to column mapping.
'table_columns' => { 'PropertyName' => 'ColumnName' },
NB: Capitalization here is very important!
=back
......@@ -162,6 +172,11 @@ sub records
my $self = shift;
# Get list of columns we need
my @columns = $self->_tableProperties2Columns(
$self->_propertiesWithout(DATAOBJ_PROPERTY_NOLOAD)
);
# Do select query
my ($sth,$numResults) = DBSelectSearch(
sprintf("
......@@ -170,7 +185,7 @@ sub records
FROM
%s
",
join(',',$self->_properties(DATAOBJ_PROPERTY_ALL ^ DATAOBJ_PROPERTY_NOLOAD)),
join(',',@columns),
$self->table()
)
);
......@@ -184,10 +199,12 @@ sub records
}
# Add each row as another record
my @records;
while (my $row = hashifyLCtoMC($sth->fetchrow_hashref(), $self->_properties(DATAOBJ_PROPERTY_ALL))) {
my @records = ( );
while (my $row = hashifyLCtoMC($sth->fetchrow_hashref(),@columns)) {
# Translate hash from row to record
my $data = $self->_tableRow2Record($row);
# We use clone to clone the current child class, and reset to reset the object entirely
my $record = $self->clone()->reset()->_loadHash($row);
my $record = $self->clone()->reset()->_loadHash($data);
push(@records,$record);
}
......@@ -220,7 +237,19 @@ sub load
# One param means that we're just grabbing an ID
if (@params == 1) {
$matches{'ID'} = shift(@params);
# Validate the ID property name
my $IDProperty = $self->_property_id();
if (!defined($IDProperty)) {
# Report error and return
$self->_error("Invalid invocation of load(), object has no property with option DATAOBJ_PROPERTY_ID");
$self->_log(DATAOBJ_LOG_ERROR,
"Invalid invocation of load(), object has no property with option DATAOBJ_PROPERTY_ID");
return;
}
# Grab column name for the ID property
my $IDColumn = $self->_tableProperty2Column($IDProperty);
$matches{$IDColumn} = shift(@params);
# More params, means we grabbing based on a "search"
} else {
%matches = @params;
......@@ -229,11 +258,19 @@ sub load
# Build SQL statement
my @whereItems;
my @whereValues;