App-Framework
12 results

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN 

	# is unreliable on some platforms and requires write permissions)
	# for now we should catch this and refuse to run.
	if ( -f $0 ) {
		my $s = (stat($0))[9];

		# If the modification time is only slightly in the future,
		# sleep briefly to remove the problem.
		my $a = $s - time;
		if ( $a > 0 and $a < 5 ) { sleep 5 }

		# Too far in the future, throw an error.
		my $t = time;
		if ( $s > $t ) { die <<"END_DIE" }

Your installer $0 has a modification time in the future ($s > $t).

This is known to create infinite loops in make.

Please correct this, then run $0 again.

END_DIE

lib/App/Framework/Base.pm  view on Meta::CPAN 

		}
	}
	$this->requires_ok($ok) ;
	$this->loaded(\%loaded) ;

	## First check that all required modules loaded correcly
	if (!$this->requires_ok)
	{
		my $loaded_href = $class->loaded ;
		my $failed_modules = join ', ', grep {$loaded_href->{$_}} keys %$loaded_href ;
		$this->throw_fatal("Failed to load: $failed_modules") ;	
	}

print "App::Framework::Base->new() - END\n" if $class_debug ;

	return($this) ;
}



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

lib/App/Framework/Base/Object.pm  view on Meta::CPAN 

=cut

sub field_access
{
	my $this = shift ;
	my ($field, $value) = @_ ;

	my $class = ref($this) || $this ;
	my %field_list = ();
	%field_list = %{ $FIELD_LIST{$class} } if exists($FIELD_LIST{$class}) ;
	$this->throw_fatal("Attempting to access an invalid field \"$field\" for this object class \"$class\" ") unless (exists($field_list{$field})) ;

	$this->{$field} = $value if defined($value) ;
	return $this->{$field} ;
}





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

lib/App/Framework/Base/Object/ErrorHandle.pm  view on Meta::CPAN 


App::Framework::Base::Object::ErrorHandle - Adds error handling to basic object

=head1 SYNOPSIS

use App::Framework::Base::Object::ErrorHandle ;


=head1 DESCRIPTION

Any object derived from this class can throw an error and some registered error handler will catch (and handle) that error.

Hierarchy of catch handlers is:

	catch_fn set for this object instance
	any registered global catch function (last registered first)
	default handler
	
Global catch functions, when registered, are added to a stack so that the last one registered is called first.

Each handler must return either 1=handled, or 0=not handled to tell this object whether to move on to the next handler.

lib/App/Framework/Base/Object/ErrorHandle.pm  view on Meta::CPAN 

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

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

my %FIELDS = (
	'errors'	=> [],		# List of errors for this object
	'catch_fn'	=> undef,	# Function called if error is thrown
) ;

# Keep track of all errors
my @all_errors = () ;

# Error type priority
my %ERR_TYPES = (
	'fatal'		=> 0x80,
	'nonfatal'	=> 0x40,
	'warning'	=> 0x08,

lib/App/Framework/Base/Object/ErrorHandle.pm  view on Meta::CPAN 

}


#============================================================================================
# OBJECT METHODS 
#============================================================================================


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

=item B<_throw_error($error)>

Add a new error to this object instance, also adds the error to this Class list
keeping track of all runtime errors

=cut

sub _throw_error
{
	my $this = shift ;
	my ($error) = @_ ;
	
	# Add to this object's list
	push @{$this->errors()}, $error ;

	# Add to global list
	$this->_global_error($error) ;

lib/App/Framework/Base/Object/ErrorHandle.pm  view on Meta::CPAN 

	if (!$handled)
	{
		my ($msg, $exitcode) = $this->error_split($error) ;
		die "Unhandled Error: $msg ($exitcode)\n" ;
	}

}

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

=item B<rethrow_error($error_ref)>

Throws an error for this object based on an error object associated with a different object
 
=cut

