view release on metacpan or  search on metacpan

lib/App/Framework/Feature/Sql.pm  view on Meta::CPAN

package App::Framework::Feature::Sql ;

=head1 NAME

Sql - MySql interface

=head1 SYNOPSIS

  use App::Framework '+Sql' ;


=head1 DESCRIPTION

Provides a simplified interface to MySQL via DBI.

B<DOCUMENTATION TO BE COMPLETED>

=cut

use strict ;

our $VERSION = "2.016" ;

#============================================================================================
# USES
#============================================================================================
use App::Framework::Feature ;



#============================================================================================
# OBJECT HIERARCHY
#============================================================================================
our @ISA = qw(App::Framework::Feature) ; 

#============================================================================================
# GLOBALS
#============================================================================================

=head2 FIELDS

The following fields should be defined either in the call to 'new()', as part of a 'set()' call, or called by their accessor method
(which is the same name as the field):


=over 4

=item B<host> - MySql host [default=localhost]


=item B<database> - Database name (required)

=item B<table> - Table name

=item B<user> - User name

=item B<password> - Password

=item B<trace> - Sql debug trace level [default=0]

=item B<trace_file> - If specified, output trace information to file (default=STDOUT)

=item B<sql_vars> - Default HASH used to store 'prepare' values

=item B<prepare> - Create one or more queries


=back

=cut

my %FIELDS = (
	# Object Data
	'dbh'			=> undef,
	'host'			=> 'localhost',
	'database'		=> undef,
	'table'			=> undef,
	'user'			=> undef,
	'password'		=> undef,
	'trace'			=> 0,
	'trace_file'	=> undef,
	
	'prepare'		=> undef,		# Special 'parameter' used to create STHs 
	'sql_vars'		=> {},
	
	'_sth'			=> {},
) ;

# ensure these fields are set before starting to process the 'prepare' values
my @PRIORITY_FIELDS = qw/database user password table sql_vars/ ;

# Default STH
my $DEFAULT_STH_NAME = "_current" ;

#* DELETE
#
#DELETE [LOW_PRIORITY] [QUICK] [IGNORE] 
#	FROM tbl_name
#    [WHERE where_condition]
#    [ORDER BY ...]
#    [LIMIT row_count]
#
#"DELETE FROM `$table` WHERE `pid`=? AND `channel`=? LIMIT 1;"
#
#
#* INSERT / REPLACE
#
#INSERT [LOW_PRIORITY | DELAYED | HIGH_PRIORITY] [IGNORE]
#    [INTO] tbl_name [(col_name,...)]
#    VALUES ({expr | DEFAULT},...),(...),...
#    [ ON DUPLICATE KEY UPDATE
#      col_name=expr
#        [, col_name=expr] ... ]
#
#"INSERT INTO `$table` ( `pid`, `channel`, `title`, `date`, `start`, `duration`, `episode`, `num_episodes`, `repeat`, `text` ) ". 
#'VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?);'
#
#Or:
#
#INSERT [LOW_PRIORITY | DELAYED | HIGH_PRIORITY] [IGNORE]
#    [INTO] tbl_name
#    SET col_name={expr | DEFAULT}, ...
#    [ ON DUPLICATE KEY UPDATE
#      col_name=expr
#        [, col_name=expr] ... ]
#
#"INSERT INTO `$table` SET `title`=?, `date`=?, `start`=?, `duration`=?, `text`=?, `episode`=?, `num_episodes`=?, `repeat`=? "
#
#
#
#* SELECT
#
#SELECT
#    [ALL | DISTINCT | DISTINCTROW ]
#      [HIGH_PRIORITY]
#      [STRAIGHT_JOIN]
#      [SQL_SMALL_RESULT] [SQL_BIG_RESULT] [SQL_BUFFER_RESULT]
#      [SQL_CACHE | SQL_NO_CACHE] [SQL_CALC_FOUND_ROWS]
#    select_expr, ...
#    [FROM table_references
#    [WHERE where_condition]
#    [GROUP BY {col_name | expr | position}
#      [ASC | DESC], ... [WITH ROLLUP]]
#    [HAVING where_condition]
#    [ORDER BY {col_name | expr | position}
#      [ASC | DESC], ...]
#    [LIMIT {[offset,] row_count | row_count OFFSET offset}]
#    [PROCEDURE procedure_name(argument_list)]
#    [INTO OUTFILE 'file_name' export_options
#      | INTO DUMPFILE 'file_name'

