view release on metacpan or  search on metacpan

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

			'prefix'	=> 'UPDATE `$sqlvar_table`',
			'format'	=> 'UPDATE `$sqlvar_table` SET $sqlvar_update_setlist $sqlvar_where $sqlvar_order $sqlvar_limit',
			'vals'		=> '@sqlvar_update_vals,@sqlvar_where_vals,@sqlvar_order_vals',
	},
	
	## Command options
	'where'			=> {
			'prefix'	=> 'WHERE',
			'format'	=> 'WHERE $sqlvar_where_andlist',
	},

	'order'			=> {
			'prefix'	=> 'ORDER BY',
			'format'	=> 'ORDER BY $sqlvar_order_varlist $sqlvar_asc',
	},

	'group'			=> {
			'prefix'	=> 'GROUP BY',
			'format'	=> 'GROUP BY $sqlvar_group_varlist $sqlvar_asc',
	},

	'limit'			=> {
			'prefix'	=> 'LIMIT',
			'format'	=> 'LIMIT $limit',
	},

) ;


#============================================================================================

=head2 CONSTRUCTOR

=over 4

=cut

#============================================================================================

=item B<new([%args])>

Create a new Sql object.

The %args are specified as they would be in the B<set> method, for example:

	'mmap_handler' => $mmap_handler

The full list of possible arguments are :

	'fields'	=> Either ARRAY list of valid field names, or HASH of field names with default values 

=cut

sub new
{
	my ($obj, %args) = @_ ;
	
	my $class = ref($obj) || $obj ;

	# Create object
	my $this = $class->SUPER::new(%args,
		'requires' => [qw/DBI DBD::mysql/],
	) ;

	## Postpone connection until we actually need it

	return($this) ;
}



#============================================================================================

=back

=head2 CLASS METHODS

=over 4

=cut

#============================================================================================

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

=item B<init_class([%args])>

Initialises the Sql object class variables.

=cut

sub init_class
{
	my $class = shift ;
	my (%args) = @_ ;

	# Add extra fields
	$class->add_fields(\%FIELDS, \%args) ;

	# init class
	$class->SUPER::init_class(%args) ;

}

#============================================================================================

=back

=head2 OBJECT DATA METHODS

=over 4

=cut

#============================================================================================

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

=item B<set(%args)>

Set one or more settable parameter.

The %args are specified as a hash, for example

	set('mmap_handler' => $mmap_handler)

Sets field values. Field values are expressed as part of the HASH (i.e. normal
field => value pairs).

=cut

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

	# ensure priority args are handled first
	my %priority ;
	foreach my $arg (@PRIORITY_FIELDS)
	{
		my $val = delete $args{$arg} ;
		$priority{$arg} = $val if $val ; 
	}
	if (keys %priority)
	{
		$this->SUPER::set(%priority) ;

		# Connect if we can
		if ($this->database && $this->host)
		{
			$this->connect() ;		
		}
	}
	
	# handle the rest
	$this->SUPER::set(%args) if keys %args ;

}

#============================================================================================

=back

=head2 OBJECT METHODS

=over 4

=cut

#============================================================================================

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

=item B< sql([%args]) >

Returns the sql object. If %args are specified they are used to set the L</FIELDS>

=cut

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

	$this->set(%args) if %args ;
	return $this ;
}

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

=item B< Sql([%args]) >

Alias to L</sql>

=cut

*Sql = \&sql ;




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

=item B<prepare($prepare_href)>

Use HASH ref to create 1 or more STHs

=cut

sub prepare
{
	my $this = shift ;
	my ($prepare_href) = @_ ;
	
	if (ref($prepare_href) eq 'HASH')
	{
		foreach my $name (keys %$prepare_href)
		{
			# Just create each one
			$this->sth_create($name, $prepare_href->{$name});
		}
	}

	return undef ;
}

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

=item B<trace(@args)>

Change trace level

=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"]) ;