sub rethrow_error
{
	my $this = shift ;
	my ($error) = @_ ;
	
	# Create copy of error
	my %err_copy = () ;
	foreach (keys %$error)
	{
		$err_copy{$_} = $error->{$_} ;
	}
	$err_copy{'parent'} = $this ;
	
	$this->_throw_error(\%err_copy) ;
	
}


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

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

Add a new error to this object instance, also adds the error to this Class list
keeping track of all runtime errors

%args hash contains:

	* type = fatal, nonfatal, warning, note
	* message = text message
	* errorcode = integer error code value

=cut

sub throw_error
{
	my $this = shift ;
	my (%args) = @_ ;
	
	# Convert args into an error
	my $error = _create_error('parent'=>$this, %args) ;

	$this->_throw_error($error) ;
	
}

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

=item B<throw_fatal($message, [$errorcode])>

Add a new error (type=fatal) to this object instance, also adds the error to this Class list
keeping track of all runtime errors

=cut

sub throw_fatal
{
	my $this = shift ;
	my ($message, $errorcode) = @_ ;
	
	# Convert args into an error
	$this->throw_error('type'=>'fatal', 'message'=>$message, 'errorcode'=>$errorcode) ;
	
}


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

=item B<throw_nonfatal($message, [$errorcode])>

Add a new error (type=nonfatal) to this object instance, also adds the error to this Class list
keeping track of all runtime errors

=cut

sub throw_nonfatal
{
	my $this = shift ;
	my ($message, $errorcode) = @_ ;
	
	# Convert args into an error
	$this->throw_error('type'=>'nonfatal', 'message'=>$message, 'errorcode'=>$errorcode) ;
	
}

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

=item B<throw_warning($message, [$errorcode])>

Add a new error (type=warning) to this object instance, also adds the error to this Class list
keeping track of all runtime errors

=cut

sub throw_warning
{
	my $this = shift ;
	my ($message, $errorcode) = @_ ;
	
	# Convert args into an error
	$this->throw_error('type'=>'warning', 'message'=>$message, 'errorcode'=>$errorcode) ;
	
}

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

=item B<throw_note($message, [$errorcode])>

Add a new error (type=note) to this object instance, also adds the error to this Class list
keeping track of all runtime errors

=cut

sub throw_note
{
	my $this = shift ;
	my ($message, $errorcode) = @_ ;
	
	# Convert args into an error
	$this->throw_error('type'=>'note', 'message'=>$message, 'errorcode'=>$errorcode) ;
	
}



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

=item B<last_error()>

Returns a hash containing the information from the last (worst case) error stored for this object

lib/App/Framework/Core.pm  view on Meta::CPAN 

	my $features_href = $this->_feature_list() ;
	$name = lc $name ;
	
	my $info_href ;
	if (exists($features_href->{$name}))
	{
		$info_href = $features_href->{$name} ;
	}	
	else
	{
		$this->throw_fatal("Feature \"$name\" not found") ;
	}

	return $info_href ;	
}

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

=item B<feature_installed($name)>

Return named feature object if the feature is installed; otherwise returns undef.

lib/App/Framework/Extension/Filter.pm  view on Meta::CPAN 

	
	# Get command line arguments
	my @args = @{ $args_href->{'file'} || [] } ;
	my @args_fh = @{ $args_href->{'file_fh'} || [] } ;

	## check for in-place editing on STDIN
	if ($opts_href->{inplace})
	{
		if ( (scalar(@args) == 1) && ($args_fh[0] == \*STDIN) )
		{
			$this->throw_fatal("Cannot do in-place editing of standard input") ;
		}
	}

	$this->_dispatch_entry_features(@_) ;

#$this->debug(2) ;

$this->_dbg_prt(["#!# Hello, Ive started filter_run()...\n"]) ;

	## Update from options