lib/App/Framework/Feature/Sql.pm  view on Meta::CPAN

=cut

sub trace
{
	my $this = shift ;
	my (@args) = @_ ;

	# Update value
##	my $trace = $this->SUPER::trace(@args) ;
	my $trace = $this->field_access('trace', @args) ;

	if (@args)
	{
		my $dbh = $this->dbh() ;
		my $trace_file = $this->trace_file() ;
		
		# Update trace level
		$this->_set_trace($dbh, $trace, $trace_file) ;
	}
	
	return $trace ;
}

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

=item B<trace_file(@args)>

Change trace file

=cut

sub trace_file
{
	my $this = shift ;
	my (@args) = @_ ;
	
	# Update value
##	my $trace_file = $this->SUPER::trace_file(@args) ;
	my $trace_file = $this->field_access('trace_file', @args) ;
	
	if (@args)
	{
		my $dbh = $this->dbh() ;
		my $trace = $this->trace() ;
		
		# Update trace level
		$this->_set_trace($dbh, $trace, $trace_file) ;	
	}
	
	return $trace_file ;
}




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

=item B<connect(%args)>

Connects to database. Either uses pre-set values for user/password/database,
or can use optionally specified args

=cut

sub connect
{
	my $this = shift ;
	my (%args) = @_ ;

	$this->set(%args) ;

	$this->_dbg_prt(["Sql::connect() => ",$this->database(),"\n"]) ;

	$this->throw_fatal("SQL connect error: no database specified") unless $this->database() ;
	$this->throw_fatal("SQL connect error: no host specified") unless $this->host() ;

	my $dbh ;
	eval
	{
		# Disconnect if already connected
		$this->disconnect() ;
		
		# Connect
		$dbh = DBI->connect("DBI:mysql:database=".$this->database().
					";host=".$this->host(),
					$this->user(), $this->password(),
					{'RaiseError' => 1}) or $this->throw_fatal( $DBI::errstr ) ;
		$this->dbh($dbh) ;
		
	};
	if ($@)
	{
		$this->throw_fatal("SQL connect error: $@", 1000) ;
	}
	
	my $dbh_dbg = $dbh || "" ;
	$this->_dbg_prt([" + connected dbh=$dbh_dbg : db=",$this->database()," user=",$this->user()," pass=",$this->password(),"\n"]) ;
	
	return $dbh ;
}

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

=item B<disconnect()>

Disconnect from database (if connected)

=cut

sub disconnect
{
	my $this = shift ;

	my $dbh = $this->dbh() ;

	my $dbh_dbg = $dbh || "" ;
	$this->_dbg_prt(["Sql::disconnect() => dbh=$dbh_dbg\n"]) ;

	eval
	{
		if ($dbh)
		{
			$this->dbh(0) ;
		}
	};
	if ($@)
	{
		$this->throw_fatal("SQL disconnect error: $@", 1000) ;
	}

	$this->_dbg_prt([" + disconnected\n"]) ;
}


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

=item B<sth_create($name, $spec)>

Prepare a named SQL query & store it for later execution by query_sth()

Name is saved as $name. Certain names are 'special':

 ins*	- Create an 'insert' type command
 upd*	- Create an 'update' type command
 sel*	- Create a 'select' type command
 check* - Create a 'select' type command
 
The $spec is either a SCALAR or HASH ref 

If $spec is a SCALAR then it is in the form of sql. Note, when the query is executed the values
(if required) must be specified.

If $spec is a HASH ref then it can contain the following fields:

	'cmd'	=> Command type: 'insert', 'update', 'select'
	'vars'	=> ARRAY ref list of variable names (used for 'insert', 'update')
	'vals'	=> Provides values to be used in the query (no extra values need to be specified). HASH ref or ARRAY ref.