DBIx-JCL
view release on metacpan or search on metacpan
lib/DBIx/JCL.pm view on Meta::CPAN
"dj" => \$opt_disp_jobs,
"dja" => \$opt_disp_active_jobs,
"se=s" => \$opt_send_email,
"sp=s" => \$opt_send_pager,
"um" => \$opt_util_move,
"h" => \$opt_help,
"ha" => \$opt_help_args,
) || _sys_help(0);
if ( $opt_connection ) {
foreach my $connectdef ( split m/,/, $opt_connection ) {
my ($db, $inst) = split m/:/, $connectdef;
_check_array_val( $db, \@databases )
|| sys_die( "Invalid database: [$db]", 0 );
_check_array_val( $inst, [split m/,/, $dbinst{$db}] )
|| sys_die( "Invalid database instance: [$db.$inst]", 0 );
## update default connection data
$dbdefenvr{$db} = $inst;
}
}
# create dbitrace file if not found
if ( ! -e $dbitrace_filefull ) {
open my $fh, ">", $dbitrace_filefull
|| sys_die( 'Unable to open dbitrace file', 0 );
lib/DBIx/JCL.pm view on Meta::CPAN
my ($pseudo, %hash);
if ( $conf_job{$section}{$entry} ) {
$pseudo = $conf_job{$section}{$entry};
} else {
sys_die( "No job conf entry found for $entry in section $section" );
}
## construct a real hash from the pseudo hash
foreach my $item ( split "\n", $pseudo ) {
my ($key, $value) = split m/$delim/, $item;
$hash{$key} = $value;
}
return \%hash; ## ref to hash
}
sub sys_get_array {
=begin wiki
!3 sys_get_array
lib/DBIx/JCL.pm view on Meta::CPAN
Parameters: ( p1, p2, p3 )
Please write this documentation.
Returns:
=cut
my $target_opt = shift;
foreach my $option ( @ARGV ) {
my ($opt,$val) = split m/=/, $option;
$opt =~ s/^-\s*//x;
$opt =~ s/\s+$//x;
if ( $opt =~ m/^$target_opt$/ix ) {
return 1;
}
}
return 0;
}
sub sys_get_commandline_val {
lib/DBIx/JCL.pm view on Meta::CPAN
Returns:
=cut
my ($target_opt,$default_value) = @_;
## handle:
## >script.pl -r -- -batchsize=10
foreach my $option ( @ARGV ) {
$option =~ s/\s+=/=/x;
$option =~ s/=\s+/=/x;
my ($opt,$val) = split m/=/, $option;
$opt =~ s/^-\s*//x;
$opt =~ s/\s+$//x;
if ( $opt =~ m/^$target_opt$/ix ) {
#$val =~ s/^\s*//;
#$val =~ s/\s*$//;
return $val;
}
}
return $default_value;
}
lib/DBIx/JCL.pm view on Meta::CPAN
## time increment is secs, action is either 'run' or 'fail'
my $dependent_jobname = $connect_params{dependent_jobname} || '';
my $wait_duration = $connect_params{wait_duration} || 60;
my $wait_max_secs = $connect_params{wait_max_secs} || 60*60;
my $wait_action = $connect_params{wait_action} || 'fail';
my $retry_duration = $connect_params{retry_duration} || 0;
my $retry_max_secs = $connect_params{retry_max_secs} || 0;
if ( $vdn =~ m/:/x ) { ## vdn contains instance definiton
my ($db, $inst) = split m/:/, $vdn;
_check_array_val( $db, \@databases )
|| sys_die( "Invalid database: [$db]", 0 );
_check_array_val( $inst, [split m/,/, $dbinst{$db}] )
|| sys_die( "Invalid database instance: [$db.$inst]", 0 );
$dbdefenvr{$db} = $inst; ## update default connection data
$vdn = $db; ## vdn gets true vdn
}
## check for dependent job
_db_connect_check_dependent(
$dependent_jobname, $wait_duration, $wait_max_secs, $wait_action
);
lib/DBIx/JCL.pm view on Meta::CPAN
database processing. This function stores the resulting statement handle for \
subsequent access under the via the virtual database name.
Returns:
=cut
my ($vdn, $sql, $longrlen) = @_;
$longrlen = 0 unless $longrlen;
my $sth_name = 'sth_default'; ## default statement handle name
if ( $vdn =~ m/\./x ) {
($vdn, $sth_name) = split m/\./x, $vdn;
if ( $sth_name eq 'sth_default' ) {
sys_die( 'Invalid statement handle name', 0 );
}
}
my ($dbh, $sth) = _db_vdn('prepare', $vdn);
if ( $longrlen > 0 ) { $dbh->{LongReadLen} = $longrlen; }
$sth = $dbh->prepare( $sql )
lib/DBIx/JCL.pm view on Meta::CPAN
Parameters: ( p1, p2, p3 )
Please write this documentation.
Returns:
=cut
my $vdn = shift;
my $sth_name = 'sth_default'; ## default statement handle name
if ( $vdn =~ m/\./x ) {
($vdn, $sth_name) = split m/\./x, $vdn;
}
return $dbhandles{$vdn}{$sth_name};
}
sub db_get_defenvr {
=begin wiki
!3 db_get_defenvr
Parameters: ( p1, p2, p3 )
lib/DBIx/JCL.pm view on Meta::CPAN
# 0 = success
# errors handled internally
#
my ($vdn,@colrefs) = @_;
my $sth;
if ( ref $vdn ) {
$sth = $vdn; ## received a raw sth
} else {
my $sth_name = 'sth_default'; ## default statement handle name
if ( $vdn =~ m/\./x ) { ## dot notation vdn.sthn
($vdn, $sth_name) = split m/\./x, $vdn;
}
$sth = $dbhandles{$vdn}{$sth_name};
}
foreach my $colref ( @colrefs ) {
if ( ! ref $colref ) { sys_die( "Received bad ref in db_bindcols" ); }
}
$sth->bind_columns( @colrefs );
return 0;
}
lib/DBIx/JCL.pm view on Meta::CPAN
# returns:
# reference to an array
#
my $vdn = shift;
my $sth;
if ( ref $vdn ) {
$sth = $vdn; ## received a raw sth
} else {
my $sth_name = 'sth_default'; ## default statement handle name
if ( $vdn =~ m/\./x ) {
($vdn, $sth_name) = split m/\./x, $vdn;
}
$sth = $dbhandles{$vdn}{$sth_name};
}
return $sth->fetchrow_arrayref();
}
sub db_commit {
=begin wiki
!3 db_commit
lib/DBIx/JCL.pm view on Meta::CPAN
}
## prepare range limit query
my $query = sys_get_sql( $query_name );
db_prepare( $vdn, $query );
log_info( "$lead Status [Test] Expected/Actual/Threshold(%)/Threshold(#)" );
## perform checkpoint tests
foreach my $chkpt ( split "\n", $checkpoints ) {
my ($param,$rest) = split m/=/, $chkpt;
my ($exp,$range) = split m/:/, $rest;
$param = _trim($param); ## col to check
$exp = _trim($exp); ## expected value
$range = _trim($range); ## range/tolerance
db_execute( $vdn, $param );
my $row = db_fetchrow( $vdn );
my $act = @{$row}[0]; ## actual value
my $dev = int $exp * ( $range / 100 ); ## deviation as a percent
my $status = "[$param] $exp/$act/$range/$dev ";
lib/DBIx/JCL.pm view on Meta::CPAN
$log_console_levels = $conf_log{'log'}{'console_levels'} || "FATAL,ERROR,WARN,INFO";
$log_gdg = $conf_log{'log'}{'gdg'} || 5;
$path_plugin_dir = $conf_system{"$OSNAME directory plugin"}{$dataenvr};
if ( $osuser ) {
$dbitrace_file = $dbitrace_base . '_' . $osuser . $log_ext;
}
$dbitrace_filefull = $path_log_dir.$dbitrace_file;
## load data structures
@databases = split m/,/, $conf_data{'databases'}{'databases'};
@dat_envrs = split m/,/, $conf_system{'system'}{'dat_envrs'};
@job_acros = split m/,/, $conf_system{'system'}{'job_acros'};
foreach my $db ( @databases ) {
$dbname{$db} = $conf_data{'names'}{$db};
}
foreach my $db ( @databases ) {
$dbdefenvr{$db} = $conf_data{'default '.$dataenvr}{$db};
}
foreach my $db ( @databases ) {
$dbhandles{$db}{'dbh'} = 0;
$dbhandles{$db}{'sth'} = 0;
}
foreach my $db ( @databases ) {
$dbinst{$db} = $conf_data{'instances'}{$db};
}
foreach my $db ( @databases ) {
foreach my $inst ( split m/,/, $conf_data{'instances'}{$db} ) {
$dbconn{$db}{$inst}{'netservice'} = $conf_data{"$db $inst"}{'netservice'};
$dbconn{$db}{$inst}{'database' } = $conf_data{"$db $inst"}{'database'};
$dbconn{$db}{$inst}{'username' } = $conf_data{"$db $inst"}{'username'};
$dbconn{$db}{$inst}{'password' } = $conf_data{"$db $inst"}{'password'};
}
}
return 0;
}
lib/DBIx/JCL.pm view on Meta::CPAN
Parameters: ( p1, p2, p3 )
Please write this documentation.
Returns:
=cut
my $connections = shift;
## open dbi trace file
DBI->trace(1, $dbitrace_filefull );
foreach my $connectdef ( split m/,/, $connections ) {
my ($db, $inst) = split m/:/, $connectdef;
_check_array_val( $db, \@databases )
|| sys_die( "Invalid database: [$db]", 0 );
_check_array_val( $inst, [split m/,/, $dbinst{$db}] )
|| sys_die( "Invalid database instance: [$db.$inst]", 0 );
my $database = $dbconn{$db}{$inst}{'database'};
my $username = $dbconn{$db}{$inst}{'username'};
my $password = $dbconn{$db}{$inst}{'password'};
print "Connecting to: $db/$inst\n";
my $dbh = DBI->connect( $database, $username, $password, { RaiseError => 0, AutoCommit => 0 } )
or sys_die( DBI->errstr, 0 );
## push resulting handle onto handle stack for cleanup on exit
$dbhandles{$db}{'dbh'} = $dbh;
print "Success\n\n";
lib/DBIx/JCL.pm view on Meta::CPAN
Please write this documentation.
Returns:
=cut
my $lvls_str = shift;
## levls_str can be either a single value or a comma delimited list
if ( $lvls_str =~ /,/ ) {
## received a list of severity levels
my @loglvls = split m/,/, $lvls_str;
foreach my $level ( @loglvls ) {
if ( $level !~ /FATAL|ERROR|WARN|INFO|DEBUG|NONE/ ) {
sys_die( 'Invalid logging/notification severity list', 0 );
}
}
return $lvls_str;
} else {
## received a single severity level to be translated to a list
if ( $lvls_str =~ /^FATAL$/i ) {
$lvls_str = 'FATAL';
lib/DBIx/JCL.pm view on Meta::CPAN
!3 _sys_send_email_message
Parameters: ( p1, p2, p3 )
Please write this documentation.
Returns:
=cut
my $params = shift;
my ($addrlist, $message) = split m/~/, $params;
$mail_emailto = $addrlist;
_log_send_mail($message, 'MESSAGE');
exit 0;
}
sub _sys_send_pager_message {
=begin wiki
!3 _sys_send_pager_message
Parameters: ( p1, p2, p3 )
Please write this documentation.
Returns:
=cut
my $params = shift;
my ($addrlist, $message) = split m/~/, $params;
$mail_pagerto = $addrlist;
_log_send_page($message, 'MESSAGE');
exit 0;
}
sub _sys_help {
=begin wiki
!3 _sys_help
lib/DBIx/JCL.pm view on Meta::CPAN
text started life as an array of lines retrieved from dbms_output_get(), \
and each of these lines had leading whitespace to make them more readable \
in the log file.
Returns:
=cut
my $msg = shift;
my $trimmed = '';
if ( $msg =~ /\n/ms ) { ## trim leading spaces from multi-line messages
foreach my $m ( split m/\n/, $msg ) {
$m =~ s/^\s+//;
$trimmed .= $m."\n";
}
$trimmed =~ s/\n$//ms;
} else {
$trimmed = $msg;
}
return $trimmed;
}
lib/DBIx/JCL.pm view on Meta::CPAN
my $sth_name = 'sth_default'; ## default statement handle name
## does vdn contains explicit statement handle?
if ( $vdn =~ /\./ ) {
($vdn, $sth_name) = split /\./, $vdn;
}
my ($this_db, $this_inst);
if ( $vdn =~ m/:/x ) { ## does vdn contain explicit instance?
($this_db, $this_inst) = split m/:/, $vdn;
} else {
$this_db = $vdn;
$this_inst = $dbdefenvr{$vdn};
}
if ( ! $dbname{$this_db} ) {
sys_die( "Virtual database name [$vdn] is invalid" );
}
## special return values if caller is 'connect'
lib/DBIx/JCL.pm view on Meta::CPAN
connection string is returned from sys_data.conf for the provided instance.
Returns:
=cut
my ($vdni) = shift;
my $netservice = '';
if ( $vdni =~ m/:/x ) { ## vdn contains instance definiton
my ($db, $inst) = split m/:/, $vdni;
_check_array_val( $db, \@databases )
|| sys_die( "Invalid database: [$db]", 0 );
_check_array_val( $inst, [split m/,/, $dbinst{$db}] )
|| sys_die( "Invalid database instance: [$db.$inst]", 0 );
$netservice = $dbconn{$db}{$inst}{netservice};
}
return $netservice;
}
sub _db_proc_build_sql {
=begin wiki
lib/DBIx/JCL.pm view on Meta::CPAN
## disconnect any open database handles
foreach my $vdn ( keys %dbhandles ) {
my $dbh = $dbhandles{$vdn}{'dbh'};
my $sth = $dbhandles{$vdn}{'sth'};
if ( defined $sth && $sth ) { $sth->finish; }
if ( defined $dbh && $dbh ) { $dbh->disconnect; }
}
## call plugin end functions
while ( my $pluginf = pop @plugins ) {
my ($pp, $pf, $pff) = split m/~/, $pluginf;
$pp->end();
}
## send completion notifications
unless ( defined $jobname ) { $jobname = '?'; }
my $msg = "Job $jobname ($script_file) has completed ($errorlevel).";
if ( $opt_notify_email_oncomp ) {
_log_send_mail($msg, 'MESSAGE' );
}
if ( $opt_notify_pager_oncomp ) {
( run in 0.733 second using v1.01-cache-2.11-cpan-71847e10f99 )