File Coverage

blib/lib/DBIx/Hash2Table.pm

Criterion	Covered	Total	%
statement	9	43	20.9
branch	0	8	0.0
condition	0	9	0.0
subroutine	3	8	37.5
pod	0	2	0.0
total	12	70	17.1

package DBIx::Hash2Table;

# Name:
#	DBIx::Hash2Table.
#
# Documentation:
#	POD-style documentation is at the end. Extract it with pod2html.*.
#
# Reference:
#	Object Oriented Perl
#	Damian Conway
#	Manning
#	1-884777-79-1
#	P 114
#
# Note:
#	o Tab = 4 spaces || die.
#
# Author:
#	Ron Savage
#	Home page: http://savage.net.au/index.html
#
# Licence:
#	Australian copyright (c) 1999-2002 Ron Savage.
#
#	All Programs of mine are 'OSI Certified Open Source Software';
#	you can redistribute them and/or modify them under the terms of
#	The Artistic License, a copy of which is available at:
#	http://www.opensource.org/licenses/index.html

use strict;
use warnings;

use Carp;

require 5.005_62;

require Exporter;

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use DBIx::Hash2Table ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(

) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(

);
our $VERSION = '2.04';

# -----------------------------------------------

# Preloaded methods go here.

# -----------------------------------------------

# Encapsulated class data.

{
	my(%_attr_data) =
	(
		_columns	=> '',
		_dbh		=> '',
		_extras		=> [],
		_hash_ref	=> '',
		_table_name	=> '',
	);

	sub _default_for
	{
		my($self, $attr_name) = @_;

		$_attr_data{$attr_name};
	}

	sub _save
	{
		my($self, $sth, $hash_ref, $parent) = @_;

		my(@bind);

		for my $key (keys %$hash_ref)
		{
			# If we have a hash ref, which we almost always do have...

			if (ref($$hash_ref{$key}) eq 'HASH')
			{
				$$self{'_id'}++;

				@bind = ($$self{'_id'}, $parent, $key);

				for (@{$$self{'_extras'} })
				{
					push(@bind, exists($$hash_ref{$key}{$_}) ? $$hash_ref{$key}{$_} : undef);
				}

				$sth -> execute(@bind);

				# Curse again. (Aka 'recurse', for non-native speakers of English.)

				$self -> _save($sth, $$hash_ref{$key}, $$self{'_id'});
			}
		}

	}	# End of _save.

	sub _standard_keys
	{
		keys %_attr_data;
	}
}

# -----------------------------------------------

sub insert
{
	my($self)			= @_;
	$$self{'_extras'}	= [sort @{$$self{'_extras'} }];
	my($sql)			= "insert into $$self{'_table_name'} (" . join(', ', @{$$self{'_columns'} }, @{$$self{'_extras'} }) . ') values (' . join(', ', ('?') x ($#{$$self{'_columns'} } + $#{$$self{'_extras'} } + 2) ) . ')';
	my($sth)			= $$self{'_dbh'} -> prepare($sql);
	$$self{'_id'}		= 0;

	$self -> _save($sth, $$self{'_hash_ref'}, 0);

}	# End of insert.

# -----------------------------------------------

sub new
{
	my($class, %arg)	= @_;
	my($self)			= bless({}, $class);

	for my $attr_name ($self -> _standard_keys() )
	{
		my($arg_name) = $attr_name =~ /^_(.*)/;

		if (exists($arg{$arg_name}) )
		{
			$$self{$attr_name} = $arg{$arg_name};
		}
		else
		{
			$$self{$attr_name} = $self -> _default_for($attr_name);
		}
	}

	croak(__PACKAGE__ . ". You must supply a value for each parameter except 'extras'")
		if (! ($$self{'_columns'} && $$self{'_dbh'} && $$self{'_hash_ref'} && $$self{'_table_name'}) );

	return $self;

}	# End of new.

# -----------------------------------------------

1;

__END__