lib/App/Framework/Extension/Filter.pm  view on Meta::CPAN 

		{
			# In place editing - make sure flag is set
			$this->inplace(1) ;

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

#		else
#		{
			## Open output
			open my $outfh, ">$outfile" or $this->throw_fatal("Unable to write \"$outfile\" : $!") ;
			$this->out_fh($outfh) ;

$this->_dbg_prt([" + opened $outfile fh=$outfh\n"]) ;
			
			$state_href->{outfile} = $outfile ;
#		}
		
	}
	else
	{

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


		my ($arg_spec, $summary, $description, $default_val) = @$arg_entry_aref ;
		
		## Process the arg spec
		my ($name, $pod_spec, $dest_type, $arg_type, $arg_direction, $arg_optional, $arg_append, $arg_mode) ;
		($name, $arg_spec, $pod_spec, $dest_type, $arg_type, $arg_direction, $arg_optional, $arg_append, $arg_mode) =
			$this->_process_arg_spec($arg_spec) ;

		if ($last_dest_type)
		{
			$this->throw_fatal("Application definition error: arg $name defined after $last_dest_type defined as array") ;
		}
		$last_dest_type = $name if $dest_type ;
		
		# Set default if required
		$args_href->{$name} = $default_val if (defined($default_val)) ;

		# See if optional
		$arg_optional++ if defined($default_val) ;
		if ($optional && !$arg_optional)
		{
			$this->throw_fatal("Application definition error: arg $name should be optional since previous arg is") ;
		}		
		$optional ||= $arg_optional ;

$this->_dbg_prt(["Args: update() - arg_optional=$arg_optional optional=$optional\n"]) ;
		
		# Create full entry
		my $href = $this->_new_arg_entry($name, $arg_spec, $summary, $description, $default_val, $pod_spec, $arg_type, $arg_direction, $dest_type, $optional, $arg_append, $arg_mode) ;
		$args_names_href->{$name} = $href ;

$this->_dbg_prt(["Arg $name HASH=", $href], 2)   ;

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

{
	my $this = shift ;
	my ($filename) = @_ ;
	my %config ;
	my %sections ;
	my @sections ;
	my $order=1 ;
		
$this->_dbg_prt( ["Config: _process($filename)\n"] ) ;

	open my $fh, "<$filename" or $this->throw_fatal("Feature:Config : unable to read file $filename : $!") ;
	my $line ;
	my %params ;
	my $href = \%config ;
	while (defined($line = <$fh>))
	{
		chomp $line ;

$this->_dbg_prt( [" + <$line>\n"] ) ;
$this->_dbg_prt( ["Params:", \%params] ) ;

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

#
#=cut
#
sub _write
{
	my $this = shift ;
	my ($write_file) = @_ ;
	
$this->_dbg_prt( ["Config: _write($write_file)\n"] ) ;

	open my $fh, ">$write_file" or $this->throw_fatal("Feature:Config : unable to write file $write_file : $!") ;

	## Global options
	my %config = $this->get_raw_hash() ;
	
	# skip config options
	my $skip=0;
	foreach my $opt (@CONFIG_OPTIONS)
	{
		delete $config{$opt} ;
	}

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

	## Log
	my $logfile = $this->logfile ;
	if ($logfile)
	{
		## start if we haven't yet
		if (!$this->_started)
		{
			$this->_start_logging() ;
		}

		open my $fh, ">>$logfile" or $this->throw_fatal("Error: unable to append to logfile \"$logfile\" : $!") ;
		print $fh $tolog ;
		close $fh ;
	}

	## Echo
	if ($this->to_stdout)
	{
		print $tolog ;
	}

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


	my $logfile = $this->logfile() ;
	if ($logfile)
	{
		my $mode = ">" ;
		if ($this->mode eq 'append')
		{
			$mode = ">>" ;
		}
		
		open my $fh, "$mode$logfile" or $this->throw_fatal("Unable to write to logfile \"$logfile\" : $!") ;
		close $fh ;
		
		## set flag
		$this->_started(1) ;
	}
}	
	


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

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

	
	$this->set(%args) ;
	
	my $from = $this->from ;
	my $mail_to = $this->to ;
	my $subject = $this->subject ;
	my $host = $this->host ;
	
	
	## error check
	$this->throw_fatal("Mail: not specified 'from' field") unless $from ;
	$this->throw_fatal("Mail: not specified 'to' field") unless $mail_to ;
	$this->throw_fatal("Mail: not specified 'host' field") unless $host ;

	my @content ;
	if (ref($content) eq 'ARRAY')
	{
		@content = @$content ;
	}
	elsif (!ref($content))
	{
		@content = split /\n/, $content ;
	}

	## For each recipient, need to send a separate mail
	my @to = split /,/, $mail_to ;
	foreach my $to (@to)
	{
		my $smtp = Net::SMTP->new($host); # connect to an SMTP server
		$this->throw_fatal("Mail: unable to connect to '$host'") unless $smtp ;
		
		$smtp->mail($from);     # use the sender's address here
		$smtp->to($to);	# recipient's address
		$smtp->data();      # Start the mail
		
		# Send the header.
		$smtp->datasend("To: $mail_to\n");
		$smtp->datasend("From: $from\n");
		$smtp->datasend("Subject: $subject\n") if $subject ;

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

=item B<timeout> - optional timeout time in secs.

When specified causes the program to be run as a forked child 

=item B<nice> - optional nice level

On operating systems that allow this, runs the external command at the specified "nice" level

=item B<on_error> - what to do when a program fails

When this field is set to something other than 'status' it causes an error to be thrown. The default 'status' 
just returns with the error information stored in the object fields (i.e. 'status', 'results' etc). This field may be set to:

=over 4

=item I<status> - error information returned in fields

=item I<warning> - throw a warning with the message string indicating the error 

=item I<fatal> - [default] throw a fatal error (and abort the script) with the message string indicating the error 

=back

=item B<required> - required programs check

This is a HASH ref where the keys are the names of the required programs. When reading the field, the values 
are set to the path for that program. Where a program is not found then it's path is set to undef.

See L</required> method.

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


=item B<required([$required_href])>

Get/set the required programs list. If specified, B<$required_href> is a HASH ref where the 
keys are the names of the required programs (the values are unimportant).

This method returns the B<$required_href> HASH ref having set the values associated with the
program name keys to the path for that program. Where a program is not found then
it's path is set to undef.

Also, if the L</on_error> field is set to 'warning' or 'fatal' then this method throws a warning
or fatal error if one or more required programs are not found. Sets the message string to indicate 
which programs were not found. 

=cut

sub required
{
	my $this = shift ;
	my ($new_required_href) = @_ ;

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

	my $required_href = $this->field_access('required', $new_required_href) ;
	if ($new_required_href)
	{
		## Test for available executables
		foreach my $exe (keys %$new_required_href)
		{
			$required_href->{$exe} = which($exe) ;
		}
		
		## check for errors
		my $throw = $this->_throw_on_error($this->on_error) ;
		if ($throw)
		{
			my $error = "" ;
			foreach my $exe (keys %$new_required_href)
			{
				if (!$required_href->{$exe})
				{
					$error .= "  $exe\n" ;
				}
			}
			
			if ($error)
			{
				$this->$throw("The following programs are required but not available:\n$error\n") ;
			}
		}
	}
	
	return $required_href ;
}


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

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

	foreach my $key (qw/debug/)
	{
		$set{$key} = $args{$key} if exists($args{$key}) ;
	}
	$this->set(%set) if keys %set ;
	

	# Get command
#	my $cmd = $this->cmd() ;
	my $cmd = $local{'cmd'} ;
	$this->throw_fatal("command not specified") unless $cmd ;
	
	# Add niceness
#	my $nice = $this->nice() ;
	my $nice = $local{'nice'} ;
	if (defined($nice))
	{
		$cmd = "nice -n $nice $cmd" ;
	}

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


	# Update vars
	$this->status($rc) ;
	chomp foreach (@results) ;
	$this->results(\@results) ;

	$logging->logging(\@results) if $logging && ($logopts_href->{all} || $logopts_href->{results}) ;
	$logging->logging("Status: $rc\n") if $logging && ($logopts_href->{all} || $logopts_href->{status}) ;
	
	## Handle non-zero exit status
	my $throw = $this->_throw_on_error($local{'on_error'}) ;
	if ($throw && $rc)
	{
		my $results = join("\n", @results) ;
		my $error_str = $local{'error_str'} ;
		$this->$throw("Command \"$cmd $args\" exited with non-zero error status $rc : \"$error_str\"\n$results\n") ;
	}
	
	return($this) ;
}

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

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

Alias to L</run>

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

#	else
#	{
#		%args = (@args) ;
#	}
#	
#	# Set any specified args
#	$this->set(%args) if %args ;
#
#	# Get command
#	my $cmd = $this->cmd() ;
#	$this->throw_fatal("command not specified") unless $cmd ;
#	
#	# Check arguments
#	my $args = $this->_check_args() ;
#
#	print "$cmd $args\n" ;
#}


# ============================================================================================
# PRIVATE METHODS

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

	my $state_href = {} ;
	my $linenum = 0 ;

	# Run inside eval to catch timeout		
	my $pid ;
	my $rc = 0 ;
	my $endtime = (time + $timeout) ;
	eval 
	{
		alarm($timeout);
		$pid = open my $proc, "$cmd $args |" or $this->throw_fatal("Unable to fork $cmd : $!") ;

		while(<$proc>)
		{
			chomp $_ ;
			push @results, $_ ;

			++$linenum ;

			# if it's defined, call the progress checker for each line
			if (defined($progress))

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

		{
print "timed out - stopping command pid=$pid...\n" if $this->debug ;
			# timed out  - stop command
			kill('INT', $pid) ;
		}
		else
		{
print "unexpected end of program : $@\n" if $this->debug ; 			
			# Failed
			alarm(0) ;
			$this->throw_fatal( "Unexpected error while timing out command \"$cmd $args\": $@" ) ;
		}
	}
	alarm(0) ;

print "exit program\n" if $this->debug ; 

	# if it's defined, call the results checker for each line
	$rc ||= $this->_check_results(\@results, $check_results) ;

	return($rc, @results) ;

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

	if (defined($check_results))
	{
		$rc = &$check_results($results_aref) ;
	}

	return $rc ;
}


#----------------------------------------------------------------------
# If the 'on_error' setting is not 'status' then return the "throw" type
#
sub _throw_on_error
{
	my $this = shift ;
	my ($on_error) = @_ ;
	$on_error ||= $ON_ERROR_DEFAULT ;
	
	my $throw = "";
#	my $on_error = $this->on_error() || $ON_ERROR_DEFAULT ;
	if ($on_error ne 'status')
	{
		$throw = 'throw_fatal' ;
		if ($on_error =~ m/warn/i)
		{
			$throw = 'throw_warning' ;
		}
	}

	return $throw ;
}

# ============================================================================================
# END OF PACKAGE

=back

=head1 DIAGNOSTICS

Setting the debug flag to level 1 prints out (to STDOUT) some debug messages, setting it to level 2 prints out more verbose messages.

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


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 ;
}

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

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


	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)>

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

		my %spec = (%{$spec}) ;
		
		# Set table if specified
		$vars{'sqlvar_table'} = delete $spec{'table'} if (exists($spec{'table'})) ; 

		# see if command specified
		$cmd = delete $spec{'cmd'} if (exists($spec{'cmd'})) ; 
		$cmd = lc $cmd ;

		# error check
		$this->throw_fatal("No valid sql command") unless $cmd ;

		# Process spec - set vars
		$this->_sql_setvars($cmd, \%spec, \%vars) ;
	}
	elsif (!ref($spec))
	{
		# Process spec - set vars
		$this->_sql_setvars($cmd || 'query', $spec, \%vars) ;
	}

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

