SQL::Generator - Generate SQL-statements with oo-perl

SQL-Generator documentation Contained in the SQL-Generator distribution.

Index

Code Index:

NAME

Top

SQL::Generator - Generate SQL-statements with oo-perl

SYNOPSIS

Top

  use SQL::Generator;

DESCRIPTION

Top

With this module you can easily (and very flexible) generate/construct sql-statements. As a rookie, you are used to write a lot of sprintf`s every time i needed a statement (i.e.for DBI). Later you start writing your own functions for every statement and every sql-dialect (RDBMS use to have their own dialect extending the general SQL standard). This SQL::Generator module is an approach to have a flexible abstraction above the statement generation, which makes it easy to implement in your perl code. Its main purpose is to directly use perl variables/objects with SQL-like code.

CLASSES

Top

SQL::Generator

USE

Top

Carp

CLASS METHODS

Top

close

Destructor.

dialect_path( $dialect )

Returns the perl 'use' module path of the dialect.

change_dialect( $dialect )

Loads commandset for the dialect. Afterwards SQL::Generator interprets its calls with this dialect.

Method

Top

dump_history

INSTALL

Top

Standard configuration, just type in your shell:

	perl Makefile.PL
	make
	make test
	make install

or if CPAN module is working, type in your shell:

	perl -MCPAN -e 'shell install SQL::Generator'

Win32 enviroment (which have Microsoft Developer Studio installed), type in your shell:

	perl Makefile.PL
	nmake
	nmake test
	nmake install

or using CPAN, type in your shell:

	perl -MCPAN -e "shell install SQL::Generator"

EXPORT

Top

None.

METHODS

Top

new( ... )

new is the class constructor. It accepts a hash list of following arguments:

LANG => (string) .i.e.: 'MYSQL'

LANG is optional; Following alternatives are possible:

MYSQL (default), ORACLE, SQL92

This is the generator-engine specifier. It tells the SQL::Generator which dialect of the SQL-LANGUAGE will be generated / produced / constructed. This distribution only supports a very limited subset of the MYSQL (version 3.22.30) sql command set. The transparent implementation invites everyone to extend/contribute to the engine (have a look at IMPLEMENTATION near the end of this document). You may also use 'ORACLE' or 'SQL92' as a parameter, but they simply represents a copy of the 'MYSQL' implementation and were added for motivating to extend the interface (of course not tested for real compability yet).

FILE => (string) .i.e.: '>filename.sql'

FILE is optional;

A filename for alternativly dumping the generated sql output to a file.This should be valid filename as used by IO::File open function. The parameter is directly forwared to this function, therefore the heading mode controllers are significant, but you should only use only output modes (">", ">>", ..) because SQL::Generator will only print to the handle.

PRE => (string) .i.e.: "$line)\t\t"

PRE is optional.

A string which will be concated before each generated sql command.

PRE() is also a method, which may be called anywhere in the lifetime of an SQL::Generator instance and will have an impact on further behaviour.

POST => (string) .i.e.: ';\n\n'

POST is optional.

A string which will be concated after each generated sql command.

POST() is also a method, which may be called anywhere in the lifetime of an SQL::Generator instance and will have an impact on further behaviour.

AUTOPRINT => (boolean) .i.e. 0

AUTOPRINT is 0 (false) per default.

Normally when an SQL-generating method is called, it returns the result as a string, which may printed or stored or whatever. If you want that the method is also echoing the command to STDOUT, so turn this switch on (1).

AUTOPRINT() is also a method, which may be called anywhere in the lifetime of an SQL::Generator instance and will have an impact on further behaviour.

prettyprint => (boolean) .i.e. 0

prettyprint is 0 (false) per default.

history => (boolean) .i.e. 0

history is 0 (false) per default.

historysize => (scalar) .i.e. 50 [lines]

historysize is 100 lines per default.

debug => (boolean) .i.e. 0

debug is 0 (false) per default.

If true (1), it turns some diagnostic printings on, but should be used from very advanced users only.

debug() ,debugOn() or debugOff are also methods, which may be called anywhere in the lifetime of an SQL::Generator instance and will have an impact on further behaviour.

changLang( 'LANGID' )

see new( LANG ) argument description above.

Changes the (current) SQL language module. It accepts following arguments:

LANGID (string) .i.e.: 'MYSQL'

LANG is not optional; Following alternatives in this dist are possible:

MYSQL (default), ORACLE, SQL92

It changes the generator-language module (it is simply another module loaded), which switches the translation to another SQL dialect which controlls how the output is generated / produced / constructed. Generally it looks for <LANGID>.pm in a subpath 'Generator/Lang/' of the distribution (have a look at IMPLEMENTATION section near the end of this document).

totext( RULE )

For advanced users only ! Interprets (current) command with a rule. It accepts following arguments:

RULE (a SQL::Generator::Command instance)

RULE is not optional;

It translates the perl function call (via AUTOLOAD) to an SQL function. For the construction of the SQL it uses an SQL::Generator::Command instance, which holds the information how to transform the function parameters to an SQL string.

see the SQL::Generator::Command pod for specific description.

EXAMPLE 1 (see test.pl in the dist-directory)

Top

DESCRIPTION

A very simple example. It instanciates the generator and creates some example output, which could be simply piped to an mysql database for testing (be careful if tables/database name is existing. I guess not !).

CODE

my $table = 'sql_statement_construct_generator_table';

my $database = 'sql_statement_construct_generator_db';

my %types = ( row1 => 'VARCHAR(10) AUTO_INCREMENT PRIMARY KEY',

	row2 => 'INTEGER',

	row3 => 'VARCHAR(20)'
);

my %columns = ( row1 => '1', row2 => '2', row3 => '3' );

my %alias = ( row1 => 'Name', row2 => 'Age', row3 => 'SocialID' );

	my $sql = new SQL::Generator(

		LANG => 'MYSQL',

		post => ";\n",

		history => 1,

		autoprint => 0,

		prettyprint => 0

	) or die 'constructor failed';

	$sql->CREATE( DATABASE => $database );

	$sql->USE( DATABASE => $database );

	$sql->CREATE( COLS => \%types, TABLE => $table );

	$sql->DESCRIBE( TABLE => $table );

	$sql->INSERT(

		COLS => [ keys %columns ],

		VALUES => [ values %columns ],

		INTO => $table

		);

	foreach (keys %columns)	{ $columns{$_}++ }

	$sql->INSERT( SET => \%columns , INTO => $table );

	foreach (keys %columns)	{ $columns{$_}++ }

	$sql->REPLACE(

		COLS => [ keys %columns ],

		VALUES => [ values %columns ],

		INTO => $table,

		);

	$sql->SELECT( ROWS => '*', FROM => $table );

	$sql->SELECT( ROWS => [ keys %types ], FROM => $table );

	$sql->SELECT(

		ROWS =>  \%alias,

		FROM => $table,

		WHERE => 'row1 = 1 AND row3 = 3'

		);

	$sql->DROP( TABLE => $table );

	$sql->DROP( DATABASE => $database );

	# evocate an errormsg

	print "\nDumping sql script:\n\n";

	for( $sql->HISTORY() )
	{
		printf "%s", $_;
	}

OUTPUT OF EXAMPLE 1

CREATE DATABASE sql_statement_construct_db; USE sql_statement_construct_db; CREATE TABLE sql_statement_construct_table ( row1 VARCHAR(10) AUTO_INCREMENT PRIMARY KEY, row2 INTEGER, row3 VARCHAR(20) ); DESCRIBE sql_statement_construct_table; INSERT INTO sql_statement_construct_table ( row1, row2, row3 ) VALUES( 1, 2, 3 ); INSERT INTO sql_statement_construct_table SET row1='2', row2='3', row3='4'; REPLACE INTO sql_statement_construct_table ( row1, row2, row3 ) VALUES( 3, 4, 5 ); SELECT * FROM sql_statement_construct_table; SELECT row1, row2, row3 FROM sql_statement_construct_table; SELECT row1 AS 'Name', row2 AS 'Age', row3 AS 'SocialID' FROM sql_statement_construct_table WHERE row1 = 1 AND row3 = 3; DROP TABLE sql_statement_construct_table; DROP DATABASE sql_statement_construct_db;

EXAMPLE 2

Top

DESCRIPTION

This example is uses the perl AUTOLOAD/BEGIN/END features. With this script template, you are enabled to write very straightforward code, without even sensing the OO architecture of the SQL::Generator implementation. Therefore you can directly use "functions" instead of writing method syntax.

It looks like a new SQL script language with perl powerfeatures. It tastes like an "embedded SQL" script, but you can simply change the destination SQL database language with one parameter.

CODE

use strict; use vars qw($AUTOLOAD);

my $sql;

BEGIN { use SQL::Generator;

	$sql = new SQL::Generator(

		LANG => 'ORACLE',

		FILE => '>create_table.oraclesql',

		post => ";\n",

		autoprint => 1,

		) or print 'object construction failed';
}

END { $sql->close(); }

sub AUTOLOAD { my $func = $AUTOLOAD;

	$func =~ s/.*:://;

    	return if $func eq 'DESTROY';

	my %args = @_;

	$sql->$func( %args );
}

## PERL/SQL STARTS HERE ##

my $table = 'sql_statement_construct_generator_table';

my $database = 'sql_statement_construct_generator_db';

my %types = ( row1 => 'VARCHAR(10) AUTO_INCREMENT PRIMARY KEY',

	row2 => 'INTEGER',

	row3 => 'VARCHAR(20)'
);

my %columns = ( row1 => '1', row2 => '2', row3 => '3' );

my %alias = ( row1 => 'Name', row2 => 'Age', row3 => 'SocialID' );

	CREATE( DATABASE => $database );

	USE( DATABASE => $database );

	CREATE( TABLE => $table, COLS => \%types );

	DESCRIBE( TABLE => $table );

	INSERT( SET => \%columns , INTO => $table );

	DROP( TABLE => $table );

	DROP( DATABASE => $database );

OUTPUT OF EXAMPLE 2

CREATE DATABASE sql_statement_construct_db; USE sql_statement_construct_db; CREATE TABLE sql_statement_construct_table ( row1 VARCHAR(10) AUTO_INCREMENT PRIMARY KEY, row2 INTEGER, row3 VARCHAR(20) ); DESCRIBE sql_statement_construct_table; INSERT INTO sql_statement_construct_table SET row1='2', row2='3', row3='4'; DROP TABLE sql_statement_construct_table; DROP DATABASE sql_statement_construct_db;

IMPLEMENTATION

Top

see the SQL::Generator::Lang::MYSQL pod documentation for how to easily extend the archive of generators sql-standard/non-standard languages.

SQL::Generator::Debugable Baseclass for symdumps, croaks and intelligent debugging. SQL::Generator::Argument Class that implements the translation on command argument level and also formats the perl function arguments to text. SQL::Generator::Command Class that holds the configuration of the arguments of the SQL-command versus perl-function. Object::ObjectList A list class for Command's (SQL-commands) which defines the language. SQL::Generator::Lang::* A subclass of CommandList which is dynamically used for SQL generation. Dictates the language conformance.

SUPPORT

Top

By author. Ask comp.lang.perl.misc or comp.lang.perl.module if you have very general questions. Or try to consult a perl and SQL related mailinglist before.

If all this does not help, contact me under my email below.

AUTHOR

Top

Murat Uenalan, muenalan@cpan.org

COPYRIGHT

Top

    The SQL::Generator module is Copyright (c) 1998-2002 Murat Uenalan. Germany. All rights reserved.

    You may distribute under the terms of either the GNU General Public
    License or the Artistic License, as specified in the Perl README file.

SEE ALSO

Top

perl(1), DBI, DBIx::*, DBD::*

SQL-Generator documentation Contained in the SQL-Generator distribution. 
# Author: Murat Uenalan (muenalan@cpan.org)
#
# Copyright (c) 2001 Murat Uenalan. All rights reserved.
#
# Note: This program is free software; you can redistribute
#
# it and/or modify it under the same terms as Perl itself.

our $VERSION = '0.02';

require 5.005_62;

use warnings;

use Carp;

use Class::Maker;

package Object::ObjectList;

use Class::Maker::Examples::Array;

#use Types::Array;

Class::Maker::class
{
	isa => [qw(Array)],

	attribute =>
	{
		getset => [ qw/name blessed/ ],
	},
};

sub push_new
{
	my $this = shift;

	my %arghash = @_;

	my $obj;

	my $class = $this->blessed();

	unless( $class->can( 'new' ) )
	{
			::croak "Couldn't call method new via module '$class' :$@";
	}

	$obj = $class->new( %arghash );

	$this->push( $obj );

return $obj;
}

	# search our object list and return the obj with matching attributes

sub get_where
{
	my $this = shift;

	my %arghash = @_;

	my $key = shift @{ [ keys %arghash ] };

	my @results;

		foreach my $obj ( $this->get )
		{
			if( $obj->$key() eq $arghash{$key} )
			{
				push @results, $obj;
			}
		}

	return undef unless @results;

return wantarray ? @results : $results[0];
}

sub get_where_islike
{
	my $this = shift;

	my %arghash = @_;

	my $key = shift @{ [ keys %arghash ] };

	my @results;

		foreach my $obj ( @{ $this->get } )
		{
			if( $obj->$key() =~ /$arghash{$key}/ )
			{
				push @results, $obj;
			}
		}

return \@results;
}

package SQL::Generator::Argument;

Class::Maker::class
{
	attribute =>
	{
		getset =>
		[
			qw(replace pre post token parameter),

			qw(token_printf joinstr param_printf),

			qw(joinseperator),

			qw(hash_keyprintf hash_valueprintf hash_assigner),

			qw(array_valueprintf),
		],

		hash => [qw(argtypes)],
	},
};

require 5.005_62; use warnings; use strict;

# Preloaded methods go here.

sub _preinit
{
	my $this = shift;

	$this->pre('');
	$this->post('');

	$this->token_printf('%s');	# format tokenstring
	$this->param_printf('%s');	# format paramstring
	$this->joinstr(' ');

	$this->joinseperator(', ');	# what is the seperator between elements

	$this->hash_keyprintf('%s');	# do we should quote the keys ?
	$this->hash_valueprintf("'%s'");	# do we should quote the values ?
	$this->hash_assigner(' => ');	# string between key => value pairs

	$this->array_valueprintf('%s');	# do we should quote the values ?

	$this->replace( 0 );
}

sub _postinit
{
	my $this = shift;

	if( $this->pre )
	{
		$this->token_printf( $this->pre.$this->token_printf );	# format tokenstring
	}

	if( $this->post )
	{
		$this->param_printf( $this->param_printf.$this->post );	# format tokenstring
	}

	if( $this->replace )
	{
		$this->token('');

		$this->param_printf('%s');
	}

	unless( keys %{ $this->argtypes } )
	{
		$this->argtypes->{SCALAR} = 1;
	}
}

sub scalar_totext
{
	my $this = shift;

return sprintf( $this->param_printf, ref($this->parameter) ? ${$this->parameter} : $this->parameter );
}

sub array_totext
{
	my $this = shift;

	my @fields=();

	foreach my $field ( @{ $this->parameter } )
	{
		push @fields, sprintf( $this->array_valueprintf, $field );
	}

return sprintf( $this->param_printf, join( $this->joinseperator, @fields ) );
}

sub hash_totext
{
	my $this = shift;

	my @fields=();

	while( my ($key, $value) = each %{$this->parameter} )
	{
		my $field='';

		$field .= sprintf( $this->hash_keyprintf, $key );

		$field .= $this->hash_assigner;

		$field .= sprintf( $this->hash_valueprintf, $value );

		push @fields, $field;
	}

return sprintf( $this->param_printf, join( $this->joinseperator, @fields ) );
}

sub param : method
{
	my $this = shift;

		my $param = shift;

			my $type = ref( $param ) || 'SCALAR';

			unless( $this->testType( $type ) )
			{
				::carp  'Incorrect type ', $type, ', use ', join( ' or ',$this->wantType ), ' instead';
			}

return $this->parameter( $param );
}

sub reset : method
{
	my $this = shift;

		$this->parameter( undef );
return;
}

sub wantType : method
{
	my $this = shift;

		my @allowed = ();

		foreach ( keys %{ $this->argtypes } )
		{
			if( $this->argtypes->{$_} )
			{
				push @allowed, $_;
			}
		}

return @allowed;
}

	# tests wether the given type is allowed and with undef argument returns list of allowed
	# types

sub testType($) : method
{
	my $this = shift;

		my $type = shift;

		if( $this->argtypes->{'ALL'} )
		{
			return 'ALL';
		}

		if( $this->argtypes->{$type} )
		{
			return $type;
		}

return undef;
}

	#
	# translates the element to a sql language element
	#

sub totext : method
{
	my $this = shift;

	my $pre = sprintf( $this->token_printf, $this->token );	# format tokenstring

	if( $pre )
	{
		$pre .= $this->joinstr;
	}

	my $type =  ref( $this->parameter ) || 'SCALAR';

	if( $type eq 'ARRAY' )
	{
		return $pre.$this->array_totext( $this->parameter );
	}
	elsif( $type eq 'HASH' )
	{
		return $pre.$this->hash_totext( $this->parameter );
	}
	else
	{
		return $pre.$this->scalar_totext( $this->parameter );
	}

return undef;
}

package SQL::Generator::Command;

Class::Maker::class
{
	can => [qw( validate )],

	attribute =>
	{
		getset => [qw(id subobject prettyprint)],

		array => [qw(template required)],

		hash => [qw(arguments subobjects defaults)],
	},
};

require 5.005_62;

use strict;

use warnings;

# Preloaded methods go here.

sub _preinit : method
{
	my $this = shift;

		$this->prettyprint( '' );

return;
}

sub _postinit : method
{
	my $this = shift;

			# generate 'Argument' instances for every arg of the template

		foreach my $arg ( @{ $this->template } )
		{
			if( exists $this->arguments->{$arg} )
			{
				$this->arguments->{$arg} = new SQL::Generator::Argument( token => $arg, %{ $this->arguments->{$arg} } );
			}
			else
			{
				$this->arguments->{$arg} = new SQL::Generator::Argument( token => $arg, argtypes => { SCALAR => 1 } );
			}
		}

return;
}

sub validate : method
{
	my $this = shift;

		my $href_args = shift;

			# validate if all required fields are existing

		my @missing = ();

		foreach my $element ( @{ $this->required } )
		{
			if( not exists $href_args->{$element} )
			{
				if( not exists $this->defaults->{$element} )
				{
					push @missing, $element;
				}
			}
		}

		die sprintf( 'Required argument(s) (%s) %s missing (defaults: %s)', join( ', ',@missing ), @missing > 1 ? 'are' : 'is', join( ', ', keys %{ $this->defaults } ) ) if @missing;

return 1;
}

sub totext
{
	my $this = shift;

		my $href_args = shift;

		$this->validate( $href_args );

		my @construct;

		foreach my $element ( @{ $this->template } )
		{
			#$this->debugPrint( sprintf "%s( '%s' %s )\n",$this->id, $element, (exists $href_args->{$element}) ? 'EXISTS' : 'NOT FOUND' );

			# defaults should be use, if value is missing ## ERROR/WARN: ONLY WHEN IT IS A REQUIRED ELEMENT ...see validate !!

			unless( exists $href_args->{$element} )
			{
				if( exists $this->defaults->{$element} )
				{
					$href_args->{$element} = $this->defaults->{$element};
				}
			}

			if( exists $href_args->{$element} )
			{
				if( my $subcmd = $this->subobjects->{$element} )
				{
					$this->arguments->{$element}->param( $subcmd->totext( $href_args ) );
				}
				else
				{
					$this->arguments->{$element}->param( $href_args->{$element} );
				}

				push @construct, sprintf '%s%s', $this->arguments->{$element}->totext(), $this->prettyprint;

				$this->arguments->{$element}->reset();
			}
		}

return join( ' ', @construct);
}

package SQL::Generator;

Class::Maker::class
{
	attribute =>
	{
		getset =>
		[
			qw/command pre post autoprint prettyprint  historysize/,

			qw/table database where/,

			qw/lang langrules file handle/,
		],

		array => [ qw/history/ ],

		hash => [ qw/defaults/ ],
	},
};

use strict;

use IO::File;

use vars qw($AUTOLOAD $VERSION);

use Exporter;

our %EXPORT_TAGS = ( 'all' => [ qw( ) ]  );

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

our @EXPORT = qw( );

# Preloaded methods go here.

sub _preinit
{
	my $this = shift;

	$this->pre( '' );

	$this->post( '' );

	$this->autoprint(0);

	$this->prettyprint(0);

	$this->historysize(100);

	$this->lang( 'MYSQL' );

	$this->file( undef );

	#$this->debugOn;
}

sub close
{
	my $this = shift;

	if( defined $this->handle() )
	{
		$this->handle->close();
	}
}

sub _postinit
{
	my $this = shift;

	$this->change_dialect( $this->lang );

	if( $this->file )
	{
		$this->debugPrint( sprintf "opening file %s as STDOUT", $this->file );

		$this->handle( new IO::File( $this->file ) ) ;

		unless( defined $this->handle() )
		{
			die sprintf "FAILURE: opening file %s as STDOUT", $this->file;
		}
	}
}

sub dialect_path
{
	my $this = shift;

		my $lang = shift || $this->lang;

return 'SQL::Generator::Lang::'.$lang;
}

sub change_dialect
{
	my $this = shift;

		my $lang = shift;

		#die "WE DIE HERE";

		my $dialect = $this->dialect_path($lang);

		eval "require $dialect";

		if( $@ )
		{
			::croak "Couldn't change/load language module '$dialect' :$@";
		}

		# update rules via new CommandList instance: SQL::Generator::Lang::*->new()

		$this->langrules( $dialect->new() );

		die "Failed loading language module" unless $this->langrules;

return $this->lang( $lang );
}

sub DEFAULT : method
{
	my $this = shift;

		my %args = @_;

		$this->defaults( \%args );

#		foreach my $key ( keys %{ $this->defaults } )
#		{
#			print "SETTING DEFAULT: $key => ", $args{$key}, "\n\n";
#		}

return;
}

sub AUTOLOAD
{
	my $func = $AUTOLOAD;

	$func =~ s/.*:://;

	return if $func eq 'DESTROY';

	my $this = shift;

		my %args = @_;

		my $result;

			# only single command per func in this version !!! we take the first one...

		my ( $cmd ) =  $this->langrules->get_where( id => $func );

		if(  defined $cmd )
		{
			$cmd->defaults( \%{ $this->defaults } );

			$result = sprintf '%s %s', $func, $cmd->totext( \%args );

			$result = $this->pre.$result.$this->post;

			if( $result eq 1 )
			{
				die "DONT KNOW WHAT THE HELL HAPPENED";
			}
		}
		else
		{
			warn( "Can't find command for $func in ", $this->dialect_path );
		}

		$this->handle->print($result) if $this->file;

		print $result if $this->autoprint;

		if( $this->history )
		{
			if( @{ $this->history } < $this->historysize )
			{
				push @{ $this->history }, $result;
			}
		}

return $result;
}

sub dump_history
{
	my $this = shift;

	my $pre = shift;

	my $post = shift;

		foreach ( @{ $this->history } )
		{
			print $pre || '', $_, $post || '';
		}

		@{ $this->history } = [];
}

1;

__END__