view release on metacpan or  search on metacpan

lib/Data/Toolkit/Connector/DBI.pm  view on Meta::CPAN

=cut

sub add {
	my $self = shift;
	my $source = shift;
	my $map = shift;

	croak "Data::Toolkit::Connector::DBI->add called before addspec has been defined" if !$self->{add_sth};
	croak "Data::Toolkit::Connector::DBI->add first parameter should be a Data::Toolkit::Entry"
		if ($source and !$source->isa('Data::Toolkit::Entry'));
	croak "Data::Toolkit::Connector::DBI->add second parameter should be a Data::Toolkit::Map"
		if ($map and !$map->isa('Data::Toolkit::Map'));

	carp "Data::Toolkit::Connector::DBI->add $self $source" if $debug;

	# Apply the map if we have one
	$source = $source->map($map) if $map;

	# The args to be passed to the SQL UPDATE statement
	my @args;
	# The array of names that came from the addspec
	my @arglist = @{$self->{add_arglist}};
	# Check that we have an entry to get params from
	print "ARGLIST for add: ", (join '/', @arglist), "\n" if $debug;
	if ($arglist[0] and !$source) {
		croak "Data::Toolkit::Connector::DBI->add requires an entry when the addspec includes parameters";
	}

	# Extract the args from the entry
	my $arg;
	foreach $arg (@arglist) {
		my $value = $source->get($arg);
		croak "add spec calls for a '$arg' attribute but the entry does not have one" if !$value;
		# We only use the first value from the list.
		# This is permitted to be undef or the null string.
		$value = $value->[0];
		push @args, $value;
	}

	# Start the operation and return the statement handle having stashed a copy internally
	return $self->{add_result} = $self->{add_sth}->execute( @args );
}


########################################

=head2 updatespec

Supply or fetch spec for update

   $spec = $dbiConn->updatespec();
   $spec = $dbiConn->updatespec( "UPDATE people set name = %myname% WHERE joinkey = %mykey%" );

Parameters are indicated thus: %name% - this will result in a '?'-style placeholder in
the SQL statement and the named attribute will be extracted from the supplied entry
by the update() method.

=cut

sub updatespec {
	my $self = shift;
	my $updatespec = shift;

	carp "Data::Toolkit::Connector::DBI->updatespec $self $updatespec " if $debug;

	croak "Data::Toolkit::Connector::DBI->updatespec called before server connection opened" if !$self->{server};

	# No arg supplied - just return existing setting
	return $self->{updatespec} if (!$updatespec);

	# We have a new updatespec so stash it for future reference
	$self->{updatespec} = $updatespec;

	# We need to parse the spec to find the list of args that it calls for.
	# Start by clearing the arglist and update string
	my $update = '';
	my @arglist;
	$self->{update_arglist} = \@arglist;

	# Parameter names are between pairs of % characters
	# Where we want a literal '%' it is represented by '%%'
	# so if the update string has at least two '%' left then there is work to be done
	while ($updatespec =~ /%.*%/) {
		my ($left,$name,$right) = ($updatespec =~ /^([^%]*)%([a-zA-Z0-9_]*)%(.*)$/);
		# Everything before the first % gets added to the update string
		$update .= $left;
		if ($name) {
			# Add the name to the list of attributes needed when the update is performed
			push @arglist, $name;
			# Put the placeholder in the actual update string
			$update .= '?';
		}
		else {
			# We got '%%' so add a literal '%' to the update string
			$update .= '%';
		}
		# The remainder of the updatespec goes round again
		$updatespec = $right;
	}
	# Anything left in the updatespec gets appended to the update string
	$update .= $updatespec;

	# Stash the resulting string and associated list of attributes
	$self->{update_statement} = $update;

	# Prepare the statement and stash the statement handle
	$self->{update_sth} = $self->{server}->prepare( $update );
	croak "Failed to prepare update '$update'" if !$self->{update_sth};

	carp "Data::Toolkit::Connector::DBI->updatespec setting '$update', (" . (join ',',@arglist) . ")" if $debug;

	# Return the spec string that we were given
	return $self->{updatespec};
}

########################################

=head2 update

Update a row in the database using data from a source entry and an optional map.
If a map is supplied, it is used to transform data from the source entry before
it is applied to the database operation.

Returns the result of the DBI execute operation.

   $msg = $dbConn->update($sourceEntry);
   $msg = $dbConn->update($sourceEntry, $updateMap);

A suitable update operation must have been defined using the updatespec() method
before update() is called:

   $spec = $dbiConn->updatespec( "UPDATE people set name = %myname% WHERE key = %mykey%" );
   $msg = $dbiConn->update( $entry );

NOTE that only the first value of a given attribute is used, as relational databases expect
a single value for each column in a given row.

Note also that multiple rows could be affected by a single call to this method, depending
on how the updatespec has been defined.

=cut

sub update {
	my $self = shift;
	my $source = shift;
	my $map = shift;

	croak "Data::Toolkit::Connector::DBI->update called before updatespec has been defined" if !$self->{update_sth};
	croak "Data::Toolkit::Connector::DBI->update first parameter should be a Data::Toolkit::Entry"
		if ($source and !$source->isa('Data::Toolkit::Entry'));
	croak "Data::Toolkit::Connector::DBI->update second parameter should be a Data::Toolkit::Map"
		if ($map and !$map->isa('Data::Toolkit::Map'));

	carp "Data::Toolkit::Connector::DBI->update $self $source" if $debug;

	# Apply the map if we have one
	$source = $source->map($map) if $map;

	# The args to be passed to the SQL UPDATE statement
	my @args;
	# The array of names that came from the updatespec
	my @arglist = @{$self->{update_arglist}};
	# Check that we have an entry to get params from
	print "ARGLIST for update: ", (join ',', @arglist), "\n" if $debug;
	if ($arglist[0] and !$source) {
		croak "Data::Toolkit::Connector::DBI->update requires an entry when the updatespec includes parameters";
	}

	# Extract the args from the entry
	my $arg;
	foreach $arg (@arglist) {
		my $value = $source->get($arg);
		croak "update spec calls for a '$arg' attribute but the entry does not have one" if !$value;
		# We only use the first value from the list.
		# This is permitted to be the null string.
		# It should not be undef, as that would need an 'IS NULL' clause in SQL.
		$value = $value->[0];
		push @args, $value;
	}

	# Start the search and return the statement handle having stashed a copy internally
	return $self->{update_result} = $self->{update_sth}->execute( @args );
}


########################################

=head2 deletespec

Supply or fetch spec for delete

   $spec = $dbiConn->deletespec();
   $spec = $dbiConn->deletespec( "DELETE from people WHERE joinkey = %mykey%" );

Parameters are indicated thus: %name% - this will result in a '?'-style placeholder in
the SQL statement and the named attribute will be extracted from the supplied entry
by the delete() method.

=cut

sub deletespec {
	my $self = shift;
	my $deletespec = shift;