{
	print "\n------------------------------------\n" ;
	print "PREPARE SQL($name): $sql\n----------\n" ;
	$this->prt_data("Values=", $values_aref) ;
}

#$this->prt_data("Values=", $values_aref, "\n--------------------\nVars=", \%vars) ;

	## Use given/created command sql
	my $dbh = $this->connect() ;
	$this->throw_fatal("No database created", 1) unless $dbh ;
	
	my $sth ;
	eval
	{
		$sth = $dbh->prepare($sql) ;
	};
	$this->throw_fatal("STH prepare error $@\nQuery=$sql", 1) if $@ ;
	
	my $sth_href = $this->_sth() ;
	$sth_href->{$name} = {
		'sth' => $sth,
		'vals' => $values_aref,
		'query' => $sql,		# For debug
	} ;
	
}

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

		$this->_dbg_prt(["Sql::sth_query($query) : args=", \@args, "vals=", \@vals], 2) ;
		
		# execute
		eval
		{
			$sth->execute(@args, @vals) ;
		};
		if ($@)
		{
			my $vals = join(', ', @args, @vals) ;
			$this->throw_fatal("STH \"$name\"execute error $@\nQuery=$query\nValues=$vals", 1) if $@ ;
		}
	}

	return $this ;
}

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

=item B<sth_query_all($name, [@vals])>

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

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

	# Do query
	eval
	{
		$dbh->do($sql) ;
	};
	if ($@)
	{
		$this->throw_fatal("SQL do error $@\nSql=$sql", 1) if $@ ;
	}

	return $this ;
}

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

=item B<do_sql_text($sql_text)>

Process the SQL text, split it into one or more SQL command, then execute each of them

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

Execute the (possible sequence of) command(s) stored in a named __DATA__ area in the application.

=cut

sub sql_from_data
{
	my $this = shift ;
	my ($name) = @_ ;
	
	my $app = $this->app() ;
	$this->throw_error("Unable to find DATA section since not associated with an application") unless $app ;	
	
	# Get named data
	my $sql_text = $app->data($name) ;
	
	if ($sql_text)
	{
		## process the data
		$this->do_sql_text($sql_text) ;
	}
	else
	{
		$this->throw_error("Data section $name contains no SQL") ;	
	}

	return $this ;	
}




# ============================================================================================
# PRIVATE METHODS

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


sub _sth_record
{
	my $this = shift ;
	my ($name) = @_ ;

	# error check
	if (!$name)
	{
		$this->dump_callstack() if $this->debug() ;
		$this->throw_fatal("Attempting to find prepared statement but no name has been specified") unless $name ;				
	}

	my $sth_href = $this->_sth() ;
	if (exists($sth_href->{$name}))
	{
		$sth_href = $sth_href->{$name} ;

		# error check
		$this->throw_fatal("sth $name not created") unless $sth_href ;				

	}
	else
	{
		# error
		$this->throw_fatal("sth $name not created") ;				
	}
		
	return $sth_href ;
}

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

=item B<_sth_record_sth($name)>

Returns the saved sth looked up from $name; returns undef otherwise

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

	my $this = shift ;
	my ($name) = @_ ;

	my $sth ;
	my $sth_href = $this->_sth_record($name) ;
	
	if ($sth_href && exists($sth_href->{'sth'}))
	{
		$sth = $sth_href->{'sth'} ;

		$this->throw_fatal("sth $name not created" ) unless $sth ;				

	}
	else
	{
		$this->throw_fatal("sth $name not created" ) ;				
	}
		
	return $sth ;
}

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

=item B<_set_trace($dbh, $trace, $trace_file)>

Update trace level



( run in 0.292 second using v1.01-cache-2.11-cpan-496ff517765 )