File Coverage

lib/DBIx/JCL.pm

Criterion	Covered	Total	%
statement	67	1999	3.3
branch	4	828	0.4
condition	0	123	0.0
subroutine	21	230	9.1
pod	0	155	0.0
total	92	3335	2.7

##@@JCL.pm,dbixlib
##$$Job Control Library for Data Management Tasks
##author:Brad Adkins
##format:codehtml
##outfile:JCL.html
##title:Job Control Library
##toc:yes
##header:DBIx-JCL

=head1 NAME

DBIx::JCL - Job Control Library for database load tasks.

=head1 SYNOPSIS

    # file: test_job.pl
    use strict;
    use warnings;
    use DBIx::JCL qw( :all );

    my $jobname = 'name_of_job';
    sys_init( $jobname );

    # perform database tasks calling DBIx-JCL functions
    # ...

    sys_end();
    exit sys_get_errorlevel();

=head1 DESCRIPTION

This documentation describes the perl module DBIx-JCL.pm and the use of
standardized perl scripts which together provide a common job execution
environment to support database backend load and maintenance tasks.

=head1 RATIONALE

Provide a suite of standard functions that can be shared across all batch
job scripts used to support database back end tasks. Provide a standardized
approach for the development of all back end database job scripts.
Centralize the administration and access to configuration data. Enforce
coding standards and documentation. Abstract the sql used to support back
end processes from the task processing logic, by placing all sqlinto an sql
library. This will make maintenance of back end sql a trivial task. Provide
generalized logging, notification, and system information functions.

If you want to write a robust database extract and load job with complete
support for logging and error notification, and do it in 25 lines of code,
read on.

=head1 OPTIONS

Database maintenance and load jobs written using DBIx-JCL support the following
options out-of-the-box, with no additional work required on your part.

Job Options:

    | -r   | Run job
    | -rb  | Run job in the background
    | -rs  | Run job at requested start time
    | -rr  | Restart job after failure
    | -rde | Run using specified DE number
    | -x   | Pass extra parameters to job script
    | -c   | Specify database connections
    | -v   | Verbose
    | -vv  | Very Verbose
    | -ng  | No greeting
    | -tc  | Test database connections

Logging Options:

    | -lf  | Log filename
    | -lg  | Log generations
    | -ll  | Log log levels
    | -lp  | Log file prefix
    | -lr  | Log archive file radix
    | -cl  | Log console levels

Notificaiton Options:

    | -ne  | Notify email on completion
    | -np  | Notify pager on completion
    | -et  | Email notification to list
    | -el  | Email notification levels
    | -pt  | Pager notification to list
    | -pl  | Pager notification levels

Information Options:

    | -dp  | Display job parameters
    | -dq  | Display job querys
    | -dd  | Display job documentation
    | -dl  | Display last log file
    | -da  | Display archived log files
    | -dj  | Display a list of job scripts
    | -dja | Diaplay jobs active in the system

Utility Options:

    | -se  | Send email message
    | -sp  | Send pager message
    | -um  | Util no move files
    | -h   | Help
    | -ha  | Help on option arguments

Please see L below.

=head1 CAPABILITIES

The DBIx-JCL modules provides many capabilities commonly needed in support of
database maintenance jobs designed to run in a production environment. Below
is a summary list of features and the types of functions provided to support
those features.

=head2 Features

The following features have been designed in to the DBIx-JCL module:

=over 4

=item * Logging support with log file rotation

=item * Notification support

=item * Simplified DBI interface

=item * Configuration data stored externally

=item * High level functions not available in the DBI

=item * SQL stored in "SQL books"

=item * Job documentation enforced

=item * Job control functions

=item * Plugin support

=back

=head2 Implementation

The features listed above have been implemented by providing [many] functions
for use by your database mantenance jobs:

=over 4

=item * Functions for command line interaction

=item * Functions for initialization, monitoring, and control

=item * Functions for database interaction

=item * Functions for log file access and maintenance

=item * Functions for file manipulation

=back

Please see L below.

=head1 EXAMPLE JOB

Shown below is the standard approach to writing job scripts.

    ##@@name_of_script.pl,bin
    ##$$Description of this job

    use strict;
    use warnings;
    use DBIx::JCL qw( :all );

    # initialize
    # -------------------------------------------------------------------------

    my $jobname = 'name_of_script';
    sys_init( $jobname );

    my $dbenv1 = 'mydb1';
    my $mysql1 = sys_get_sql( 'query_number_1' );

    # main
    # -------------------------------------------------------------------------

    log_info( sys_get_dbdescr( $dbenv1 ) );
    db_connect( $dbenv1 );

    # do more db stuff here

    # end
    # -------------------------------------------------------------------------

    =begin wiki

    !1 NAME

    Name of script

    ----

    !1 DESCRIPTION

    Describe the job script here.

    ----

    !1 RECOVERY NOTES

    Document recovery notes here.

    ----

    !1 DEPENDENCIES

    Document dependencies here.

    =cut

    __END__

Please see L below.

=head1 ADDITIONAL INFORMATION

Please see the documentation embedded in this source file for [LOTS!] of
additional details on how to use JCL.pm. You can view this documentation using
WikiText.pm module to format the WikiText content in this file. Hint: download
and install WikiText.pm.

Thank you!

=head1 COPYRIGHT

Copyright 2008 Brad Adkins .

Permission is granted to copy, distribute and/or modify this document under the
terms of the GNU Free Documentation License, published by the Free Software
Foundation; with no Invariant Sections, with no Front-Cover Texts, and with no
Back-Cover Texts.

=head1 AUTHOR

Brad Adkins, [e-mail]

=cut

=begin wiki

!1 Name

DBIx-JCL - Job Control Library for database load tasks.

----

!1 Description

This documentation describes the perl module DBIx::JCL.pm and the use of \
standardized perl scripts which together provide a common job execution \
environment to support database backend maintenance.

----

!1 Synopsis

 % language=Perl
 % # file: test_job.pl
 % use strict;
 % use warnings;
 % use DBIx::JCL qw( :all );
 %
 % my $jobname = 'name_of_job';
 % sys_init( $jobname );
 %
 % # perform database tasks
 %
 % sys_end();
 % exit sys_get_errorlevel();
 %%

For a file named %test_job.pl% the %$jobname% would normally be simply \
%test_job%.

----

!1 Options

Job Options:

| -r   | Run job|
| -rb  | Run job in the background|
| -rs  | Run job at requested start time|
| -rr  | Restart job after failure|
| -rde | Run using specified DE number|
| -x   | Pass extra parameters to job script|
| -c   | Specify database connections|
| -v   | Verbose|
| -vv  | Very Verbose|
| -ng  | No greeting|
| -tc  | Test database connections|

Logging Options:

| -lf  | Log filename|
| -lg  | Log generations|
| -ll  | Log log levels|
| -lp  | Log file prefix|
| -lr  | Log archive file radix|
| -cl  | Log console levels|

Notificaiton Options:

| -ne  | Notify email on completion|
| -np  | Notify pager on completion|
| -et  | Email notification to list|
| -el  | Email notification levels|
| -pt  | Pager notification to list|
| -pl  | Pager notification levels|

Information Options:

| -dp  | Display job parameters|
| -dq  | Display job querys|
| -dd  | Display job documentation|
| -dl  | Display last log file|
| -da  | Display archived log files|
| -dj  | Display a list of job scripts|
| -dja | Diaplay jobs active in the system|

Utility Options:

| -se  | Send email message|
| -sp  | Send pager message|
| -um  | Util no move files|
| -h   | Help|
| -ha  | Help on option arguments|

----

!1 Arguments

Job Params:

| -r   | (on/off)|
| -rb  | (on/off)|
| -rs  | starttime    Example: 17:30|
| -rr  | jobstep      Example: 3|
| -rde | denumber     Example: 64753|
| -x   | extra params Example: -x="a=1 b=2 c=3"|
| -c   | connectdef   Example: mydb:myinst|
| -v   | (on/off)|
| -vv  | (on/off)|
| -ng  | (on/off)|
| -tc  | connectdef   Example: mydb:myinst|

Logging Params:

| -lf  | filename     Example: mylog.log|
| -lg  | numgdg       Example: 10|
| -ll  | loglevels    Example: FATAL,ERROR,WARN or WARN|
| -lp  | logprefix    Example: pre_|
| -lr  | logradix     Example: 3|
| -cl  | loglevels    Example: FATAL,ERROR,WARN,INFO,DEBUG or DEBUG|

Notificaiton Params:

| -ne  | (on/off)|
| -np  | (on/off)|
| -et  | addrlist       Example: [e-mail],[e-mail]|
| -el  | levels         Example: FATAL,ERROR,WARN|
| -pt  | addrlist       Example: [e-mail],[e-mail]|
| -pl  | levels         Example: FATAL,ERROR,WARN|

Information Params:

| -dp  | (on/off)|
| -dq  | (on/off)|
| -dd  | (on/off)|
| -dl  | (on/off)|
| -da  | (on/off)|
| -dj  | (on/off)|
| -dja | (on/off)|

Utility Params:

| -se  | addrlist:msg   Example: "[e-mail]~Message text"|
| -sp  | addrlist:msg   Example: "[e-mail]~Message text"|
| -um  | (on/off)|
| -h   | (on/off)|
| -ha  | (on/off)|

----

!1 Rationale

Provide a suite of standard functions that can be shared across all batch \
job scripts used to support database back end tasks. Provide a standardized \
approach for the development of all back end database job scripts. \
Centralize the administration and access to configuration data. Enforce \
coding standards and documentation. Abstract the sql used to support back \
end processes from the task processing logic, by placing all sqlinto an sql \
library. This will make maintenance of back end sql a trivial task. Provide \
generalized logging, notification, and system information functions.

If you want to write a robust database extract and load job with complete \
support for logging and error notification, and do it in 25 lines of code, \
read on.

----

!1 Capabilities

Some of the capabilities provided by DBIx-JCL are: System initialization, \
variables for system-wide use, configuration file interface support, \
command line processing support, command line help interface, sql library \
interface, system documentation in pod form, handy information display \
routines, source filtering for quality control, database connection and \
sql processing, log file access and managment, email and pager notification, \
general file access routines, and a generic plugin interface.

----

!1 Configuration And Environment

Configuration is provided using an enhanced version of ini style \
configuration files. The big difference between the conf files used and \
ini files is that the conf files support here document syntax. This makes \
storing sql querys a trivial task. Several configuration files are used, \
these are described individually below.

!2 Environments

DBIx-JCL can support multiple database environments over multiple file \
systems, with attachments to any number of remote databases. An environment \
is actually a combination of file system and database instance. Remote \
databases and local databases can also be specified on the command line. \
The example conf files define the database environments shown in the \
diagram below.

On each local server, the default combination of database/instance is \
identified by an environment variable (shown in square brackets). The name \
of the environment variable is stored in the C file.

 % language=Ini_Files
 % (-------------------------------------+------------------------------------)
 %                 LOCAL                 |               REMOTE
 % (-------------------------------------+------------------------------------)
 %                                       |
 %   .------------.     .------------.   |       .------------.
 %   | Server 1   |--.--| mydb2/dev1 |-->|   .-->| mydb1/frz  |
 %   '------------'  |  `------------'   |   |   '------------'
 %                   |     [mydev1]      |   |
 %                   |                   |   |
 %                   |  .------------.   |   |   .------------.
 %                   |--| mydb2/dev2 |-->|   +-->| mydb1/prd  |
 %                   |  '------------'   |   |   '------------'
 %                   |     [mydev2]      |   |
 %                   |                   |   |
 %                   |  .------------.   |   |   .------------.
 %                   +--| mydb2/int  |-->|   +-->| mydb3/dev  |
 %                      '------------'   |   |   '------------'
 %                         [myint]       |---+
 %                                       |   |
 %   .------------.     .------------.   |   |   .------------.
 %   | Server 2   |-----| mydb2/frz  |-->|   +-->| mydb3/int  |
 %   '------------'     '------------'   |   |   '------------'
 %                         [myfrz]       |   |
 %                                       |   |
 %   .------------.     .------------.   |   |   .------------.
 %   | Server 3   |-----| mydb2/prd  |-->|   +-->| mydb3/sys  |
 %   '------------'     '------------'   |   |   '------------'
 %                         [myprd]       |   |
 %                                       |   |
 %                                       |   |   +------------.
 %                                       |   +-->| mydb3/prd  |
 %                                       |       '------------'
 %    Key                                |
 %   (-----------------------------)     |
 %    dev  - development region          |
 %    dev1 - development region          |
 %    dev2 - development region          |
 %    int  - integration test region     |
 %    frz  - system test region          |
 %    sys  - system test region          |
 %    prd  - production region           |
 %   (-----------------------------)     |
 %                                       |
 % (-------------------------------------+------------------------------------)
 %%

!2 System Configuration

The /system.conf/ stores information about your installation environment. \
The default database environment related to this file system, a list of \
database environments, and a list of valid job acronyms:

 % language=Ini_Files
 % [system]
 %
 % envvar    = mydbenv1
 % dat_envrs = mydbenv1,mydbenv2,mydbenv3,mydbenv4
 % job_acros = load_,extr_,merg_,vend_,job_,util_,test_,temp_
 %%

Following this section are the directory sections, There is one directory \
section for each type of directory used: bin, lib, log, load, extr, and \
plugin. Each directory section is named as using the form \
%[directory ]%. Directory specifications for the the bin \
directory are shown below. For each database environment, you would have \
a directory entry for that particular environment. So for the bin directory, \
the entry would be something like the following:

 % language=Ini_Files
 % [directory bin]
 %
 % mydbenv1 = /home/account/bin/
 % mydbenv2 = /home/account/bin/
 % mydbenv3 = /home/account/bin/
 % mydbenv4 = /home/account/bin/
 %%

The trailing slashes on the directory entries are required.

The last section in the C file is the restart section. This \
stores the last job step attempted. This is set immediately before a job \
is restarted. The example below shows a job restart step of 3.

 % language=Ini_Files
 % [restart]
 %
 % restart=3
 %%

!2 Job Configuration

The /job.conf/ file stores information about specific jobs. The key entry \
is the logfile entry. This entry provides a name to use for this job's log \
file. The entry is placed in a section named after the jobname used in the \
script. If your script uses:

 % language=Perl
 % my $jobname = 'job_number_1';
 % sys_init( $jobname );
 %%

Then the job section for that script would be:

 % language=Ini_Files
 %
 % [job_number_1]
 % logfile=epdw_contractor.log
 %%

There are also several optional entries that can be made for a given job. \
These will be permanent overrides for that particular job. All of these are \
also available as command line options.

 % language=Ini_Files
 % logging_levels=
 % gdg=
 % emailto=
 % pagerto=
 % email_levels=
 % pager_levels=
 %%

This gives you the ability to set up logging and notifications differently \
for every job if you want to (probably not a good idea).

!2 Data Configuration

The /data.conf/ file is possibly the most complex file. This file is used \
to map your databases and database instances, both local and remote, and \
provides a default instance for each database.

Here is a sample /data.conf/ file. In the example below, the C<[instances]> \
section maps the available database instances for each database. The default \
sections %[default ]
instance to connect to for each supported database, based on the current \
database environment variable. The last set of sections provide the \
connection parameters for each database/instance combination. (Only one of \
these is shown below.)

Keep in mind when trying to decipher the example below, that database mydb2 \
is in all cases the "local" database (attached to a file system where the \
DBIx-JCL are running. The databases mydb1 and mydb2 are remote databases.

 % language=Ini_Files
 % [databases]
 % databases = mydb1,mydb2,mydb3
 %
 % [names]
 % mydb1 = A Long Name for mydb1
 % mydb2 = A Long Name for mydb2
 % mydb3 = A Long Name for mydb3
 %
 % [instances]
 % mydb1 = prd,frz
 % mydb2 = prd,frz,int,dev1,dev2
 % mydb3 = prd,sys,int,dev
 %
 % [default db2dev1]
 % mydb1 = frz
 % mydb2 = dev1
 % mydb3 = dev
 %
 % [default db2dev2]
 % mydb1 = frz
 % mydb2 = dev2
 % mydb3 = dev
 %
 % default db2int]
 % mydb1 = frz
 % mydb2 = int
 % mydb3 = int
 %
 % [default db2frz]
 % mydb1 = prd
 % mydb2 = frz
 % mydb3 = sys
 %
 % [default db2prd]
 % mydb1 = prd
 % mydb2 = prd
 % mydb3 = prd
 %
 % [mydb2 int]
 % database=dbi:Oracle:db2int
 % username=myaccount
 % password=12345678
 %%

!2 Mail Configuration

The /mail.conf/ file stores settings used when sending email and pager \
notifications. The entries are placed in a section named mail.

 % language=Ini_Files
 % [mail]
 % server=mail.server.com
 % from=[e-mail]
 % emailto=[e-mail],[e-mail]
 % pagerto=[e-mail],[e-mail]
 % email_levels=FATAL,ERROR,WARN
 % pager_levels=FATAL,ERROR
 %%

!2 Log Configuration

The /log.conf/ file contains settings used by the logging functions. The \
settings are placed in a section named log. The gdg entry specifies the \
default number of log archive files that will be maintained. In case you \
are curious, gdg stands for generation data group.

 % language=Ini_Files
 % [log]
 % default_logfile=job.log
 % logging_levels=FATAL,ERROR,WARN,INFO
 % gdg=5
 %%

!2 Query Configuration

The /query.conf/ file contains all the sql used by DBIx-JCL on your \
installations. Each job has its own section in this file. Querys are \
entered using heredoc syntax, which makes it very easy to cut-and-paste \
sql from other sources into this file, and vice-versa. Abstracting your \
sql into a separate file should make your maintenance life much easier. \
It would be a good idea to put this file under configuration management \
control.

!2 Util Configuration

The /util.conf/ file is currently not used. It is anticipated that there \
will be a need for this file in the future.

----

!1 Logging

One of the real strengths of DBIx-JCL is its support for logging. The goal \
is to log all significant events, including DBI errors. You decide what types \
of events are significant by setting the logging levels prior to running your \
script, or on the command line when starting your script.

!2 Writing to the log

You use the log write functions to write data to the log. If the log \
statement is in the list of logging levels to be output for this script, \
the log statement will be written, if the log statement used is lower than \
any of the set logging levels, it will not be written to the log file. An \
example may clarify. Let's say you have set the logging levels to include \
FATAL,ERROR,WARNING. If your job script calls C or C \
functions, they would not write to the log file becuase those log levels \
are not in the list of logging levels to be output. If you want to see you \
log messages on the console while your job is running, use the Verbose \
command line option.

The log write functions are:

|%log_fatal()% |outputs FATAL level messages|
|%log_error()% |outputs ERROR level messages|
|%log_warn()%  |outputs WARN  level messages|
|%log_info()%  |outputs INFO  level messages|
|%log_debug()% |outputs DEBUG level messages|

!2 Using Oracle's DBMS_OUTPUT Package

The functions used here to implement stored procedure calls (DBD::Oracle only) \
will gather dbms output automatically. If any is found, these are sent to \
the current log file using an appropriate logging level. To make your log \
files more readable, you should consider using a a custom package for all \
dbms output generated from stored procedures and functions. I've also found \
that if you preceed your dbms output messages with some white space, they \
will look better when viewed in your log files.

----

!1 Notifications

Another real strength of DBIx-JCL is the built-in support for notifications. \
There are two types of notifications, email notifications and pager \
notifications. One of the nice features of email notifications is that the \
log file is included in the email message following the message text. Pager \
notifications are just short versions of email notifications, pager \
notifications never have the contents of the log file appended.

The pager notifications are really just an email message. Your pager device \
must be able to support messaging via email interface to make use of this \
feature. Most cell phone devices and text pagers have this capability.

The severity of the message is included in the message subject line so you \
can immediately see if you need to respond to the message or not.

The log writing functions are hooked into the notification functions. \
Whenever a log write function is called it checks to see if a notification \
should also be sent based on the email and pager severity levels. These work
the same as described above for logging levels, in fact, the same levels are \
used. Care should be exercised when setting the notifications levels, if you \
set them too low you script could generate a lot of email/pager messages. \
Caveat emptor.

----

!1 Database Interface

This module uses the Perl DBI for all database functionality. However you do \
not have to deal with the raw DBI functions. All DBI access thru this module \
is made via a virtual name that you assign to each database connection used \
by your running job script. The virtual name is resolved using entries in a \
configuration file. Furthermore, all calls to DBI functions just require that \
virtual name. Underneath, the module functions handle storage of database \
handles and statement handles automatically for you. This has two benefits, \
it makes writing database job scripts for the novice much simpler, and it \
makes for cleaner, more readable job scripts.

You probably can't fully appreciation the latter until you are reading a \
job script at 2am, trying to figure out what went wrong with a production \
job. Of course, one of the design goals of this module is to make it so you \
never have to read a script when one of your jobs fails. All the information \
you need to diagnose and fix the problem should be in the most recent log \
file, with previous log history right at your finger tips as well.

----

!1 Script Naming Convention

Scripts which use DBIx-JCL are required to use a script naming convention, \
however, the convention chosen is up to you. All scripts using DBIx-JCL \
should be prefixed with an acronym. For example, if you had a script that \
sent a warning message on some condition, you might name it "util_warn.pl" \
where "util_" is the script prefix acronym. You decide what script prefix \
acronyms you want to use, and configure those in the system.conf file. This \
module will check that all invoking scripts adhere to your naming convention. \
DBIx-JCL will complain at runtime if a script is inappropriately named.

Some examples of script acronyms are:

|Acro  |Description|
|load_ |load data script|
|extr_ |extract data script|
|merg_ |merge/update data script|
|job_  |job which runs other scripts|
|util_ |utility script|
|test_ |test script|
|temp_ |temporary scipt|

You should examine the sampel system configuration files that some with \
DBIx-JCL.

----

!1 Installation

The DBIx-JCL module can be installed into a private directory or appended to \
your Perl installation using the normal install process. If you intall into a \
private directory, you'll need to set the environment variable PERL5LIB so \
your scripts can find the module.

/Environment Variables/

The module also uses several envirnoment variables besides PERL5LIB, sample \
export entries are shown below. The module needs to know where your home \
directory is, this should normally be set for you in most installations. The \
module will look for a configuration file named /system.conf/ to start the \
boot-strap process, this location is identified by the JCLCONF environment \
variable. A default database environment needs to be identified. You \
determine what this variable will be called, in the example below the \
variable is named MYDBENV. The name you choose is stored in the \
/system.conf/ file in section %[system]%, under the key %envvar%.

Sample export settings:

 % language=IniFiles
 % export PERL5LIB=/home/myaccount/lib
 % export HOME=/home/myaccount
 % export JCLCONF=/home/myaccount/conf
 % export MYDBENV=dbenv1
 %%

Under a Windows system you will want to set these in yous Control Panel \
under System and Advanced options.

----

!1 Example Script

Shown below is the standard approach to writing job scripts.

 % language=Perl
 % #!perl
 % ##@@name_of_script.pl,bin
 % ##$$Description of the Job
 %
 % use strict;
 % use warnings;
 % use DBIx::JCL qw( :all );
 %
 % # initialize
 % # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 %
 % my $jobname = 'name_of_script';
 % sys_init( $jobname );
 %
 % my $dbenv1 = 'mydb1';
 % my $mysql1 = sys_get_sql( 'query_number_1' );
 %
 % # main
 % # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 %
 % log_info( sys_get_dbdescr( $dbenv1 ) );
 % db_connect( $dbenv1 );
 %
 % # do more db stuff here
 %
 % # end
 % # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 %
 % =begin wiki
 %
 % !1 NAME
 %
 % Name of script
 %
 % ----
 %
 % !1 DESCRIPTION
 %
 % Describe the job script here.
 %
 % ----
 %
 % !1 RECOVERY NOTES
 %
 % Document recovery notes here.
 %
 % ----
 %
 % !1 DEPENDENCIES
 %
 % Document dependencies here.
 %
 % =cut
 %
 % __END__
 %
 %%

The second and third lines of the example are required for every job script. \
The second line identifies the script and the script installation directory. \
The third line provides a brief description of the job and is used by the \
command line option that displays all installed jobs.

----

!1 Functions

The following provides an explanation of each of the functions provided by \
DBIx-JCL.

=cut


# package
# ------------------------------------------------------------------------------

package DBIx::JCL;
use strict;
use warnings;

# package exports
# ------------------------------------------------------------------------------

require Exporter;
use base qw( Exporter );
our @EXPORT_OK = qw(
    sys_init
    sys_init_setuser
    sys_end
    sys_init_plugin
    sys_get_sql
    sys_get_item
    sys_get_hash
    sys_get_array
    sys_get_common_sql
    sys_get_run_control
    sys_get_dbdescr
    sys_get_dbinst
    sys_set_restart
    sys_load_library
    sys_set_verbose
    sys_die
    sys_warn
    sys_info
    sys_ctime2str
    sys_disp_active_jobs
    sys_run_job
    sys_run_job_background
    sys_run_job_wait
    sys_run_job_maxrc
    sys_run_job_reset
    sys_get_path_bin_dir
    sys_get_path_lib_dir
    sys_get_path_log_dir
    sys_get_path_load_dir
    sys_get_path_extr_dir
    sys_get_path_scripts_dir
    sys_get_path_plugin_dir
    sys_get_path_prev_dir
    sys_get_mail_server
    sys_get_mail_from
    sys_get_mail_emailto
    sys_get_mail_pagerto
    sys_get_mail_email_levels
    sys_get_mail_pager_levels
    sys_get_log_file
    sys_get_log_filefull
    sys_get_log_logging_levels
    sys_get_log_console_levels
    sys_get_log_gdg
    sys_get_dataenvr
    sys_get_errorlevel
    sys_get_conf_dir
    sys_get_email_levels
    sys_get_pager_levels
    sys_get_logging_levels
    sys_get_console_levels
    sys_get_commandline
    sys_get_commandline_opt
    sys_get_commandline_val
    sys_get_script_file
    sys_get_user
    sys_get_util_move
    sys_get_maxval
    sys_set_errorlevel
    sys_set_die
    sys_set_warn
    sys_set_conf_file
    sys_set_email_levels
    sys_set_pager_levels
    sys_set_mail_emailto
    sys_set_logging_levels
    sys_set_console_levels
    sys_set_script_file
    sys_set_path_log_dir
    sys_set_path_plugin_dir
    sys_set_maxval
    sys_check_dataenvr
    sys_timer
    sys_wait
    sys_disp_doc
    log_fatal
    log_error
    log_warn
    log_info
    log_debug
    log_close
    log_write_log
    log_write_screen
    db_init
    db_connect
    db_nil
    db_finish
    db_disconnect
    db_prepare
    db_execute
    db_commit
    db_get_sth
    db_get_defenvr
    db_pef
    db_pef_list
    db_fetchrow
    db_bindcols
    db_rollback
    db_insert_from_file
    db_query_to_file
    db_dump_query
    db_dump_table
    db_grant
    db_func
    db_proc
    db_proc_in
    db_proc_out
    db_proc_inout
    db_rowcount_query
    db_sanity_check
    db_rowcount_table
    db_truncate
    db_dbms_output_enable
    db_dbms_output_disable
    db_dbms_output_get
    db_drop_index
    db_drop_table
    db_drop_procedure
    db_drop_function
    db_drop_package
    db_rename_index
    db_rename_table
    db_purge_table
    db_purge_index
    db_update_statistics
    db_sqlloader
    db_sqlloaderx
    db_sqlloaderx_parse_logfile
    db_sqlloaderx_read
    db_sqlloaderx_skipped
    db_sqlloaderx_rejected
    db_sqlloaderx_discarded
    db_sqlloaderx_elapsed_time
    db_sqlloaderx_cpu_time
    db_index_rebuild
    db_exchange_partition
    util_get_filename_load
    util_get_filename_extr
    util_get_filename_log
    util_read_header
    util_read_footer
    util_read_file
    util_write_header
    util_write_footer
    util_move
    util_trim
    util_zsdf
    test_init
    test_ok
    test_results
    test_harness_init
    test_harness_run
    test_harness_results
    $VERSION
    $SQLLDR_SUCC
    $SQLLDR_WARN
    $SQLLDR_FAIL
    $SQLLDR_FTL
);

our %EXPORT_TAGS = (
    all => [
        @EXPORT_OK
    ],
    sys => [ qw(
        sys_init
        sys_init_setuser
        sys_end
        sys_init_plugin
        sys_get_sql
        sys_get_item
        sys_get_hash
        sys_get_array
        sys_get_common_sql
        sys_get_run_control
        sys_get_dbdescr
        sys_get_dbinst
        sys_set_restart
        sys_load_library
        sys_set_verbose
        sys_die
        sys_warn
        sys_info
        sys_ctime2str
        sys_disp_active_jobs
        sys_run_job
        sys_run_job_background
        sys_run_job_wait
        sys_run_job_maxrc
        sys_run_job_reset
        sys_get_path_bin_dir
        sys_get_path_lib_dir
        sys_get_path_log_dir
        sys_get_path_load_dir
        sys_get_path_extr_dir
        sys_get_path_prev_dir
        sys_get_path_scripts_dir
        sys_get_mail_server
        sys_get_mail_from
        sys_get_mail_emailto
        sys_get_mail_pagerto
        sys_get_mail_email_levels
        sys_get_mail_pager_levels
        sys_get_log_file
        sys_get_log_filefull
        sys_get_log_logging_levels
        sys_get_log_console_levels
        sys_get_log_gdg
        sys_get_dataenvr
        sys_get_errorlevel
        sys_get_conf_dir
        sys_get_email_levels
        sys_get_pager_levels
        sys_get_logging_levels
        sys_get_console_levels
        sys_get_commandline
        sys_get_commandline_opt
        sys_get_commandline_val
        sys_get_script_file
        sys_get_path_plugin_dir
        sys_get_util_move
        sys_get_user
        sys_get_maxval
        sys_set_errorlevel
        sys_set_die
        sys_set_warn
        sys_set_email_levels
        sys_set_pager_levels
        sys_set_mail_emailto
        sys_set_logging_levels
        sys_set_console_levels
        sys_set_script_file
        sys_set_conf_file
        sys_set_path_log_dir
        sys_set_path_plugin_dir
        sys_set_maxval
        sys_check_dataenvr
        sys_timer
        sys_wait
        sys_disp_doc
    ) ],
    log => [ qw(
        log_fatal
        log_error
        log_warn
        log_info
        log_debug
        log_close
        log_write_log
        log_write_screen
    ) ],
    db => [ qw(
        db_init
        db_connect
        db_nil
        db_finish
        db_disconnect
        db_prepare
        db_execute
        db_commit
        db_get_sth
        db_get_defenvr
        db_pef
        db_pef_list
        db_fetchrow
        db_bindcols
        db_rollback
        db_insert_from_file
        db_query_to_file
        db_dump_query
        db_dump_table
        db_grant
        db_func
        db_proc
        db_proc_in
        db_proc_out
        db_proc_inout
        db_rowcount_query
        db_sanity_check
        db_rowcount_table
        db_truncate
        db_dbms_output_enable
        db_dbms_output_disable
        db_dbms_output_get
        db_drop_index
        db_drop_table
        db_drop_procedure
        db_drop_function
        db_drop_package
        db_rename_index
        db_rename_table
        db_purge_table
        db_purge_index
        db_update_statistics
        db_sqlloader
        db_sqlloaderx
        db_sqlloaderx_parse_logfile
        db_sqlloaderx_read
        db_sqlloaderx_skipped
        db_sqlloaderx_rejected
        db_sqlloaderx_discarded
        db_sqlloaderx_elapsed_time
        db_sqlloaderx_cpu_time
        db_index_rebuild
        db_exchange_partition
    ) ],
    util => [ qw(
        util_get_filename_load
        util_get_filename_extr
        util_get_filename_log
        util_read_header
        util_read_footer
        util_read_file
        util_write_header
        util_write_footer
        util_move
        util_trim
        util_zsdf
    ) ],
    test => [ qw(
        test_init
        test_ok
        test_results
        test_harness_init
        test_harness_run
        test_harness_results
    ) ],
    const => [ qw(
        $SQLLDR_SUCC
        $SQLLDR_WARN
        $SQLLDR_FAIL
        $SQLLDR_FTL
    ) ],
);

# package imports
# ------------------------------------------------------------------------------

use English qw( -no_match_vars );
use Getopt::Long;
use Config::IniFiles;
use Pod::WikiText;
use IO::File;
use IO::Handle;
use IO::LockedFile;
use Fcntl qw(:flock);
use File::Copy;
use File::Bidirectional;
use File::Basename;
use MIME::Lite;
use Date::Format;
use DBI;
#|++  ## flush print buffer on write

# version
# ------------------------------------------------------------------------------

our $VERSION = "0.12";

# const exports
# ------------------------------------------------------------------------------

our $SQLLDR_SUCC = 0;
our $SQLLDR_WARN = 2;
our $SQLLDR_FAIL = 1;
our $SQLLDR_FTL  = 3;

# state variables
# ------------------------------------------------------------------------------

my $path_bin_dir       = '';
my $path_lib_dir       = '';
my $path_log_dir       = '';
my $path_load_dir      = '';
my $path_extr_dir      = '';
my $path_prev_dir      = '';
my $path_scripts_dir   = '';
my $mail_server        = '';
my $mail_from          = '';
my $mail_emailto       = '';
my $mail_pagerto       = '';
my $mail_email_levels  = '';
my $mail_pager_levels  = '';
my $log_file           = '';
my $log_filefull       = '';
my $log_logging_levels = '';
my $log_console_levels = '';
my $dataenvr           = '';
my $log_gdg            = 0;
my $log_prefix         = '';
my $log_radix          = 2;
my $errorlevel         = 0;
my $util_move          = 1;

# command line variables
# ------------------------------------------------------------------------------

my $opt_run                 = 0;
my $opt_run_background      = 0;
my $opt_run_scheduled       = '';
my $opt_run_restart         = '';
my $opt_connection          = '';
my $opt_run_de              = '';
my $opt_commandline_ext     = '';
my $opt_verbose             = 0;
my $opt_very_verbose        = 0;
my $opt_no_greeting         = 0;
my $opt_test_dbcon          = '';
my $opt_log_file            = '';
my $opt_logging_levels      = '';
my $opt_console_levels      = '';
my $opt_log_gdg             = 0;
my $opt_log_prefix          = '';
my $opt_log_radix           = 0;
my $opt_notify_email_oncomp = 0;
my $opt_notify_pager_oncomp = 0;
my $opt_notify_email_tolist = '';
my $opt_notify_pager_tolist = '';
my $opt_notify_email_levels = '';
my $opt_notify_pager_levels = '';
my $opt_disp_params         = 0;
my $opt_disp_sql            = 0;
my $opt_disp_doc            = 0;
my $opt_disp_sysdoc         = 0;
my $opt_disp_logprev        = 0;
my $opt_disp_logarch        = 0;
my $opt_disp_jobs           = 0;
my $opt_disp_active_jobs    = 0;
my $opt_disp_exec           = 0;
my $opt_send_email          = '';
my $opt_send_pager          = '';
my $opt_util_move           = 0;
my $opt_help                = 0;
my $opt_help_args           = 0;
my $opt_commandline         = join ' ', @ARGV;

# module variables
# ------------------------------------------------------------------------------

use constant QUOTE => q{"};
use constant SPACE => q{ };

my $RC_FATAL = 32;
my $RC_ERROR = 16;
my $RC_WARN  = 8;

my %MONTHS = (
    Jan => 0, Feb => 1, Mar => 2, Apr => 3, May => 4, Jun => 5,
    Jul => 6, Aug => 7, Sep => 8, Oct => 9, Nov => 10, Dec=> 11,
);

my $jobname               = '';   # name used to identify job script
my $pid                   = 0;    # os process id number
my %pidlib                = ();   # hash of info about background jobs
my $pidcnt                = 0;    # count of child pids
my $maxrc                 = 0;    # max return code for foreground jobs
my $osuser                = '';   # os username
my $commandline_ext       = '';   # extended command line
my @plugins               = ();   # loaded plugin information
my %timers                = ();   # hash of timers
my %function_params       = ();   # hash of stored function params
my $wt_seconds            = 0;    # wait seconds
my $wt_start              = time; # init wait start time
my %maxval                = ();   # hash of max values
my $t_num                 = 0;    # test script
my $t_ok                  = 0;    # test script
my $t_notok               = 0;    # test script
my $th_num                = 0;    # test harness
my $th_error              = 0;    # test harness
my $sys_dbms_output       = 0;    # has dbms_output been enabled
my $sys_log_open          = 0;    # is log file open
my $sys_stderr_redirected = 0;    # STDERR has been redirected to /dev/null
my $sys_jobconf_override  = 0;    # using override job conf file
my $sys_jobconf_file      = '';   # override jobconf filename
my $path_plugin_dir       = '';   # path to plugin directory
my $path_conf_dir         = '';   # path to conf file directory
my %sqlloader_results     = ();   # hash of SQL*Loader results
my %log_level_opts        = ();   # hash of logging options

my (%conf_data, %conf_log, %conf_mail, %conf_query, %conf_job, %conf_util);
my (%conf_system, %conf_de, %conf_rcontrols);
my (@databases, @dat_envrs, @job_acros);
my (%dbname, %dbdefenvr, %dbinst, %dbconn, %dbhandles);

my $script_file           = $PROGRAM_NAME;
my $script_filefull       = $script_file;
my $log_ext               = '.log';
my $dbitrace_base         = 'dbitrace';
my $dbitrace_file         = $dbitrace_base . $log_ext;
my $dbitrace_filefull     = '';

$script_file =~ s{^/.*/}{};

$path_conf_dir = $ENV{JCLCONF} || '';
if ( ! defined $path_conf_dir ) {
    sys_die( 'Environment variable JCLCONF not set', 0 );
}

if ( $path_conf_dir =~ m/(.*)\/$/ ) { $path_conf_dir = $1; }

my %db_func_params = (
    db_insert_from_file => {
        TrimLead       => 'no',
        TrimFieldLead  => 'no',
        TrimFieldTrail => 'no',
        CommentChar    => '#',
        SkipComments   => 'no',
        SkipLastField  => 'no',
        UseRegex       => 'no',
    },
    db_insert_from_conf => {
        TrimLead       => 'no',
        TrimFieldLead  => 'no',
        TrimFieldTrail => 'no',
        CommentChar    => '#',
        SkipComments   => 'no',
        SkipLastField  => 'no',
        UseRegex       => 'no',
    },
    db_sqlloader => {
        DatFilePath => '',
        DbEnvr      => '',
        NetService  => '',
    },
);

# public methods
# ------------------------------------------------------------------------------

=begin wiki

!2 System Functions

These functions provide general job information and job managment \
capabilities.

=cut

sub sys_init {
=begin wiki

!3 sys_init

( jobname )

This is the job script initialization function. All job scripts should call \
this function first before any other JCL functions. This will validate a job \
name and does all the other setup work necessary to run a job script. This \
function also provides a standard command line interface and supporting \
functions for the supplied command line options.

=cut
    my ($jn, @cl) = @_;
    $jobname = $jn;
    foreach my $opt ( @cl ) {
        push @ARGV, $opt;   # add additional command line option
    }

    unless ( $jobname ) {
        sys_die( 'Please specify jobname when initializing', 0 );
    }

    _sys_init_vars();

    $log_file = $jobname . $log_ext;
    $log_filefull = $path_log_dir.$log_file;

    push @ARGV, '-r' if $jobname eq "JCL";  # for convenience

    $sys_jobconf_file = _sys_check_de_override( $jobname );

    $sys_jobconf_file .= ".conf";
    _sys_read_conf( $sys_jobconf_file );   # tie %conf_job to job's conf file
    _sys_read_job();   # read job specific settings from %conf_job

    GetOptions( "r"     => \$opt_run,
                "rb"    => \$opt_run_background,
                "rs=s"  => \$opt_run_scheduled,
                "rr=s"  => \$opt_run_restart,
                "rde=s" => \$opt_run_de,
                "x=s"   => \$opt_commandline_ext,
                "c=s"   => \$opt_connection,
                "v"     => \$opt_verbose,
                "vv"    => \$opt_very_verbose,
                "ng"    => \$opt_no_greeting,
                "tc=s"  => \$opt_test_dbcon,
                "lf=s"  => \$opt_log_file,
                "lg=i"  => \$opt_log_gdg,
                "lp=s"  => \$opt_log_prefix,
                "lr=i"  => \$opt_log_radix,
                "ll=s"  => \$opt_logging_levels,
                "cl=s"  => \$opt_console_levels,
                "ne"    => \$opt_notify_email_oncomp,
                "np"    => \$opt_notify_pager_oncomp,
                "et=s"  => \$opt_notify_email_tolist,
                "el=s"  => \$opt_notify_email_levels,
                "pt=s"  => \$opt_notify_pager_tolist,
                "pl=s"  => \$opt_notify_pager_levels,
                "dp"    => \$opt_disp_params,
                "dq"    => \$opt_disp_sql,
                "dd"    => \$opt_disp_doc,
                "dl"    => \$opt_disp_logprev,
                "da"    => \$opt_disp_logarch,
                "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 );
        close $fh;
    }

    if ( $opt_help                ) {
        _sys_help( 1 ); }
    if ( $opt_help_args           ) {
        _sys_help( 2 ); }
    if ( $opt_run_background      ) {
        _sys_run_background(); }
    if ( $opt_run_scheduled       ) {
        _sys_run_scheduled(); }
    if ( $opt_run_de              ) {
        _sys_run_de( $opt_run_de ); }
    if ( $opt_run_restart         ) {
        _sys_run_restart(); }
    if ( $opt_test_dbcon          ) {
        _sys_test_dbcon( $opt_test_dbcon); }
    if ( $opt_commandline_ext     ) {
        $commandline_ext = $opt_commandline_ext; }
    if ( $opt_logging_levels      ) {
        $log_logging_levels = _sys_check_severity_levels( $opt_logging_levels ); }
    if ( $opt_console_levels      ) {
        $log_console_levels = _sys_check_severity_levels( $opt_console_levels ); }
    if ( $opt_log_gdg             ) {
        $log_gdg = _sys_check_log_gdg( $opt_log_gdg ); }
    if ( $opt_log_prefix          ) {
        $log_prefix = $opt_log_prefix; }
    if ( $opt_log_radix           ) {
        $log_radix = _sys_check_log_radix( $opt_log_radix ); }
    if ( $opt_notify_email_tolist ) {
        $mail_emailto = $opt_notify_email_tolist; }
    if ( $opt_notify_pager_tolist ) {
        $mail_pagerto = $opt_notify_pager_tolist; }
    if ( $opt_notify_email_levels ) {
        $mail_email_levels = _sys_check_severity_levels( $opt_notify_email_levels ); }
    if ( $opt_notify_pager_levels ) {
        $mail_pager_levels = _sys_check_severity_levels( $opt_notify_pager_levels ); }
    if ( $opt_disp_logprev        ) {
        _sys_disp_logprev(); }
    if ( $opt_disp_logarch        ) {
        _sys_disp_logarch(); }
    if ( $opt_disp_exec           ) {
        _sys_disp_exec(); }
    if ( $opt_disp_sql            ) {
        _sys_disp_sql(); }
    if ( $opt_disp_params         ) {
        _sys_disp_params(); }
    if ( $opt_disp_doc            ) {
        _sys_disp_doc(); }
    if ( $opt_disp_jobs           ) {
        _sys_disp_jobs(); }
    if ( $opt_disp_active_jobs    ) {
        _sys_disp_active_jobs( 0 ); }
    if ( $opt_send_email          ) {
        _sys_send_email_message($opt_send_email); }
    if ( $opt_send_pager          ) {
        _sys_send_pager_message($opt_send_pager); }
    if ( $opt_util_move           ) {
        $util_move = 0; }

    # must have a Run option to continue
    if ( ! $opt_run ) {
        _sys_help(1);
    }

    $log_file = $log_prefix . $jobname . $log_ext;  # default

    if ( $osuser ) {  # custom
        $log_file = $log_prefix . $jobname . '_' . $osuser . $log_ext;
    }
    $log_filefull = $path_log_dir . $log_file;

    if ( $opt_log_file ) {  # override
        $log_file = $opt_log_file;
        $log_filefull = $path_log_dir . $log_file;
    }

    _log_init_log_file();  # log rotation handler

    # validate script name using configured acros
    my ($base, $path, $type) = fileparse( $script_file );
    if ( $base =~ m/^([a-z]+_)/x ) {  ## acro + underscore
        $base = $1;
    }
    _check_array_val($base, \@job_acros) || sys_die( "Not a valid job acro", 0 );

    _sys_init_source_validation();

    sys_timer( 'start', '__default_timer' );

    log_info( "Start: $jobname" ) unless $opt_no_greeting;

    if ( $opt_very_verbose ) { $opt_verbose = 1; }
    if ( $opt_verbose ) {
        log_info( 'Running in verbose mode' );
        log_info( "Process: $pid" );
        log_info( "Options: $opt_commandline" );
    }

    if ( $sys_jobconf_override ) {
        log_info( "Jobconf override: $sys_jobconf_file" );
    }

    _sys_job_init();

    return 0;
}

sub sys_init_setuser {
=begin wiki

!3 sys_init_setuser

( jn, cl )

Please write this documentation.

=cut
    my ($jn, @cl) = @_;
    $osuser = getlogin || 'unknown';
    sys_init( $jn, @cl );
    return 0;
}

sub sys_end {
=begin wiki

!3 sys_end

No Parameters

Please write this documentation.

=cut
    _sys_job_end();

    if ( $opt_no_greeting ) { return 0; }

    sys_timer( 'stop', '__default_timer' );

    log_info( "Errorlevel: $errorlevel" );
    log_info( "Elapsed time: " . sys_timer( 'elapsed', '__default_timer' ) );
    log_info( "End: $jobname" ) unless $opt_no_greeting;

    return 0;
}

sub sys_load_library {
=begin wiki

!3 sys_load_library

( conf_filename )

Give the user an opportunity to load a different conf file replacing the \
contents of sys_common.conf with the requested conf file contents.

=cut
    my $conf_filename = shift;

    ## load a conf file replacing the contents of sys_common.conf
    tie %conf_query, 'Config::IniFiles', ( -file => $path_conf_dir.'/'.$conf_filename )
        or sys_die( "Unable to load conf file $conf_filename", 0 );
    return 0;
}

sub sys_init_plugin {
=begin wiki

!3 sys_init_plugin

( plugin_file, package_name )

Provide plugin support. This function accepts a plugin filename and attempts \
to load a plugin file by that name from the plugin directory. Plugins are \
standard Perl modules with nothing exported. The package name used by the \
module is also passed in to this function and is used to call an \
initialization function named start.

Plugins should always implement a start and an end function, these take no \
parameters. All plugins should also implement a main plugin function named \
odly enough, plugin_main. The start and end functions should not take any \
parameters. The main plugin function can be written to accept whatever \
parameters are needed.

This little bit of deep magic by merlyn gleened from the Perl Monastery was \
very educational (I almost had it before finding this):

 % language=Perl
 %    my %codeRefs = map {
 %       "Package"->can($_) || sub { die "can't find $_" }
 %   } qw(subroutine1 subroutine2 subroutine3);
 %%

Merlyn, aka, Tom Christensen???

=cut
    my ($plugin_file, $package_name) = @_;

    my $plugin_filefull = $path_plugin_dir.$plugin_file.'.pm';
    unless ( -f $plugin_filefull ) { sys_die( "Plugin not found: $plugin_file", 0 ); }

    require $plugin_filefull;

    push @plugins, join '~', ($package_name, $plugin_file, $plugin_filefull);
    $package_name->start($path_conf_dir, $path_plugin_dir, $dataenvr);
    return $package_name->can('plugin_main');   ## deep magic
}

sub sys_ctime2str {
=begin wiki

!3 sys_time2str

( format )

This is an interface to the Data::Format::time2str function. This simply \
provides an easier way for the job script to make use of the time2str \
function for acquiring a formatted current date/time. You can pass as a \
format string any of the following meta characters.

|%% |PERCENT|
|%a |day of the week abbr|
|%A |day of the week|
|%b |month abbr|
|%B |month|
|%c |MM/DD/YY HH:MM:SS|
|%C |ctime format: Sat Nov 19 21:05:57 1994|
|%d |numeric day of the month, with leading zeros (eg 01..31)|
|%e |numeric day of the month, without leading zeros (eg 1..31)|
|%D |MM/DD/YY|
|%G |GPS week number (weeks since January 6, 1980)|
|%h |month abbr|
|%H |hour, 24 hour clock, leading 0's)|
|%I |hour, 12 hour clock, leading 0's)|
|%j |day of the year|
|%k |hour|
|%l |hour, 12 hour clock|
|%L |month number, starting with 1|
|%m |month number, starting with 01|
|%M |minute, leading 0's|
|%n |NEWLINE|
|%o |ornate day of month -- "1st", "2nd", "25th", etc.|
|%p |AM or PM|
|%P |am or pm (Yes %p and %P are backwards :)|
|%q |Quarter number, starting with 1|
|%r |time format: 09:05:57 PM|
|%R |time format: 21:05|
|%s |seconds since the Epoch, UCT|
|%S |seconds, leading 0's|
|%t |TAB|
|%T |time format: 21:05:57|
|%U |week number, Sunday as first day of week|
|%w |day of the week, numerically, Sunday == 0|
|%W |week number, Monday as first day of week|
|%x |date format: 11/19/94|
|%X |time format: 21:05:57|
|%y |year (2 digits)|
|%Y |year (4 digits)|
|%Z |timezone in ascii. eg: PST|
|%z |timezone in format -/+0000|

/end of table/

=cut
    my $format = shift;
    return time2str($format, time);
}

sub sys_die {
=begin wiki

!3 sys_die

Parameters: ( message, notify )

Print a message to STDOUT and then exit returning $errorlevel $RC_FATAL. The \
message is printed to STDOUT because STDERR is redirected while running.

=cut
    my ($message, $notify) = @_;
    $notify = 0 unless defined $notify;
    $errorlevel = $RC_FATAL;

    _log_write_to_screen( 'FATAL', $notify, $message );

    if ( $sys_log_open ) {
        _log_write_to_log( 'FATAL', $notify, $message );
    }

    ## save a call if possible
    if ( $notify ) { _log_send_notifications( 'FATAL', $notify, $message ); }

    _sys_job_end();

    exit $errorlevel;
}

sub sys_warn {
=begin wiki

!3 sys_warn

Parameters: ( message, notify )

Print a message to STDOUT and then return to caller setting $errorlevel \
$RC_WARN. The message is printed to STDOUT because STDERR is redirected \
while running.

=cut
    my ($message, $notify) = @_;
    $notify = 1 unless defined $notify;
    $errorlevel = $RC_WARN;

    ## force write to screen
    _log_write_to_screen( 'WARN', 1, $message );

    ## force write to log if log is open
    if ( $sys_log_open ) {
        _log_write_to_log( 'WARN', 1, $message );
    }

    ## force notifications if notification requested
    if ( $notify ) { _log_send_notifications( 'WARN', 1, $message ); }

    return $errorlevel;
}

sub sys_info {
=begin wiki

!3 sys_info

Parameters: ( message, notify )

=cut
    my ($message, $extmsg, $notify, $nolog) = @_;
    $notify = 1 unless defined $notify;
    $nolog = 0 unless defined $nolog;

    ## get destination email address from job conf
    my $emailto = sys_get_item( 'sys_info_emailto' );
    my $mail_emailto_save = $mail_emailto;
    $mail_emailto = $emailto;

    log_info( $message, $extmsg, $nolog );
    _log_send_notifications( 'INFO', 1, $message ) if $notify;

    $mail_emailto = $mail_emailto_save;
    return 0;
}

sub sys_disp_active_jobs {
=begin wiki

!3 sys_disp_active_jobs

No Parameters

Please write this documentation.

=cut
    _sys_disp_active_jobs( 1 );
    return 0;
}

sub sys_run_job {
=begin wiki

!3 sys_run_job

Parameters: (jobname, job_maxrc, params )

|$job    |name of script or application to execute|
|@params |list of parameters to pass to the executed process|

This function usese the built-in Perl system function to invoke a JCL script \
(or other application). As such, this function will wait until the child \
completes before returning to the caller.

A reasonable attempt is made to insure that the process execute is invoked \
via a shell. This is accomplished by passing the system function the \
paramaters as a quoted string, rather than as a list.

Returns: Process return code from the script/application executed.

=cut
    my ($jobname, $job_maxrc, @params) = @_;

    my @args = ($jobname, @params);
    system(@args);
    my $childrc = $CHILD_ERROR >> 8;

    if ( $childrc > $job_maxrc ) {
        sys_die( "Process failed with return code $childrc" );
    }

    if ( $job_maxrc > $maxrc ) { $maxrc = $job_maxrc; }

    return $childrc;
}

sub sys_run_job_background {
=begin wiki

!3 sys_run_job_background

Parameters: ( jobname, maxrc, params )

Please write this documentation.

Returns:

=cut
    my ($jobname, $maxrc, @params) = @_;
    $maxrc = 0 unless $maxrc;

    my $pid = _sys_forkexec( $jobname, @params );
    $pidlib{$pid} = { jobname => $jobname,
                      maxrc   => $maxrc,
                      retcd   => 0
                    };
    $pidcnt++;
    return $pid;
}

sub sys_run_job_wait {
=begin wiki

!3 sys_run_job_wait

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    return 0 if $pidcnt < 1;
    while (1) {
        my $pid = _sys_reap_child();
        $pidcnt--;
        my $childrc = $pidlib{$pid}{retcd};
        my $msg = "Complete $pidlib{$pid}{jobname}. Return code: $childrc.";
        if ( $childrc > $pidlib{$pid}{maxrc} ) {
            ## log_warn sets errorlevel
            log_warn( "$msg Max allowed: $pidlib{$pid}{maxrc}." );
        } else {
            log_info( $msg );
        }
        last if $pidcnt < 1;
    }
    return $pidcnt;
}

sub sys_run_job_maxrc {
=begin wiki

!3 sys_run_job_maxrc

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    ## return the max of either the current background max return code or the
    ## current foreground max return code
    my $tmprc = 0;
    foreach my $pid ( keys %pidlib ) {
        if ( $pidlib{$pid}{retcd} > $tmprc ) { $tmprc = $pidlib{$pid}{retcd}; }
    }

    ( $tmprc >= $maxrc ) ? return $tmprc : return $maxrc;
}

sub sys_run_job_reset {
=begin wiki

!3 sys_run_job_reset

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    $pidcnt = 0;   ## reset background jobs count
    %pidlib = ();  ## reset background jobs info hash
    $maxrc = 0;    ## reset foreground jobs max return code
    return 0;
}

sub sys_get_path_bin_dir {
=begin wiki

!3 sys_get_path_bin_dir

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    return $path_bin_dir;
}

sub sys_get_path_lib_dir {
=begin wiki

!3 sys_get_path_lib_dir

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    return $path_lib_dir;
}

sub sys_get_path_log_dir {
=begin wiki

!3 sys_get_path_log_dir

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    return $path_log_dir;
}

sub sys_get_path_load_dir {
=begin wiki

!3 sys_get_path_load_dir

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    return $path_load_dir;
}

sub sys_get_path_extr_dir {
=begin wiki

!3 sys_get_path_extr_dir

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    return $path_extr_dir;
}

sub sys_get_path_prev_dir {
=begin wiki

!3 sys_get_path_prev_dir

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    return $path_prev_dir;
}

sub sys_get_path_scripts_dir {
=begin wiki

!3 sys_get_path_scripts_dir

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    return $path_scripts_dir;
}

sub sys_get_path_plugin_dir {
=begin wiki

!3 sys_get_path_plugin_dir

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    return $path_plugin_dir;
}

sub sys_get_mail_server {
=begin wiki

!3 sys_get_mail_server

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    return $mail_server;
}

sub sys_get_mail_from {
=begin wiki

!3 sys_get_mail_from

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    return $mail_from;
}

sub sys_get_mail_emailto {
=begin wiki

!3 sys_get_mail_emailto

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    return $mail_emailto;
}

sub sys_get_mail_pagerto {
=begin wiki

!3 sys_get_mail_pagerto

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    return $mail_pagerto;
}

sub sys_get_mail_email_levels {
=begin wiki

!3 sys_get_mail_email_levels

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    return $mail_email_levels;
}

sub sys_get_mail_pager_levels {
=begin wiki

!3 sys_get_mail_pager_levels

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    return $mail_pager_levels;
}

sub sys_get_log_file {
=begin wiki

!3 sys_get_log_file

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    return $log_file;
}

sub sys_get_log_filefull {
=begin wiki

!3 sys_get_log_filefull

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    return $log_filefull;
}

sub sys_get_log_logging_levels {
=begin wiki

!3 sys_get_log_logging_levels

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    return $log_logging_levels;
}

sub sys_get_log_console_levels {
=begin wiki

!3 sys_get_log_console_levels

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    return $log_console_levels;
}

sub sys_get_log_gdg {
=begin wiki

!3 sys_get_log_gdg

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    return $log_gdg;
}

sub sys_get_dataenvr {
=begin wiki

!3 sys_get_dataenvr

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    return $dataenvr;
}

sub sys_get_errorlevel {
=begin wiki

!3 sys_get_errorlevel

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    return $errorlevel;
}

sub sys_get_dbdescr {
=begin wiki

!3 sys_get_dbdescr

Parameters: ( dbacro )

Accept a database acro and return a database description string which \
consists of database name, acro, and current instance.

Returns:

=cut
    my $dbacro = shift;

    my $dbdescr = 'Database: acronym not found';
    foreach my $acro ( @databases ) {
        if ( $acro eq $dbacro ) {
            $dbdescr = 'Database Connection: ' . $dbname{$dbacro} . ' (' .
            $dbacro . '/' . $dbdefenvr{$dbacro} . ')';
        }
    }
    return $dbdescr;
}
sub sys_get_dbinst {
=begin wiki

!3 sys_get_dbinst

Parameters: ( dbacro )

Please write this documentation.

Returns:

=cut
    my $dbacro = shift;

    my $dbdescr = 'Database: instance not found';
    foreach my $acro ( @databases ) {
        if ( $acro eq $dbacro ) {
            $dbdescr = $dbacro . '/' . $dbdefenvr{$dbacro};
        }
    }
    return uc($dbdescr);
}

sub sys_get_conf_dir {
=begin wiki

!3 sys_get_conf_dir

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    return $path_conf_dir . '/';
}

sub sys_get_sql {
=begin wiki

!3 sys_get_sql

Parameters: ( sqlname, alternate_job_name )

Return the sql query from the query.conf file using the sqlname provided. \
If the requested sql name is not found, the name gets 'sql:' prepended and \
then another attempt is made. This allows entries of the form 'name' or \
alternately 'sql:name' to be used in the query.conf file.

The user may also pass in an optionl section name which will override the \
default section name. (Default section name is the current $jobname.)

Returns:

=cut
    my ($sqlname, $altsection) = @_;
    my $section = $altsection || 'sql';

    if ( ! $conf_job{$section}{$sqlname} ) {
        $sqlname = 'sql:'.$sqlname;
        if ( ! $conf_job{$section}{$sqlname} ) {
            sys_die( "The job conf file does not contain a query named [$sqlname]", 0 );
        }
    }
    return $conf_job{$section}{$sqlname};
}

sub sys_get_item {
=begin wiki

!3 sys_get_item

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my ($item, $altsection) = @_;
    my $section = $altsection || 'job';

    my $value = $conf_job{$section}{$item};

    if ( ! defined $value ) {
        sys_die( "Job conf missing entry [$item] in section [$section]", 0 );
    }

    if ( $value eq '0' ) {
        return $conf_job{$section}{$item};
    }

    return $value;
}

sub sys_get_hash {
=begin wiki

!3 sys_get_hash

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my ($section, $entry, $delim) = @_;
    $delim = ':' unless $delim;

    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

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my ($section, $entry, $delim) = @_;
    $delim = ':' unless $delim;

    my ($pseudo, @array);

    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 array from the pseudo array
    foreach my $item ( split "\n", $pseudo ) {
        push @array, $item;
    }

    return \@array;  ## ref to an array
}

sub sys_get_common_sql {
=begin wiki

!3 sys_get_common_sql

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my ($sqlname, $altsection) = @_;
    my $section = $altsection || 'sql';

    if ( ! $conf_query{$section}{$sqlname} ) {
        $sqlname = 'sql:'.$sqlname;
        if ( ! $conf_query{$section}{$sqlname} ) {
            sys_die( 'Common sql conf missing query by that name', 0 );
        }
    }
    return $conf_query{$section}{$sqlname};
}

sub sys_get_run_control {
=begin wiki

!3 sys_get_run_control

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my ($jobname, $section, $default) = @_;

    my $rcontrol = $default || 0;
    if ( ! $conf_rcontrols{$section}{$jobname} ) {
        return $rcontrol;
    }

    return $conf_rcontrols{$section}{$jobname};
}

sub sys_get_email_levels {
=begin wiki

!3 sys_get_email_levels

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    return $mail_email_levels;
}

sub sys_get_pager_levels {
=begin wiki

!3 sys_get_pager_levels

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    return $mail_pager_levels;
}

sub sys_get_logging_levels {
=begin wiki

!3 sys_get_logging_levels

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    return $log_logging_levels;
}

sub sys_get_console_levels {
=begin wiki

!3 sys_get_console_levels

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    return $log_console_levels;
}

sub sys_get_commandline {
=begin wiki

!3 sys_get_commandline

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    return join ' ', @ARGV;
}

sub sys_get_commandline_opt {
=begin wiki

!3 sys_get_commandline_opt

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 {
=begin wiki

!3 sys_get_commandline_val

Parameters: ( p1, p2, p3 )

Please write this documentation.

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

sub sys_get_script_file {
=begin wiki

!3 sys_get_script_file

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    return $script_file;
}

sub sys_get_util_move {
=begin wiki

!3 sys_get_util_move

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    return $util_move;
}

sub sys_get_user {
=begin wiki

!3 sys_get_user

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    return getlogin || 'unknown';
}

sub sys_get_maxval {
=begin wiki

!3 sys_get_maxval

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my $key = shift;
    return $maxval{$key} || 0;
}

sub sys_set_restart {
=begin wiki

!3 sys_set_restart

Parameters: ( restart_option )

Write the requested restart_option to the the system.conf file. This value \
is the last step attempted by the calling script.

Returns:

=cut
    my $restart_option = shift;

    if ( $restart_option !~ m/^\d+/x ) {
        sys_die( 'Restart option is not numeric', 0 );
        return 1;
    }

    my $rtconf = $path_conf_dir.'/'.$jobname.'.running';
    my $conf = new Config::IniFiles( -file => $rtconf );
    unless ( defined $conf ) { sys_die( "Error opening runtime jobconf file", 0 ); }
    $conf->setval( 'restart', 'restart', $restart_option );
    $conf->RewriteConfig;

    return 0;
}

sub sys_set_verbose {
=begin wiki

!3 sys_set_verbose

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    $opt_verbose = 1;
    return 0;
}

sub sys_set_errorlevel {
=begin wiki

!3 sys_set_errorlevel

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my $errlvl = shift;

    if ( $errlvl !~ /^\d+$/ ) {
        sys_die( "Invalid value passed to sys_set_errorlevel()" );
    }

    my $save_errlvl = $errorlevel;
    $errorlevel = $errlvl;
    return $save_errlvl;
}

sub sys_set_warn {
=begin wiki

!3 sys_set_warn

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    $errorlevel = $RC_WARN;
    return $RC_WARN;
}

sub sys_set_die {
=begin wiki

!3 sys_set_die

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    $errorlevel = $RC_FATAL;
    return $RC_FATAL;
}

sub sys_set_email_levels {
=begin wiki

!3 sys_set_email_levels

Parameters: ( email_levels )

Accept a comma delimited list of message levels to use as the source for \
determing which message levels will generate a notification, and which \
message levels will be ignored when email notification is invoked.

Valid values for the list are: FATAL,ERROR,WARN,INFO,DEBUG,NONE

Returns:

=cut
    my $email_levels = shift || "FATAL";
    $mail_email_levels = _sys_check_severity_levels( $email_levels );
    return $mail_email_levels;
}

sub sys_set_pager_levels {
=begin wiki

!3 sys_set_pager_levels

Parameters: ( pager_levels )

Accept a comma delimited list of message levels to use as the source for \
determing which message levels will generate a notification, and which \
message levels will be ignored when pager notification is invoked.

Valid values for the list are: FATAL,ERROR,WARN,INFO,DEBUG,NONE

Returns:

=cut
    my $pager_levels = shift || "FATAL";
    $mail_pager_levels = _sys_check_severity_levels( $pager_levels );
    return $mail_pager_levels;
}

sub sys_set_mail_emailto {
=begin wiki

!3 sys_set_mail_emailto

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my $new_emailto = shift;
    my $old_emailto = $mail_emailto;
    $mail_emailto = $new_emailto;
    return $old_emailto;
}

sub sys_set_logging_levels {
=begin wiki

!3 sys_set_logging_levels

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my $logging_levels = shift || "FATAL,ERROR,WARN,INFO";
    $log_logging_levels = _sys_check_severity_levels( $logging_levels );
    return $log_logging_levels;
}

sub sys_set_console_levels {
=begin wiki

!3 sys_set_console_levels

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my $console_levels = shift || "FATAL,ERROR,WARN,INFO";
    $log_console_levels = _sys_check_severity_levels( $console_levels );
    return $log_console_levels;
}

sub sys_set_script_file {
=begin wiki

!3 sys_set_script_file

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my $file = shift || $script_file;
    $script_file = $file;
    return $script_file;

}

sub sys_set_conf_file {
=begin wiki

Parameters: ( jobconf )

Manage the job conf file.

Set the value of the job conf filename and read the corresponding file. If \
no job conf filename is given, set the job conf filename back to the default \
value and reread the default job conf file (perform a reset).

Returns:

=cut
    my $jobconf = shift || '';

    if ( $jobconf ) {
        ## change jobconf file and read
        $sys_jobconf_file = $jobconf . '.conf';
        _sys_read_conf( $sys_jobconf_file );  ## tie %conf_job to job conf file
        _sys_read_job();  ## read job specific settings from %conf_job
    } else {
        ## reset jobconf file to default and reread
        $sys_jobconf_file = _sys_check_de_override( $jobname . '.conf' );
        _sys_read_conf( $sys_jobconf_file );  ## tie %conf_job to job conf file
        _sys_read_job();  ## read job specific settings from %conf_job
    }
    return 0;
}

sub sys_set_path_log_dir {
=begin wiki

!3 sys_set_path_log_dir

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my $path = shift || $path_log_dir;
    $path_log_dir = $path;
    return $path_log_dir;
}

sub sys_set_path_plugin_dir {
=begin wiki

!3 sys_set_path_plugin_dir

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my $path = shift || $path_plugin_dir;
    $path_plugin_dir = $path;
    return $path_plugin_dir;
}

sub sys_set_maxval {
=begin wiki

!3 sys_set_maxval

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my ($key, $val) = @_;
    if ( $maxval{$key} ) {
        if ( $val > $maxval{$key} ) {
            $maxval{$key} = $val;
        }
        return $val;
    }
    $maxval{$key} = $val;
    return $val;
}

sub sys_check_dataenvr {
=begin wiki

!3 sys_check_dataenvr

Parameters:

 /data_envrs/ = dataenvrs to check

Accept either a dataenvr or a ref to an array of dataenvrs. If \
/data_envrs/ contains the current dataenvr, return true, otherwise return \
false.

Returns:

=cut
    my $data_envrs = shift;
    my @check_envrs;

    if ( ref $data_envrs eq 'ARRAY' ) {
        @check_envrs = map { $_ } @{$data_envrs};
    } else {
        push @check_envrs, $data_envrs;  ## single entry
    }

    ## is current data environment in the list of acceptable environments
    if ( grep { $_ eq $dataenvr } @check_envrs ) {
        return 1;
    }

    return 0;
}

sub sys_disp_doc {
=begin wiki

!3 sys_disp_doc

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    return _sys_disp_doc();
}

sub sys_timer {
=begin wiki

!3 sys_timer

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my ($opt, $timer_name) = @_;
    $timer_name = 't1' unless $timer_name;

    if ( $opt =~ m/start/ix ) {
        $timers{$timer_name.'_start'} = time;
        return $timers{$timer_name.'_start'};
    }
    if ( $opt =~ m/stop/ix ) {
        $timers{$timer_name.'_stop'} = time;
        return $timers{$timer_name.'_stop'};
    }
    if ( $opt =~ m/elapsed/ix ) {
        my $estart = $timers{$timer_name.'_start'};
        my $estop = $timers{$timer_name.'_stop'};
        my $eelapsed = $estop - $estart;
        my $ehours = int $eelapsed / 3600;
        my $emins  = int $eelapsed / 60 % 60;
        my $esecs  = int $eelapsed % 60;
        return sprintf "%02d:%02d:%02d", $ehours, $emins, $esecs;
    }
    if ( $opt =~ /elapsed_seconds/i ) {
        my $sstart = $timers{$timer_name.'_start'};
        my $sstop = $timers{$timer_name.'_stop'};
        my $selapsed = $sstop - $sstart;
        return $selapsed;
    }
    return 'TIMER ERROR';
}

sub sys_wait {
=begin wiki

!3 sys_wait

Parameters: ( $action, $minutes )

$action can be either:

* 'init' - initialize wait's start time and elapsed time
* 'wait' - wait until $minutes has elapsed since start time

Example:

 % language=Perl
 % sys_wait( 'init', 3 );
 % ... do some work
 % sys_wait( 'wait' );
 %%

Returns:

=cut
    my ($action, $minutes) = @_;

    if ( $action =~ /^init$/i ) {
        $wt_start = time;
        $wt_seconds = 0;
        return 0 unless $minutes =~ /^\d+$/;
        $wt_seconds = $minutes * 60;
    }

    if ( $action =~ /^wait$/i ) {
        while ( 1 ) {
            my $currtime = time;
            my $elapsedt = $currtime - $wt_start;
            log_info( "Waiting $wt_seconds, Elapsed: $elapsedt" );
            if ( ($currtime - $wt_start) < $wt_seconds ) {
                sleep 10;
            } else {
                last;
            }
        }
    }

    return 0;
}

=begin wiki

!2 Logging Functions

These functions provide logging and notification capabilities.

=cut

sub log_fatal {
=begin wiki

!3 log_fatal

Parameters: ( message )

Call lower level logging functions using severity level FATAL.

Returns:

=cut
    my ($message, $extmsg) = @_;
    $errorlevel = $RC_FATAL;
    _log_write_to_log( 'FATAL', 0, $message, $extmsg);
    _log_write_to_screen( 'FATAL', 0, $message, $extmsg);
    return $errorlevel;
}

sub log_error {
=begin wiki

!3 log_error

Parameters: ( message )

Call lower level logging functions using severity level ERROR.

Returns:

=cut
    my ($message, $extmsg) = @_;
    $errorlevel = $RC_ERROR;
    _log_write_to_log( 'ERROR', 0, $message, $extmsg);
    _log_write_to_screen( 'ERROR', 0, $message, $extmsg);
    return $errorlevel;
}

sub log_warn {
=begin wiki

!3 log_warn

Parameters: ( message )

Call lower level logging functions using severity level WARN.

Returns:

=cut
    my ($message, $extmsg) = @_;
    $errorlevel = $RC_WARN;
    _log_write_to_log( 'WARN', 0, $message, $extmsg);
    _log_write_to_screen( 'WARN', 0, $message, $extmsg);
    return $errorlevel;
}

sub log_info {
=begin wiki

!3 log_info

Parameters: ( message )

Call lower level logging functions using severity level INFO.

Returns:

=cut
    my ($message, $extmsg, $nolog) = @_;
    $nolog = 0 unless $nolog;
    return 0 if $nolog;
    _log_write_to_log( 'INFO', 0, $message, $extmsg);
    _log_write_to_screen( 'INFO', 0, $message, $extmsg);
    return 0;
}

sub log_debug {
=begin wiki

!3 log_debug

Parameters: ( message )

Call lower level logging functions using severity level DEBUG.

Returns:

=cut
    my ($message, $extmsg) = @_;
    _log_write_to_log( 'DEBUG', 0, $message, $extmsg);
    _log_write_to_screen( 'DEBUG', 0, $message, $extmsg);
    return 0;
}

sub log_close {
=begin wiki

!3 log_close

Parameters: ( message )

Close the currently open log file.

Returns: 0

=cut
    my ($message, $extmsg) = @_;

    _log_write_to_log( 'INFO', 0, $message, $extmsg);
    _log_write_to_screen( 'INFO', 0, $message, $extmsg);
    $sys_log_open = 0;

    return 0;
}

sub log_write_screen {
=begin wiki

!3 log_write_screen

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my $message = shift;
    _log_write_to_screen( 'INFO', 1, $message);
    return 0;
}

sub log_write_log {
=begin wiki

!3 log_write_log

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my $message = shift;
    _log_write_to_log( 'INFO', 1, $message);
    return 0;
}

=begin wiki

!2 Database Functions

These functions provide the database interface and data manipulation \
capabilities.

=cut

sub db_init {
=begin wiki

!3 db_init

Parameters: ( )

User interface to settings used by the various db functions. Requested \
settings are validated against those held in the db_func_parmas hash.

Returns:

=cut
    my ($id, %params) = @_;
    if ( ! defined $db_func_params{$id} ) {
        sys_die( "Param $id to db_init is invalid")
    }
    foreach my $key ( keys %params ) {
        if ( ! defined $db_func_params{$id}{$key} ) {
            sys_die( "Param $key to db_init is invalid" );
        }
        $db_func_params{$id}{$key} = $params{$key};
    }
    return 0;
}

sub db_connect {
=begin wiki

!3 db_connect

Parameters: ( vdn )

This function accepts a virtual database name and makes a connection to the \
database resource identified by that name. The desired database instance has \
already been determined and stored before this function is called.

This function sets the DBI tracing mode so that we have a dbitrace.log file \
with pertinent history in it. This file will get large, so it should be \
rotated frequently. Contrary to what I've read, this does not supress \
output to STDERR. It appears that this just forces DBI to write errors to \
both STDERR and the dbitrace file. To fix that, this function redirects \
STDERR to /dev/null. This is an ugly hack. So until I can figure out if I \
read the docs wrong, or if DBI is just broken in this regard, I need to \
leave this to prevent garbage output. It's garbage because I always check \
and log DBI errors anyway.

Returns:

=cut
    my ($vdn, %connect_params) = @_;
    my ($starttime, $dbh, $instance);

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

    ## get database parameters
    my ($db, $un, $pw) = _db_vdn('connect', $vdn);
    DBI->trace( 1, $dbitrace_filefull );
    open STDERR, '>', '/dev/null' unless $opt_very_verbose;

    ## connect with retry
    $dbh = _db_connect_retry(
        $db, $un, $pw, $retry_duration, $retry_max_secs
    );

    ## connection established
    $dbhandles{$vdn}{'dbh'} = $dbh;   ## store handle for cleanup on exit

    db_nil( $vdn );
    return 0;
}

sub db_nil {
=begin wiki

!3 db_nil

Parameters: ( )

This is just a convenience function. When running in test mode, this will \
call the internal C<_db_vdn> to function for force closure of all database \
connections immediately.

Returns:

=cut
    my $vdn = shift;
    my ($dbh, $sth) = _db_vdn( 'nil', $vdn);
    return 0;
}

sub db_disconnect {
=begin wiki

!3 db_disconnect

Parameters: ( vdn )

Accept a virtual database name and disconnect from the datatabase specified \
by the virtual database name.

Returns:

=cut
    my $vdn = shift;
    my ($dbh, $sth) = _db_vdn( 'disconnect', $vdn);

    if ( $dbh ) {
        $dbh->disconnect;
        if ( DBI->errstr ) {
            log_warn( DBI->errstr );
            return 1;
        }
    }
    $dbhandles{$vdn}{'dbh'} = 0;
    return 0;
}

sub db_finish {
=begin wiki

!3 db_finish

Parameters: ( vdn )

Accept a virtual database name and close the current statement handle for \
the database specified by the virtual database name.

Returns:

=cut
    my $vdn = shift;
    my ($dbh, $sth) = _db_vdn( 'finish', $vdn);

    if ( $sth ) {
        $sth->finish;
        if ( DBI->errstr ) {
            log_warn( DBI->errstr );
            return 1;
        }
    }
    $dbhandles{$vdn}{'sth'} = 0;
    return 0;
}

sub db_prepare {
=begin wiki

!3 db_prepare

Parameters: ( vdn, sql_query )

Accept a virtual database name and an sql query and prepares the query for \
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 )
        or sys_die( $dbh->errstr );

    ## store statement handle for this vdn
    $dbhandles{$vdn}{$sth_name} = $sth;

    return 0;
}

sub db_truncate {
=begin wiki

!3 db_truncate

Parameters: ( vdn, table_name )

Accept a virtual database name and a table name. Truncate the specified \
table. This function returns number of rows truncated.

Returns:

=cut
    my ($vdn, $table_name) = @_;
    my ($dbh, $sth) = _db_vdn('truncate', $vdn);

    my $sql = "truncate table $table_name";
    $dbh->do( $sql )
        or sys_die( DBI->errstr );

    return 0;
}

sub db_execute {
=begin wiki

!3 db_execute

Parameters: ( vdn, sql_substitution_paramaters )

Accept a virtual database name and sql substitution parameters. Execute \
the query against the stored statement handle associated with the supplied \
virtual database name. The statement handle needs to be prepard before this \
function is called.

Returns:

=cut
    my ($vdn, @params) = @_;
    my ($dbh, $sth) = _db_vdn('execute', $vdn);

    $sth->execute( @params )
        or sys_die( $sth->errstr );

    return 0;
}

sub db_get_sth {
=begin wiki

!3 db_get_sth

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 )

Please write this documentation.

Returns:

=cut
    my $vdn = shift;

    if ( $dbdefenvr{$vdn} ) {
        return $dbdefenvr{$vdn};
    }

    return '';
}

sub db_bindcols {
=begin wiki

!3 db_bindcols

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
#
# interface:
#   interface to sth->bind_columns()
#
# accepts:
#   1st position
#     a raw statement handle
#     a vdn which is used to obtain a default statment handle (one per vdn)
#     a vdn, named statement handle pair in the form vdn||nsth
#   remaining
#     any number of references to scalars
#
# returns:
#   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;
}

sub db_pef {
=begin wiki

!3 db_pef

Parameters: ( )

Prepare, Execute, Fetch a scalar value

This function always returns the first element of the first row of the
result set.

Returns:

=cut
    my ($vdn, $sqlname, @params) = @_;

    my $sql = sys_get_sql( $sqlname );
    db_prepare( $vdn, $sql );
    db_execute( $vdn, @params );
    my $row = db_fetchrow( $vdn );

    return @{$row}[0];
}

sub db_pef_list {
=begin wiki

!3 db_pef_list

Parameters: ( )

Prepare, Execute, Fetch a result set as a list of scalars

This function returns a list of the first element from each row of the \
result set.

Returns:

=cut
    my ($vdn, $sqlname, @params) = @_;
    my @rsalist;

    my $sql = sys_get_sql( $sqlname );
    db_prepare( $vdn, $sql );
    db_execute( $vdn, @params );
    while ( my $row = db_fetchrow( $vdn ) ) {
        push @rsalist, @{$row}[0];
    }

    return \@rsalist;  ## return result set asa list
}

sub db_fetchrow {
=begin wiki

!3 db_fetchrow

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
#
# interface:
#   interface to sth->fetchrow_arrayref()
#
# accepts:
#   a raw statement handle
#   a vdn which is used to obtain a default statment handle (one per vdn)
#   a vdn, named statement handle pair in the form vdn||nsth
#
# note:
#   If you are going to make lots of calls to db_fetchrow for the
#   same execute cycle, you will get better performance using a raw
#   statement handle over a statement handle name
#
# 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

Parameters: ( virtual_database_name )

Accept a virtual database name and perform a commit against the specified \
database connection.

Returns:

=cut
    my ($vdn) = shift;
    my ($dbh, $sth) = _db_vdn('commit', $vdn);

    $dbh->commit;
    if ( DBI->errstr ) {
        sys_die( DBI->errstr );
        return 1;   ## test harness returns from sys_die
    }
    return 0;
}

sub db_rollback {
=begin wiki

!3 db_rollback

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my ($vdn) = shift;
    my ($dbh, $sth) = _db_vdn('rollback', $vdn);

    $dbh->rollback;
    if ( DBI->errstr ) {
        sys_die( DBI->errstr );
        return 1;   ## test harness returns from sys_die
    }
    return 0;
}

sub db_rowcount_table {
=begin wiki

!3 db_rowcount_table

Parameters: ( vdn, table_name )

Accept a virtual database name and a tablename and using the table name, \
do a select count(*) query against that table to get the current rowcount.

Returns:

=cut
    my ($vdn, $table_name) = @_;
    my ($dbh, $sth) = _db_vdn('rowcount_table', $vdn);

    my $sql = "select count(*) from $table_name";
    my $count = $dbh->selectrow_array( $sql );
    return $count;
}

sub db_rowcount_query {
=begin wiki

!3 db_rowcount_query

Parameters: ( vdn, sql )

Using a supplied query that does a select count(*), get a row count. This \
function will accept optional params for the query.

Returns:

=cut
    my ($vdn, $sql, @params ) = @_;
    my ($dbh, $sth) = _db_vdn('rowcount_query', $vdn);

    if ( @params ) {
        my $tmp_sth = $dbh->prepare( $sql )
            or sys_die( $dbh->errstr );
        $tmp_sth->execute( @params )
            or sys_die( $sth->errstr );
        my @row = $tmp_sth->fetchrow_array();
        return $row[0];
    } else {
        my $count = $dbh->selectrow_array( $sql );
        return $count;
    }
}

sub db_sanity_check {
=begin wiki

!3 db_sanity_check

Parameters: ( vdn, query_name, notify )

 /vdn/        - virtual database name
 /query_name/ - name of query in job conf file
 /notify/     - send notification on warning

Verify that table contents are within acceptable range limits for a given \
column value.

This function utilizes information stored in the current job conf file. The \
query executed to perform each range limit test is passed as a parameter in \
/query_name/. That query is executed for each test stored in the \
"checkpoints" array in conf section "thereshold" in the job conf file.

A checkpoints array should be defined for each database environment. This \
function will look for a checkpoints by database environment by combining \
the name of the current database environment with the liter string \
"checkpoints". If you have four database environments, you should have \
four checkpoint entries in your job conf file. The name of the current \
database environment is determined using the function sys_get_dataenvr().

Once the range limit query and all of the checkpoint values have been \
obtained, the parameter vdn is used to execute the range limit query.

Each checkpoint entry takes the form:

COLUMN_VALUE = count:percent_deviation

The range limit query will be executed for each COLUMN_VALUE entry. The \
actual count returned will be compared to the checkpoint count, if the \
count returned is within the percent range specified by the checkpoint \
percent_deviation, the test will pass, otherwise the test will fail and a \
log warning will be generated.

A percent_deviation of 0 (zero) represents a special case. If a \
percent_deviation of 0 is used, this instructs db_sanity_check to accept \
any positive value for count as a valid value. Typically, this behavior \
would be invoked by using a column value entry of "1:0".

An expected value of 0 (zero) represents a special case as well. When the \
expected value is 0, checking for that column value will be bypassed. In \
this way you can "turn off" sanity checking for an entire database \
environment by making all of the column value entries equal to "0:0".

If the /notify/ parameter is set, a notification will be sent in addition \
to a log warning.

Returns:

=cut
    my ($vdn, $query_name, $notify) = @_;
    $notify = 0 unless $notify;

    my $warnings = 0;
    my $lead = "Sanity check:";
    my $okay = " Ok            ";
    my $outofbounds = " Out Of Bounds ";
    my $disabled = " Disabled      ";

    ## get checkpoints
    my $checkpoints;
    my $conf_entry = sys_get_dataenvr . '_checkpoints';
    if ( $conf_job{threshold}{$conf_entry} ) {
        $checkpoints = $conf_job{threshold}{$conf_entry};
    } else {
        log_warn( "No threshold checkpoints found in job conf for: $conf_entry" );
        return 1;
    }

    ## 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 ";

        if ( $exp == 0 ) {  ## checking has been disabled
            log_info( $lead . $disabled . $status );
            next;
        }

        if ( $range == 0 ) {  ## any positive value for actual is acceptable
            if ( $act > 0 ) {
                log_info( $lead . $okay . $status );
                next;
            }
            $warnings++;
            log_info( $lead . $outofbounds . $status );
            next;
        }

        if ( $act < $exp ) {  ## actual is below threshold
            if ( $act < $exp - $dev ) {
                log_info( $lead . $outofbounds . $status );
                $warnings++;
                next;
            }
        }

        if ( $act > $exp ) { ## actual is above threshold
            if ( $act > $exp + $dev ) {
                log_info( $lead . $outofbounds . $status );
                $warnings++;
                next;
            }
        }

        log_info( $lead . $okay . $status );
    }

    ## send out notifications if there are warnings
    if ( $warnings && $notify ) {
        _log_send_notifications( "WARN", 1, "Sanity check threshold exceeded" );
    }

    return 0;
}

sub db_drop_index {
=begin wiki

!3 db_drop_index

Parameters: ( vdn, index_name )

Accept a virtual database name and an index name. Drop the index identified \
by index name. If there was a database error, we check last error. If the \
last error indicates that the index we are trying to drop did not exist, \
then the error is ignored, otherwise the error is logged.

Returns:

=cut
    my ($vdn, $index_name) = @_;
    my ($dbh, $sth) = _db_vdn('drop_index', $vdn);

    my $tmp_sth = $dbh->prepare("drop index $index_name")
        or sys_die( DBI->errstr );


    $tmp_sth->execute;
    if ( DBI->err && DBI->err != 1418 ) {   ## ORA-00942: specified index does not exist
        sys_die( DBI->errstr );
    }

    return 0;
}

sub db_drop_table {
=begin wiki

!3 db_drop_table

Parameters: ( vdn, table_name )

Accept a virtual database name and a table name. Drop the table identified \
by table name. If there was a database error, we check last error. If the \
last error indicates that the table we are trying to drop did not exist, \
then the error is ignored, otherwise the error is logged.

Returns:

=cut
    my ($vdn, $table_name) = @_;
    my ($dbh, $sth) = _db_vdn('drop_table', $vdn);

    my $tmp_sth = $dbh->prepare("drop table $table_name" )
        or sys_die( DBI->errstr );

    $tmp_sth->execute;
    if ( DBI->err && DBI->err != 942 ) {   ## ORA-00942: specified table does not exist
        sys_die( DBI->errstr );
    }
    $tmp_sth->finish;
    return 0;
}

sub db_drop_procedure {
=begin wiki

!3 db_drop_procedure

Parameters: ( vdn, procedure_name )

Accept a virtual database name and a procedure name. Drop the procedure \
identified by the given name. Check the last error, if it indicates the \
procedure did not exist, then the error is ignored, otherwise the error is \
logged.

Returns:

=cut
    my ($vdn, $procedure_name) = @_;
    my ($dbh, $sth) = _db_vdn('drop_procedure', $vdn);

    my $tmp_sth = $dbh->prepare("drop procedure $procedure_name")
        or sys_die( DBI->errstr );

    $tmp_sth->execute;
    if ( DBI->err && DBI->err != 4043 ) {   ## ORA-04043: object does not exist
        sys_die( DBI->errstr );
    }
    $tmp_sth->finish;
    return 0;
}

sub db_drop_function {
=begin wiki

!3 db_drop_function

Parameters: ( $vdn, $function_name )

Accept a virtual database name and a function name. Drop the function \
identified by the given name. Check the last error, if it indicates the \
function did not exist, then the error is ignored, otherwise the error is \
logged.

Returns:

=cut
    my ($vdn, $function_name) = @_;
    my ($dbh, $sth) = _db_vdn('drop_function', $vdn);

    my $tmp_sth = $dbh->prepare("drop function $function_name")
        or sys_die( DBI->errstr );

    $tmp_sth->execute;
    if ( DBI->err && DBI->err != 4043 ) {   ## ORA-04043: object does not exist
        sys_die( DBI->errstr );
    }
    $tmp_sth->finish;
    return 0;
}

sub db_drop_package {
=begin wiki

!3 db_drop_package

Parameters: ( vdn, package_name )

Accept a virtual database name and a package name. Drop the package \
identified by the given name. Check the last error, if it indicates \
that the the package we are trying to drop did not exist, then the error \
is ignored, otherwise the error is logged.

Returns:

=cut
    my ($vdn, $package_name) = @_;
    my ($dbh, $sth) = _db_vdn('drop_package', $vdn);

    my $tmp_sth = $dbh->prepare("drop package $package_name")
        or sys_die( DBI->errstr );

    $tmp_sth->execute;
    if ( DBI->err && DBI->err != 4043 ) {   ## ORA-04043: object does not exist
        sys_die( DBI->errstr );
    }
    $tmp_sth->finish;
    return 0;
}

sub db_rename_index {
=begin wiki

!3 db_rename_index

Parameters: ( vdn, oldndxname, newndxname )

Please write the documentation.

Returns:

=cut
    my ($vdn, $oldname, $newname) = @_;
    my ($dbh, $sth) = _db_vdn('rename_index', $vdn);

    my $tmp_sth = $dbh->prepare("alter index $oldname rename to $newname")
        or sys_die( DBI->errstr );

    $tmp_sth->execute;
    if ( DBI->err ) {
        sys_die( DBI->errstr );
    }

    return 0;
}

sub db_rename_table {
=begin wiki

!3 db_rename_table

Parameters: ( vdn, oldtabname, newtabname )

Please write this documentation.

Returns:

=cut
    my ($vdn, $oldname, $newname) = @_;
    my ($dbh, $sth) = _db_vdn('rename_table', $vdn);

    my $tmp_sth = $dbh->prepare("alter table $oldname rename to $newname" )
        or sys_die( DBI->errstr );

    $tmp_sth->execute;
    if ( DBI->err ) {
        sys_die( DBI->errstr );
    }
    $tmp_sth->finish;
    return 0;
}

sub db_purge_table {
=begin wiki

!3 db_purge_table

Parameters: ( vdn, table_name )

Please write this documentations.

Returns:

=cut
    my ($vdn, $table_name) = @_;
    my ($dbh, $sth) = _db_vdn('purge_table', $vdn);

    my $tmp_sth = $dbh->prepare("purge table $table_name" )
        or sys_die( DBI->errstr );

    $tmp_sth->execute;
    if ( DBI->err && DBI->err != 38307 ) {   ## ORA-38307: object not in recycle bin
        sys_die( DBI->errstr );
    }
    $tmp_sth->finish;
    return 0;
}

sub db_purge_index {
=begin wiki

!3 db_purge_index

Parameters: ( vdn, index_name )

Please write this documentation.

Returns:

=cut
    my ($vdn, $table_name) = @_;
    my ($dbh, $sth) = _db_vdn('purge_index', $vdn);

    my $tmp_sth = $dbh->prepare("purge index $table_name")
        or sys_die( DBI->errstr );

    $tmp_sth->execute;
    if ( DBI->err && DBI->err != 38307 ) {   ## ORA-38307: object not in recycle bin
        sys_die( DBI->errstr );
    }

    return 0;
}

sub db_grant {
=begin wiki

!3 db_grant

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
   my ($vdn, $priv, $objname, $ag) = @_;
   my ($dbh, $sth) = _db_vdn('grant', $vdn);

   unless ( $priv =~ m/^r$|^u$/x ) {
       log_warn( "Privilege to db_grant must be either 'r' or 'u'" );
       return 1;
   }
   my $sql;
   if ( $priv eq 'r' ) {
      $sql = qq{begin execute immediate 'grant select on $objname to $ag'; end;};
   }
   if ( $priv eq 'u' ) {
      $sql = qq{begin execute immediate 'grant update, insert, delete on $objname to $ag'; end;};
   }

   my $tmp_sth = $dbh->prepare( $sql )
       or sys_die( DBI->errstr );
   $tmp_sth->execute
       or sys_die( DBI->errstr );
    $tmp_sth->finish;
    return 0;
}

sub db_update_statistics {
=begin wiki

!3 db_update_statistics

Parameters: ( vdn, table_name )

Please write this documentation.

Returns:

=cut
    my ($vdn, $table_name) = @_;
    my ($dbh, $sth) = _db_vdn('update_statistics', $vdn);

    unless ( _db_is_oracle($vdn) ) {
        sys_die( 'Not an Oracle database connection in db_update_statistics', 0 );
    }

    my $sql = "BEGIN dbms_stats.gather_table_stats('','"
            . "$table_name',NULL,NULL,FALSE,'FOR ALL COLUMNS SIZE 1'"
            . ",NULL,'DEFAULT',TRUE); END;";

    my $tmp_sth = $dbh->prepare( $sql );
    if ( DBI->errstr ) { sys_die( DBI->errstr ); }
    $tmp_sth->execute;
    if ( DBI->errstr ) { sys_die( DBI->errstr ); }
    $tmp_sth->finish;
    return 0;
}

sub db_insert_from_file {
=begin wiki

!3 db_insert_from_file

Parameters: ( vdn, file_name, delim )

* /vdn/       - Virtual Database Name
* /file_name/ - File containing data to read
* /delim/     - Field delimiter (can be a regex)

Accept a virtual database name, file name, and field delimiter. Insert records \
from specified file into the database table using the statement handle tied \
to the virtual database name. The file name should include full path \
information.

It is desireable to call db_init before using this function. There are several \
advanced options implemented by this function that can be configured by call \
db_init first.

By default the field delimiter is not interpreted as a Regular Expression, \
however by calling db_init first, you can make this function treat your \
delimiter as a regex, in that case the delimiter can be more than one \
character in length.

SQL used by this function should be prepared before calling this function.

Returns:

=cut
    my ($vdn, $file_name, $delim) = @_;
    my ($dbh, $sth) = _db_vdn('insert_from_file', $vdn);

    my $id = 'db_insert_from_file';
    my $TrimLead       = _is_yes($db_func_params{$id}{'TrimLead'});
    my $TrimFieldLead  = _is_yes($db_func_params{$id}{'TrimFieldLead'});
    my $TrimFieldTrail = _is_yes($db_func_params{$id}{'TrimFieldTrail'});
    my $SkipComments   = _is_yes($db_func_params{$id}{'SkipComments'});
    my $SkipLastField  = _is_yes($db_func_params{$id}{'SkipLastField'});
    my $UseRegex       = _is_yes($db_func_params{$id}{'UseRegex'});
    my $CommentChar    = $db_func_params{$id}{'CommentChar'};

    my ($count, @row);
    open my $fh, "<", $file_name or sys_die( "Error opening $file_name" );

    my $regex = "\Q$delim\E";  # escape regex meta chars
    if ( $UseRegex ) {
        $regex = $delim;  # do escaping meta chars
    }

    while ( <$fh> ) {
        my $line = $_;
        chomp $line;
        if ( $TrimLead ) {
            $line = _trim_lead($line);
        }
        if ( $SkipComments ) {
            if ( substr($line,0,1) eq $CommentChar ) { next; }
        }

        @row = split($regex,$line,-1);  # -1 preserves trailing null fields

        if ( $SkipLastField ){
            pop @row;
        }
        if ( $TrimFieldLead ) {
            for (my $i=0;$i<@row;$i++) {
                $row[$i]=_trim_lead($row[$i]);
            }
        }
        if ( $TrimFieldTrail ) {
            for (my $i=0;$i<@row;$i++) {
                $row[$i]=_trim_trail($row[$i]);
            }
        }

        $sth->execute( @row );
        if ( DBI->errstr ) {
            print DBI->errstr;
            log_warn( DBI->errstr );
            my $errrec = 'RECORD: ' . join "~", @row;
            log_warn( $errrec );
            sys_die( 'Aborting' );
        }
        $count++;
    }

    db_commit( $vdn );
    close $fh or sys_die( "Error closing $file_name" );

    return $count;
}

sub db_insert_from_query {
=begin wiki

!3 db_insert_from_query

Parameters: ( source_vdn, target_vdn )

Accept a virtual database name for a source and target databases and insert \
rows into the target database from the source database.

Note: This needs to be rewritten to use fetchrow_arrayref() instead for \
better performance.

Returns:

=cut
    my ($src_vdn, $des_vdn, $plugin) = @_;
    $plugin = 0 unless $plugin;

    ## set up array of plugins
    my @plugins;
    if ( ref $plugin eq 'ARRAY' ) {
        @plugins = map { $_ } @{$plugin};  ## copy plugin list to plugin array
    } else {
        push @plugins, $plugin;  ## copy single plugin entry to plugin array
    }

    my ($src_dbh, $src_sth) = _db_vdn('insert_from_query', $src_vdn);
    my ($des_dbh, $des_sth) = _db_vdn('insert_from_query', $des_vdn);

    my $count = 0;
    while ( my $row = $src_sth->fetchrow_arrayref() ) {   ## fetch insert loop
        my @tmprow = @{$row};

        my $plugin_result = 0;
        foreach my $plugin ( @plugins ) {  ## call each plugin
            my $result = $plugin->( \@tmprow ) if $plugin;
            if ( $result > 1000 ) { $plugin_result = 1; }  ## plugin bad return
        }
        next if $plugin_result;  ## if any plugin complains, skip the record

        $des_sth->execute( @tmprow );
        if ( DBI->errstr ) {
            log_warn( DBI->errstr );
            my $errrec = 'RECORD: ' . join "~", @{$row};
            log_warn( $errrec );
            sys_die( 'Aborting' );
        }
        $count++;
    }
    return $count;
}

sub db_query_to_file {
=begin wiki

!3 db_query_to_file

Parameters: ( vdn, file_name, delim )

Accept a virtual database name and a file name and write the result set to \
the requested file. This function should be passed a file name that includes \
full path information. The specified delimiter is used as a field separator \
when writing the result set to the file.

Plugins

Plugins can be called for each row returned in the record set. Plugins can \
return a value, any value returned that is greater than 1000 will cause the \
current record to be skiped rather than written to the output file.

Returns:

=cut
    my ($vdn, $file_name, $delim, $append, $plugin, $protect) = @_;
    $delim = '~' unless $delim;
    $append  = 0 unless $append;
    $plugin  = 0 unless $plugin;   ## unblessed ref to a plugin or ref to array
    $protect = 0 unless $protect;  ## ref to array of cols to protect

    ## set up array of plugins
    my @plugins;
    if ( ref $plugin eq 'ARRAY' ) {
        @plugins = map { $_ } @{$plugin};  ## copy plugin list to plugin array
    } else {
        push @plugins, $plugin;  ## copy single plugin entry to plugin array
    }

    my ($dbh, $sth) = _db_vdn('query_to_file', $vdn);

    my $mode;
    if ( $append ) {
        $mode = '>>';
    } else {
        $mode = '>';
    }

    my $count = 0;
    open my $fh, $mode, $file_name or sys_die( "Error opening $file_name" );
    while ( my $row = $sth->fetchrow_arrayref() ) {
        my @outrow = @{$row};

        my $plugin_result = 0;
        foreach my $plugin ( @plugins ) {  ## call each plugin in turn
            my $result = $plugin->( \@outrow ) if $plugin;
            if ( $result > 1000 ) { $plugin_result = 1; }  ## bypass this record
        }
        next if $plugin_result;

        _db_query_to_file_protect( \@outrow, $protect ) if $protect;
        print {$fh} join $delim, @outrow;
        print {$fh} "\n";
        $count++;
    }
    close $fh or sys_die( "Error closing $file_name" );

    return $count;
}

sub db_dump_query {
=begin wiki

!3 db_dump_query

Parameters: ( vdn, columns )

Accept a virtual database name and a list of column names, dump the \
query showing column names and field values.

Returns:

=cut
    my ($vdn, $cols) = @_;
    my ($dbh, $sth) = _db_vdn('dump_query', $vdn);

    while ( my @row = $sth->fetchrow_array() ) {
        print "RECORD:\n";
        for my $i ( 0 .. $#row ) {
            print "\t", $cols->[$i], '=', _db_null( $row[$i] ), "\n";
        }
    }

    return 0;
}

sub db_dump_table {
=begin wiki

!3 db_dump_table

Parameters: ( vdn, table_name, max_rows )

Accept a virtual database name and a table name, dump the contents of the \
requested table showing column names and field values. If optional paramater \
max rows is provided, query output will be limited to that many rows. There \
is an upper limit on the number of rows that this query will return, this \
is set rather high, so in most cases you should probably supply a max rows \
limit.

Returns:

=cut
    my ($vdn, $table_name, $max_rows) = @_;
    my ($dbh, $sth) = _db_vdn('dump_table', $vdn);
    $max_rows = 999_999 unless defined $max_rows;

    $table_name = uc $table_name;
    my $col_sql = "select column_name " .
                  "  from all_tab_columns " .
                  " where table_name = '$table_name'";
    my ( $tmp_sth, @cols );

    $tmp_sth = $dbh->prepare( $col_sql )
        or sys_die( DBI->errstr );
    $tmp_sth->execute
        or sys_die( DBI->errstr );
    while ( my @row = $tmp_sth->fetchrow_array() ) {
        push @cols, $row[0];
    }
    $tmp_sth->finish;

    my $columns = join ', ', @cols;
    my $tab_sql = "select $columns " .
                  "  from $table_name";
    $tmp_sth = $dbh->prepare( $tab_sql )
        or sys_die( DBI->errstr );
    $tmp_sth->execute
        or sys_die( DBI->errstr );

    my $row_count = 0;
    while ( my @row = $tmp_sth->fetchrow_array() ) {
        print "RECORD:\n";
        for my $i ( 0 .. $#row ) {
            print "\t", $cols[$i], "=", _db_null( $row[$i] ), "\n";
        }
        last if ++$row_count >= $max_rows;
    }
    $tmp_sth->finish;

    return 0;
}

sub db_sqlloader {
=begin wiki

!3 db_sqlloader

Parameters: ( vdn, datfile, ctlname, maxerrors )

* /vdn/       - Virtual Database Name
* /datfile/   - SQL*Loader data file
* /ctlname/   - Job conf key for control file input
* /maxerrors/ - Maximum number of errors allowed

This is a convenience function which provides a simplified method for calling \
the various db_sqlloader functions. This will invoke SQL*Loader and handle \
the various execution and output parsing that whould otherwise have to be \
handled by calling the db_sqlloader functions directly (which certainly you \
can if you prefer).

Execute SQL*Loader using the supplied paramaters. The Virtual Database \
Name is used to obtain login credentials. This will launch SQL*Loader \
and wait for it to finish, returning the SQL*Loader return code to the \
caller.

Data file name must be fully qualified. Path provided by data file name \
will be used for out, bad, and dis files.

Return: One of

* SQLLDR_SUCC
* SQLLDR_WARN
* SQLLDR_FAIL

=cut
    my ($vdn, $datfile, $ctlname, $maxerrors) = @_;

    my $id = 'db_sqlloader';
    my $datfilepath = $db_func_params{$id}{DatFilePath};
    my $dbenvr = $db_func_params{$id}{DbEnvr};
    my $netservice = $db_func_params{$id}{NetService};

    my $datfilefull = $datfilepath . $datfile;

    my ($sqlldr_retcd, $sqlldr_result);

    log_info( "Executing SQLLoader" );
    if ( $dbenvr =~ /$netservice/ ) {
        log_info( "Using netservice db connection symantics" );
        $sqlldr_retcd = db_sqlloaderx( "$vdn:$dbenvr", $datfilefull, $ctlname, $maxerrors );
    } else {
        log_info( "Using local db connection symantics" );
        $sqlldr_retcd = db_sqlloaderx( $vdn, $datfilefull, $ctlname, $maxerrors );
    }

    $sqlldr_result = db_sqlloaderx_parse_logfile( $datfilefull );
    log_info( "SQLLoader Output:", $sqlldr_result );

    if ( $sqlldr_retcd == $SQLLDR_SUCC ) {
        log_info( "Load data file $datfile completed successfully" );
    }
    if ( $sqlldr_retcd == $SQLLDR_WARN ) {
        log_warn( "Load data file $datfile completed with warnings" );
    }
    if ( $sqlldr_retcd == $SQLLDR_FTL || $sqlldr_retcd == $SQLLDR_FAIL ) {
        $sqlldr_retcd = $SQLLDR_FAIL;
        log_warn( "Load data file $datfile failed" );
    }

    my $rej_count = db_sqlloaderx_rejected();
    if ( $rej_count > 0 ) {
        log_warn( "SQLLoader rejected $rej_count records loading $datfile to " . sys_get_dbinst( $vdn ) );
    }

    if ( $rej_count > $maxerrors ) {
        log_warn( "SQLLoader failed loading $datfile to " . sys_get_dbinst( $vdn ) . " due to max rejected records" );
    }

    return $sqlldr_retcd;
}

sub db_sqlloaderx {
=begin wiki

!3 db_sqlloaderx

See: db_sqlloader for Parameters and Return Values.

=cut
    my ($vdn, $datfile, $ctlname, $maxerrors) = @_;

    my $defenvr = $dbdefenvr{$vdn};
    my $netservice = _db_netservice( $vdn );
    my ($db, $un, $pw) = _db_vdn('connect', $vdn);

    $maxerrors = $maxerrors || 50;

    ## validate the data file exists
    if ( ! -e $datfile ) { sys_die( "Data file $datfile not found" ); }

    ## get control file input from job conf
    my $key = $ctlname;
    my $section = 'sqlloader';
    if ( ! $conf_job{$section}{$key} ) {
        $key = 'control_file:' . $key;
        if ( ! $conf_job{$section}{$key} ) {
            sys_die( "No loader definition found in [$section] for key [$ctlname]", 0 );
        }
    }
    my $control = $conf_job{$section}{$key};

    my ($base,$path,$type) = fileparse($datfile,qr{\.dat|\.txt});
    my $ctlfile = $path.$base.'.ctl';
    my $parfile = $path.$base.'.par';
    my $badfile = $path.$base.'.bad';
    my $disfile = $path.$base.'.dis';
    my $outfile = $path.$base.'.out';

    ## build control file
    open my $fh, ">", $ctlfile || sys_die( 'Unable to create SQLLoader ctlfile', 0 );
    print $fh $control;
    close $fh;

    ## build params file
    open $fh, ">", $parfile || sys_die( 'Unable to create SQLLoader parfile', 0 );
    print $fh "userid=$un/$pw$netservice\n";
    print $fh "control=$ctlfile\n";
    print $fh "silent=(all)\n";
    print $fh "data=$datfile\n";
    print $fh "log=$outfile\n";
    print $fh "bad=$badfile\n";
    print $fh "discard=$disfile\n";
    close $fh;

    my @args = ("sqlldr", "PARFILE=$parfile errors=$maxerrors");
    system @args;
    my $sqlldr_retcd = $CHILD_ERROR >> 8;

    ## Normalize os dependent return codes. Why Oracle returns an os dependent
    ## return code from a cross-platform product is a mystery to me...
    if ( $OSNAME eq 'MSWin32' ) {
        if ( $sqlldr_retcd == 3 ) { $sqlldr_retcd = 1; }
        if ( $sqlldr_retcd == 4 ) { $sqlldr_retcd = 3; }
    }

    unlink $parfile;
    unlink $ctlfile;

    return $sqlldr_retcd;
}

sub db_sqlloaderx_parse_logfile {
=begin wiki

!3 db_sqlloaderx_parse_logfile

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my $datfile = shift;

    my ($base,$path,$type) = fileparse($datfile,qr{\.dat|\.txt});
    my $outfile = $path.$base.'.out';

    return _db_sqlloaderx_parse_logfile( $outfile );
}

sub db_sqlloaderx_skipped {
=begin wiki

!3 db_sqlloaderx_skipped

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    if ( defined $sqlloader_results{'skipped'} ) {
        return $sqlloader_results{'skipped'}
    } else {
        return -1;
    }
}

sub db_sqlloaderx_read {
=begin wiki

!3 db_sqlloaderx_read

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    if ( defined $sqlloader_results{'read'} ) {
        return $sqlloader_results{'read'}
    } else {
        return -1;
    }
}

sub db_sqlloaderx_rejected {
=begin wiki

!3 db_sqlloaderx_rejected

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    if ( defined $sqlloader_results{'rejected'} ) {
        return $sqlloader_results{'rejected'}
    } else {
        return -1;
    }
}

sub db_sqlloaderx_discarded {
=begin wiki

!3 db_sqlloaderx_discarded

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    if ( defined $sqlloader_results{'discarded'} ) {
        return $sqlloader_results{'discarded'}
    } else {
        return -1;
    }
}

sub db_sqlloaderx_elapsed_time {
=begin wiki

!3 db_sqlloaderx_elapsed_time

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    if ( defined $sqlloader_results{'elapsed_time'} ) {
        return $sqlloader_results{'elapsed_time'}
    } else {
        return 'error';
    }
}

sub db_sqlloaderx_cpu_time {
=begin wiki

!3 db_sqlloaderx_cpu_time

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    if ( defined $sqlloader_results{'cpu_time'} ) {
        return $sqlloader_results{'cpu_time'}
    } else {
        return 'error';
    }
}

sub db_func {
=begin wiki

!3 db_func

Parameters: ( )

This function executes an Oracle stored procedure that takes no input \
parameters and returns a result via RETURN. This interface is Oracle \
specific, so a check is performed to make sure that the supplied vdn is \
pointing to an Oracle database. If a database error is raised it is \
trapped and reported. The existing vdn statement handle is preserved.

Returns:

=cut
    my ($vdn, $package, $proc_name) = @_;
    my ($dbh, $sth) = _db_vdn('funcx', $vdn);

    unless ( _db_is_oracle($vdn) ) {
        sys_die( 'Not an Oracle database connection in db_funcx' );
    }

    if ( $package ) { $proc_name = $package. '.' .$proc_name; }
    my $sql = 'BEGIN :result := ' . $proc_name . '; END;';

    my $result;
    my $tmp_sth = $dbh->prepare( $sql );
    if ( DBI->errstr ) { sys_die( DBI->errstr ); }

    $tmp_sth->bind_param_inout( ':result', \$result, 100 );
    $tmp_sth->execute;
    if ( DBI->errstr ) { sys_die( DBI->errstr ); }
    $tmp_sth->finish;

    return $result;
}

sub db_proc {
=begin wiki

!3 db_proc

Parameters: ( vdn, package, proc_name )

This function executes an Oracle stored procedure that takes no input \
parameters and returns no output. This interface is Oracle specific, so a \
check is performed to make sure that the supplied vdn is pointing to an \
Oracle database. If a database error is raised it is trapped and reported. \
The existing vdn statement handle is preserved.

Returns:

=cut
    my ($vdn, $package, $proc_name) = @_;
    my ($dbh, $sth) = _db_vdn('procx', $vdn);

    unless ( _db_is_oracle($vdn) ) {
        sys_die( 'Not an Oracle database connection in db_procx' );
    }

    if ( $package ) { $proc_name = $package . '.' . $proc_name; }
    my $sql = 'BEGIN ' . $proc_name . '; END;';

    my $tmp_sth = $dbh->prepare( $sql );
    if ( DBI->errstr ) { sys_die( DBI->errstr ); }
    $tmp_sth->execute;
    if ( DBI->errstr ) { sys_die( DBI->errstr ); }
    $tmp_sth->finish;

    return 0;
}

sub db_proc_in {
=begin wiki

!3 db_proc_in

Parameters: ( vdn, package, proc_name, parameters )

This function executes an Oracle stored procedure that takes any number of \
IN parameters and returns no output. This interface is Oracle specific, so a \
check is performed to make sure that the supplied vdn is pointing to an \
Oracle database. If a database error is raised it is trapped and reported. \
The existing vdn statement handle is preserved.

Returns:

=cut
    my ($vdn, $package, $proc_name, $params) = @_;
    unless ( ref $params eq 'ARRAY' ) {
        sys_die( 'Invalid type in call to db_procx_in' );
    }
    my ($dbh, $sth) = _db_vdn('procx_in', $vdn);

    unless ( _db_is_oracle($vdn) ) {
        sys_die( 'Not an Oracle database connection in db_procx_in' );
    }

    my $sql = _db_proc_build_sql( $package, $proc_name, $params );
    my $tmp_sth = $dbh->prepare( $sql );
    if ( DBI->errstr ) { sys_die( DBI->errstr ); }

    $tmp_sth = _db_proc_bind_inparams( $tmp_sth, $params );
    $tmp_sth->execute;
    if ( DBI->errstr ) { sys_die( DBI->errstr ); }
    $tmp_sth->finish;

    return 0;
}

sub db_proc_out {
=begin wiki

!3 db_proc_out

Parameters: ( vdn, package, proc_name, parameters )

This function executes an Oracle stored procedure that takes no input and \
returns any number of OUT parameters. This interface is Oracle specific, so \
a check is performed to make sure that the supplied vdn is pointing to an \
Oracle database. If a database error is raised it is trapped and reported. \
The existing vdn statement handle is preserved.

Returns:

=cut
    my ($vdn, $package, $proc_name, $params) = @_;
    unless ( ref $params eq 'ARRAY' ) {
        sys_die( 'Invalid type in call to db_procx_out' );
    }
    my ($dbh, $sth) = _db_vdn('procx_out', $vdn);

    unless ( _db_is_oracle($vdn) ) {
        sys_die( 'Not an Oracle database connection in db_procx_out' );
    }

    my $sql = _db_proc_build_sql( $package, $proc_name, $params );
    my $tmp_sth = $dbh->prepare( $sql );
    if ( DBI->errstr ) { sys_die( DBI->errstr ); }

    $tmp_sth = _db_proc_bind_outparams( $tmp_sth, $params);
    $tmp_sth->execute;
    if ( DBI->errstr ) { sys_die( DBI->errstr ); }
    $tmp_sth->finish;

    return 0;
}

sub db_proc_inout {
=begin wiki

!3 db_proc_inout

Parameters: ( vdn, package, proc_name, parameters )

This function executes an Oracle stored procedure that takes any combination \
of IN, IN OUT, or OUT parameters. This interface is Oracle specific, so a \
check is performed to make sure that the supplied vdn is pointing to an \
Oracle database. If a database error is raised it is trapped and reported. \
The existing vdn statement handle is preserved.

Returns:

=cut
    my ($vdn, $package, $proc_name, $params) = @_;
    unless ( ref $params eq 'ARRAY' ) {
        sys_die( 'Invalid type in call to db_procx_inout' );
    }
    my ($dbh, $sth) = _db_vdn('procx_inout', $vdn);

    unless ( _db_is_oracle($vdn) ) {
        sys_die( 'Not an Oracle database connection in db_procx_inout' );
    }

    my $sql = _db_proc_build_sql( $package, $proc_name, $params );
    my $tmp_sth = $dbh->prepare( $sql );
    if ( DBI->errstr ) { sys_die( DBI->errstr ); }

    $tmp_sth = _db_proc_bind_inoutparams( $tmp_sth, $params);
    $tmp_sth->execute;
    if ( DBI->errstr ) { sys_die( DBI->errstr ); }
    $tmp_sth->finish;

    return 0;
}

sub db_dbms_output_enable {
=begin wiki

!3 db_dbms_output_enable

Parameters: ( vdn, output_buffer_size)

This function enables dbms_output in the database. You may send this \
function an output buffer size if desired. If no buffersize is provided, \
a default buffer size of 1000000 is used. This interface is Oracle specific, \
so a check is performed to make sure that the supplied vdn is pointing to \
an Oracle database.

Returns:

=cut
    my ($vdn, $bufsize) = shift;
    my ($dbh, $sth) = _db_vdn('enable_dbms_output', $vdn);

    unless ( _db_is_oracle($vdn) ) {
        sys_die( 'Not an Oracle database connection in db_dbms_output_get' );
    }

    $sys_dbms_output = 1;
    $bufsize = 1_000_000 unless $bufsize;
    $dbh->func($bufsize, 'dbms_output_enable');
    if ( DBI->errstr ) { log_warn( DBI->errstr ); return 1; }

    return 0;
}

sub db_dbms_output_disable {
=begin wiki

!3 db_dbms_output_disable

Parameters: ( vdn )

This function disables dbms_output retrieval. It does this by setting a \
module flag value. This interface is Oracle specific, so a check is \
performed to make sure that the supplied vdn is pointing to an Oracle \
database.

Returns:

=cut
    my $vdn = shift;

    unless ( _db_is_oracle($vdn) ) {
        sys_die( 'Not an Oracle database connection in db_dbms_output_get' );
    }

    $sys_dbms_output = 0;
    return 0;
}

sub db_dbms_output_get {
=begin wiki

!3 db_dbms_output_get

Parameters: ( vdn )

This function retrieves the current dbms_output buffer and returns it to \
the caller as a reference to an array. This interface is Oracle specific, \
so a check is performed to make sure that the supplied vdn is pointing to \
an Oracle database. You need to call db_dbms_output_enable first.

Returns:

=cut
    my $vdn = shift;
    my ($dbh, $sth) = _db_vdn('get_dbms_output', $vdn);

    unless ( _db_is_oracle($vdn) ) {
        sys_die( 'Not an Oracle database connection in db_dbms_output_get' );
    }

    my @arr;
    unless ( $sys_dbms_output ) {
        log_warn( 'Output option has not been enabled' );
        return \@arr;
    }

    @arr = $dbh->func('dbms_output_get');
    if ( DBI->errstr ) { log_warn( DBI->errstr ); }

    return \@arr;
}

sub db_index_rebuild {
=begin wiki

!3 db_index_rebuild

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my ($vdn, $index_name) = @_;
    my ($dbh, $sth) = _db_vdn('ora_index_rebuild', $vdn);

    unless ( _db_is_oracle($vdn) ) {
        sys_die( 'Not an Oracle database connection in function index_rebuild', 0 );
    }

    my $sql = "ALTER INDEX $index_name REBUILD";

    my $tmp_sth = $dbh->prepare( $sql );
    if ( DBI->errstr ) { sys_die( DBI->errstr ); }

    $tmp_sth->execute;
    if ( DBI->errstr ) { sys_die( DBI->errstr ); }

    $tmp_sth->finish;
    return 0;
}

sub db_exchange_partition {
=begin wiki

!3 db_exchange_partition

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my ($vdn, $to_table, $from_table, $partition) = @_;
    my ($dbh, $sth) = _db_vdn('ora_swap_partition', $vdn);

    unless ( _db_is_oracle($vdn) ) {
        sys_die( 'Not an Oracle database connection in function swap_partition', 0 );
    }

    ## REPAIR REQUIRED need to figure out why this is required...
    db_commit( $vdn );
    sleep 3;

    my $sql = "ALTER TABLE $to_table "
            . "EXCHANGE PARTITION $partition "
            . "WITH TABLE $from_table "
            . "INCLUDING INDEXES "
            . "WITH VALIDATION";

    my $tmp_sth = $dbh->prepare( $sql );
    if ( DBI->errstr ) { sys_die( DBI->errstr ); }

    $tmp_sth->execute;
    if ( DBI->errstr ) { sys_die( DBI->errstr ); }

    $tmp_sth->finish;
    return 0;
}

=begin wiki

!2 Utility Functions

These functions provide the general purpose file access capabilities.

=cut

sub util_get_filename_load {
=begin wiki

!3 util_get_filename_load

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my ($base, $ext) = @_;
    my $filename = $base . '.' . $ext;
    if ( $osuser ) {
        $filename = $base . '_' . $osuser . '.' . $ext;
    }
    return $path_load_dir . $filename;
}

sub util_get_filename_extr {
=begin wiki

!3 util_get_filename_extr

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my ($base, $ext) = @_;
    my $filename = $base . '.' . $ext;
    if ( $osuser ) {
        $filename = $base . '_' . $osuser . '.' . $ext;
    }
    return $path_extr_dir . $filename;
}

sub util_get_filename_log {
=begin wiki

!3 util_get_filename_log

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my $base = shift;
    return $path_log_dir . $base . $log_ext;
}

sub util_read_header {
=begin wiki

!3 util_read_header

Parameters: ( filename, format )

Please write this documentation.

Returns:

=cut
    my ($filename, $format) = @_;
    my $fh = File::Bidirectional->new($filename, {origin => 1} )
        or sys_die( "Unable to open file $filename" );
    my $head = $fh->readline();
    $fh->close;
    return $head;
}

sub util_read_footer {
=begin wiki

!3 util_read_footer

Parameters: ( filename, format_string )

Please write this documentation.

Returns:

=cut
    my ($filename, $format) = @_;
    my $fh = File::Bidirectional->new($filename, {origin => -1} )
        or sys_die( "Unable to open file $filename" );
    my $foot = $fh->readline();
    $fh->close;
    return $foot;
}

sub util_read_file {
=begin wiki

Parameters: ( )

Slurp a file in one go and return a return a reference to the text contained \
in the file.

Returns:

=cut
    my $file = shift;
    open( my $fh, $file ) or return 0;
    my $text = do { local( $/ ) ; <$fh> } ;
    return \$text;
}

sub util_write_header {
=begin wiki

!3 util_write_header

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my ($filename, $header, $append) = @_;
    $header = 'HEADER' unless $header;
    my $mode = ">>";
    $mode = ">" unless $append;
    open my $fh, $mode, $filename or sys_die( "Error writing header to $filename" );
    print {$fh} "$header\n";
    close $fh or sys_die( "Error closing $filename" );
    return 0;
}

sub util_write_footer {
=begin wiki

!3 util_write_footer

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my ($filename, $footer) = @_;
    $footer = 'FOOTER' unless $footer;
    open my $fh, ">>", $filename or sys_die( "Error writing footer to $filename" );
    print {$fh} "$footer\n";
    close $fh or sys_die( "Error closing $filename" );
    return 0;
}

sub util_move {
=begin wiki

Parameters: ( )

The move function also takes two parameters: the current name and the \
intended name of the file to be moved. If the destination already exists \
and is a directory, and the source is not a directory, then the source \
file will be renamed into the directory specified by the destination.

If possible, move() will simply rename the file. Otherwise, it copies the \
file to the new location and deletes the original. If an error occurs \
during this copy-and-delete process, you may be left with a (possibly \
partial) copy of the file under the destination name.

Returns:

=cut
    my ($from, $to) = @_;

    return 0 unless $util_move;
    my $result = move($from, $to);
    return $result;
}

sub util_trim {
    my $str = shift;
    $str =~ s/^\s+//;
    $str =~ s/\s+$//;
    return $str;
}

sub util_zsdf {
=begin wiki

Parameters: ( )

This regex was taken from the book "Regular Expression Recipes", by Nathan \
A. Good. The idea for util_zsdf (Zero Supress Decimal Format) came from my \
first mentor, Ed Bowlen.

Returns:

=cut
    my ($number, $width) = @_;
    $number =~ s/(?<=\d)(?=(\d{3})+(?!\d))/,/g;
    return sprintf '%*s', $width, $number;
}

=begin wiki

!2 Testing Functions

These functions some basic test capabilities. These can be used to write simple
database test scripts.

=cut

sub test_init {
=begin wiki

!3 test_init

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    $t_ok       = 0;
    $t_notok    = 0;
    return 0;
}

sub test_ok {
=begin wiki

!3 test_ok

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my ($actual,$expected,$description) = @_;

    $t_num++;
    if ($actual eq $expected) {
        $t_ok++;
        log_info("ok $t_num");
    } else {
        $t_notok++;
        sys_set_errorlevel(sys_get_errorlevel()+1);
        log_info("not ok $t_num - $description");
    }

    return 0;
}

sub test_results {
=begin wiki

!3 test_results

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    log_info("Test script: passed $t_ok, failed $t_notok");
    if ( $t_notok == 0 ) {
        log_info("Test script: PASS");
    } else {
        log_info("Test script: FAIL");
    }
    return 0;
}

sub test_harness_init {
=begin wiki

!3 test_harness_init

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    $th_num = 0;
    return 0;
}

sub test_harness_run {
=begin wiki

!3 test_harness_run

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my $test_scripts = shift;

    foreach my $ts ( @{$test_scripts} ) {
        $th_num++;
        log_info("Test script: $ts");
        my $retcd = sys_run_job($ts, 8, '-r', '-v');
        if ( $retcd > 0 ) {
            sys_set_errorlevel( sys_get_errorlevel() + $retcd );
        }
    }

    return 0;
}

sub test_harness_results {
=begin wiki

!3 test_harness_results

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my $test_scripts = shift;

    my ($ts_passed, $ts_failed);
    my $th_result = 'PASS';
    my $th_passed = 0;
    my $th_failed = 0;

    foreach my $ts ( @{$test_scripts} ) {
        $ts =~ s/\.pl$//;
        my $tsfull = util_get_filename_log( $ts );
        my $log = util_read_file( $tsfull );
        if ( ! $log ) {
            log_info( "Error reading log for test script: $ts" );
            next;
        }

        $ts_passed = 0;
        $ts_failed = 0;
        $th_num++;

        $$log =~ m#.{19,19} Test script: (PASS|FAIL|DUBIOUS)#;
        my $ts_result = $1;

        $$log =~ m#.{19,19} Test script: passed (\d+), failed (\d+)#;
        $ts_passed = $1;
        $ts_failed = $2;

        if ( $ts_result eq 'PASS' ) {
            $th_passed++;
        }
        if ( $ts_result eq 'FAIL' ) {
            $th_failed++;
            $th_result = 'FAIL';
        }

        log_info( "Test harness: script $ts, passed $ts_passed, failed $ts_failed, $ts_result" );
    }

    log_info( "Test harness: passed $th_passed, failed $th_failed" );
    log_info( "Test harness: $th_result" );

    return 0;
}

sub test_harness_summary {
=begin wiki

!3 test_harness_summary

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my $test_harnesses = shift;

    foreach my $th ( @{$test_harnesses} ) {
        $th =~ s/\.pl$//;
        my $thfull = util_get_filename_log( $th );
        my $log = util_read_file( $thfull );
        if ( ! $log ) {
            log_info( "Error reading log for test harness: $th" );
            next;
        }

        log_info( "Test harness summary: $th" );

    }

    return 0;
}

# private methods
# -----------------------------------------------------------------------------

=begin wiki

!2 Private Functions

These functions provide internal module support.

=cut

sub _sys_init_vars {
=begin wiki

!3 _sys_init_vars

Parameters: ( )

This function provides variable initialization for a particular jobname. \
Once sys_init has been called with a jobname, this function is called to \
initialize or reinitialize system variables. It is possible, although not \
recommended, to stack jobs in a single perl script. my callling sys_init with \
different jobnames each time. This feature has not been thoroughly tested.

Returns:

=cut
    $pid = $PROCESS_ID;
    $errorlevel = 0;
    @plugins = ();
    $sys_dbms_output = 1;
    $sys_log_open = 0;
    $sys_jobconf_override = 0;
    $sys_jobconf_file = '';

    %log_level_opts = (
        FATAL => 'FATAL',
        ERROR => 'FATAL,ERROR',
        WARN  => 'FATAL,ERROR,WARN',
        INFO  => 'FATAL,ERROR,WARN,INFO',
        DEBUG => 'FATAL,ERROR,WARN,INFO,DEBUG',
        NONE  => 'NONE',
    );

    _sys_read_conf( 'sys_data.conf' );
    _sys_read_conf( 'sys_log.conf' );
    _sys_read_conf( 'sys_mail.conf' );
    _sys_read_conf( 'sys_common.conf' );
    _sys_read_conf( 'sys_util.conf' );
    _sys_read_conf( 'sys_environment.conf' );
    _sys_read_conf( 'sys_de.conf');
    _sys_read_conf( 'sys_run_controls.conf');

    my $envvar = uc $conf_system{'system'}{'envvar'};
    $dataenvr = lc $ENV{$envvar};
    if ( ! defined $dataenvr ) {
        sys_die( "Environment variable $dataenvr not set", 0 );
    }

    $path_bin_dir       = $conf_system{"$OSNAME directory bin"}{$dataenvr};
    $path_lib_dir       = $conf_system{"$OSNAME directory lib"}{$dataenvr};
    $path_log_dir       = $conf_system{"$OSNAME directory log"}{$dataenvr};
    $path_load_dir      = $conf_system{"$OSNAME directory load"}{$dataenvr};
    $path_extr_dir      = $conf_system{"$OSNAME directory extr"}{$dataenvr};
    $path_prev_dir      = $conf_system{"$OSNAME directory prev"}{$dataenvr};
    $path_scripts_dir   = $conf_system{"$OSNAME directory scripts"}{$dataenvr};
    $mail_server        = $conf_mail{'mail'}{'server'};
    $mail_from          = $conf_mail{'mail'}{'from'};
    $mail_emailto       = $conf_mail{'mail'}{'emailto'};
    $mail_pagerto       = $conf_mail{'mail'}{'pagerto'};
    $mail_email_levels  = $conf_mail{'mail'}{'email_levels'} || "FATAL";
    $mail_pager_levels  = $conf_mail{'mail'}{'pager_levels'} || "FATAL";
    $log_file           = $conf_log{'log'}{'default_logfile'};
    $log_filefull       = $path_log_dir . $log_file;
    $log_logging_levels = $conf_log{'log'}{'logging_levels'} || "FATAL,ERROR,WARN,INFO";
    $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;
}

sub _sys_job_init {
=begin wiki

!3 _sys_job_init

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my $rtconf = $path_conf_dir.'/'.$jobname.'.'.$pid.'.running';

    ## create runtime conf file
    open my $cfile, '>', $rtconf or sys_die( "Error creating runtime jobconf file" );
    close $cfile;

    my $conf = new Config::IniFiles( -file => $rtconf );
    unless ( defined $conf ) { sys_die( "Error opening runtime jobconf file" ); }

    my $starttime = time;
    $conf->newval( 'pid', 'pid', $pid );
    $conf->newval( 'starttime', 'starttime', $starttime );
    $conf->newval( 'restart', 'restart', 0 );
    $conf->RewriteConfig;
    return 0;
}

sub _sys_job_end {
=begin wiki

!3 _sys_job_end

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my $rtconf = $path_conf_dir.'/'.$jobname.'.'.$pid.'.running';
    if ( -e $rtconf ) {
        unlink $rtconf;
    }
    return 0;
}

sub _sys_job_dependent {
=begin wiki

!3 _sys_job_dependent

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my $dependent_jobname = shift;
    return 0 unless $dependent_jobname;

    my $conf = new Config::IniFiles( -file => $path_conf_dir.'/sys_environment.conf' );
    unless ( defined $conf ) { sys_die( "Error opening sys_environment.conf (4)" ); }
    my $params = join '~', $conf->Parameters( 'jobs' );
    if ( $params =~ m/$dependent_jobname/x ) {   ## case sensitive
        ## one or more instances of dependent job is currently running
        log_info( "Job name $dependent_jobname is active in the system, waiting" );
        return 1;
    }
    return 0;
}

sub _sys_read_conf {
=begin wiki

!3 _sys_read_conf

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my $conf = shift;
    my $conf_filefull = $path_conf_dir . '/' . $conf;

    my $msg1 = "Probably syntax error, unable to load";

    if ( $conf =~ m/^sys_data/x ) {
        tie %conf_data, 'Config::IniFiles', ( -file => $conf_filefull )
            or sys_die( "$msg1 data conf: $conf", 0 );
    }
    if ( $conf =~ m/^sys_log/x ) {
        tie %conf_log, 'Config::IniFiles', ( -file => $conf_filefull )
            or sys_die( "$msg1 log conf: $conf", 0 );
    }
    if ( $conf =~ m/^sys_mail/x ) {
        tie %conf_mail, 'Config::IniFiles', ( -file => $conf_filefull )
            or sys_die( "$msg1 mail conf: $conf", 0 );
    }
    if ( $conf =~ m/^sys_common/x ) {
        tie %conf_query, 'Config::IniFiles', ( -file => $conf_filefull )
            or sys_die( "$msg1 query conf: $conf", 0 );
    }
    if ( $conf =~ m/^sys_util/x ) {
        tie %conf_util, 'Config::IniFiles', ( -file => $conf_filefull )
            or sys_die( "$msg1 util conf: $conf", 0 );
    }
    if ( $conf =~ m/^sys_environment/x ) {
        tie %conf_system, 'Config::IniFiles', ( -file => $conf_filefull )
            or sys_die( "$msg1 environment conf: $conf", 0 );
    }
    if ( $conf =~ m/^sys_test/x ) {
        tie %conf_job, 'Config::IniFiles', ( -file => $conf_filefull )
            or sys_die( "$msg1 test conf: $conf", 0 );
    }
    if ( $conf =~ m/^sys_de/x ) {
        tie %conf_de, 'Config::IniFiles', ( -file => $conf_filefull )
            or sys_die( "$msg1 de conf: $conf", 0 );
    }
    if ( $conf =~ m/^sys_run_controls/x ) {
        tie %conf_rcontrols, 'Config::IniFiles', ( -file => $conf_filefull )
            or sys_die( "$msg1 run controls conf: $conf", 0 );
    }
    ## job specific conf file
    if ( $conf !~ m/^sys_/x ) {
        tie %conf_job, 'Config::IniFiles', ( -file => $conf_filefull )
            or sys_die( "$msg1 job conf: $conf", 0 );
    }
    return 0;
}

sub _sys_read_job {
=begin wiki

!3 _sys_read_job

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    if ( $conf_job{job}{'logfile'} ) {
        $log_file = $conf_job{job}{'logfile'};
    }
    if ( $conf_job{job}{'logging_levels'} ) {
        $log_logging_levels = $conf_job{job}{'logging_levels'};
    }
    if ( $conf_job{job}{'console_levels'} ) {
        $log_console_levels = $conf_job{job}{'console_levels'};
    }
    if ( $conf_job{job}{'log_gdg'} ) {
        $log_gdg = $conf_job{job}{'log_gdg'};
    }
    if ( $conf_job{job}{'log_prefix'} ) {
        $log_prefix = $conf_job{job}{'log_prefix'};
    }
    if ( $conf_job{job}{'emailto'} ) {
        $mail_emailto = $conf_job{job}{'emailto'};
    }
    if ( $conf_job{job}{'pagerto'} ) {
        $mail_pagerto = $conf_job{job}{'pagerto'};
    }
    if ( $conf_job{job}{'email_levels'} ) {
        $mail_email_levels = $conf_job{job}{'email_levels'};
    }
    if ( $conf_job{job}{'pager_levels'} ) {
        $mail_pager_levels = $conf_job{job}{'pager_levels'};
    }
    return 0;
}

sub _sys_init_source_validation {
=begin wiki

!3 _sys_init_source_validation

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    open my $fh, "<", $script_filefull
        || sys_die( "Unable to open $script_file for validatation", 0 );
    my @r = <$fh>;
    close $fh;
    my $source = join '', @r;

    my $errm1 = "$script_file failed source validation, id tag ";
    my $errm2 = "$script_file failed source validation, pod section ";
    my $errm3 = " is missing or invalid";
    my $checkfor;

    $checkfor = "FILENAME";
    $source =~ m/^\#\#@@.*/m
        or sys_die( $errm1.$checkfor.$errm3, 0 );

    $checkfor = "SOURCETITLE";
    $source =~ m/^\#\#\$\$.*/m
        or sys_die( $errm1.$checkfor.$errm3, 0 );

    $checkfor = "NAME";
    $source =~ m/^!1 $checkfor\n\n[A-Za-z]/m
        or sys_die( $errm2.$checkfor.$errm3, 1 );

    $checkfor = "DESCRIPTION";
    $source =~ m/^!1 $checkfor\n\n[A-Za-z]/m
        or sys_die( $errm2.$checkfor.$errm3, 1 );

    $checkfor = "RECOVERY NOTES";
    $source =~ m/^!1 $checkfor\n\n[A-Za-z]/m
        or sys_die( $errm2.$checkfor.$errm3, 1 );

    $checkfor = "ENVIRONMENT NOTES";
    $source =~ m/^!1 $checkfor\n\n[A-Za-z]/m
        or sys_die( $errm2.$checkfor.$errm3, 1 );

    $checkfor = "DEPENDENCIES";
    $source =~ m/^!1 $checkfor\n\n[A-Za-z]/m
        or sys_die( $errm2.$checkfor.$errm3, 1 );

    $checkfor = "HISTORY";
    $source =~ m/^!1 $checkfor\n\n[A-Za-z0-9\*]/m
        or sys_die( $errm2.$checkfor.$errm3, 1 );

    return 0;
}

sub _sys_run_background {
=begin wiki

!3 _sys_run_background

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    if ( $OSNAME eq 'MSWin32' ) {
        sys_die( 'Background run mode not available on Windows', 0 );
    }
    $opt_commandline =~ s{-rb }{-r };
    $opt_commandline =~ s{-rb$}{-r};
    print "$script_filefull $opt_commandline".' &';
    exit 0;
}

sub _sys_run_scheduled {
=begin wiki

!3 _sys_run_scheduled

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    ## this die is temporary should use sys_die
    die "Not yet implemented\n\n";
}

sub _sys_run_de {
=begin wiki

!3 _sys_run_de

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my $de = shift;
    my $conf_file = $jobname . '.' . $de . '.conf';
    _sys_read_conf( $conf_file );  ## tie %conf_job to job specific conf file
    _sys_read_job();  ## read job specific settings from %conf_job
    return 0;
}

sub _sys_run_restart {
=begin wiki

!3 _sys_run_restart

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    ## this die is temporary should use sys_die
    die "Not yet implemented\n\n";
}

sub _sys_forkexec {
=begin wiki

!3 _sys_forkexec

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my ($jobname, @params) = @_;
    my $pid;
    if ( $pid = fork ) {
        return $pid;
        ## this is the parent, so return the pid, everything below here is
        ## either the child or a major system failure
    }
    elsif ( defined $pid ) {
        exec $jobname, @params;
        ## shouldn't reach this unless exec fails, we exit here (not return)
        ## becuase we are in the child
        exit 0;
    } else {
        log_warn( "Could not fork $!" );
        return 0;
    }
}

sub _sys_reap_child {
=begin wiki

!3 _sys_reap_child

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my $pid = 0;
    if ( ($pid = waitpid(-1, 0)) > 0 ) {
        $pidlib{$pid}{retcd} = $? >> 8;
    }
    return $pid;
}

sub _sys_test_dbcon {
=begin wiki

!3 _sys_test_dbcon

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";
    }
    exit 0;
}

sub _sys_check_severity_levels {
=begin wiki

!3 _sys_check_severity_levels

Parameters: ( p1, p2, p3 )

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';
            return $lvls_str;
        }
        if ( $lvls_str =~ /^ERROR$/i ) {
            $lvls_str = 'FATAL,ERROR';
            return $lvls_str;
        }
        if ( $lvls_str =~ /^WARN$/i ) {
            $lvls_str = 'FATAL,ERROR,WARN';
            return $lvls_str;
        }
        if ( $lvls_str =~ /^INFO$/i ) {
            $lvls_str = 'FATAL,ERROR,WARN,INFO';
            return $lvls_str;
        }
        if ( $lvls_str =~ /^DEBUG$/i ) {
            $lvls_str = 'FATAL,ERROR,WARN,INFO,DEBUG';
            return $lvls_str;
        }
        if ( $lvls_str =~ /^NONE$/i ) {
            $lvls_str = '';
            return $lvls_str;
        }
        sys_die( 'Invalid logging/notification severity level', 0 );
    }
    return 0;
}

sub _sys_check_log_gdg {
=begin wiki

!3 _sys_check_log_gdg

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    if ( $opt_log_gdg =~ /[0-9]{1,3}/ ) {
        sys_die( 'Invalid log gdg specified', 0 );
    }
    return $opt_log_gdg;
}

sub _sys_check_log_radix {
=begin wiki

!3 _sys_check_log_radix

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    if ( $opt_log_radix < 1 || $opt_log_radix > 4 ) {
        sys_die( 'Invalid log radix specified', 0 );
    }
    return $opt_log_radix;
}

sub _sys_check_de_override {
=begin wiki

!3 _sys_check_de_override

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my $tmp_jobname = shift;
    my $tmp_jobconf_file = $tmp_jobname;
    my $delist = $conf_de{jobname}{$tmp_jobname};
    if ( $delist ) {   ## possible override of job conf
        my $de = '0000';
        if ( $delist =~ /(\d\d\d\d\d)\s?$/ ) {
            $de = $1;
        }
        my $overenvs = $conf_de{$de}{'env'};
        if ( $overenvs =~ /$dataenvr/i ) {
            ## as a side-effect, sys_jobconf_override gets set here...
            $sys_jobconf_override = 1;   ## so we know override is effective
            $tmp_jobconf_file .= ".$de";
        }
    }
    return $tmp_jobconf_file;
}

sub _sys_disp_logprev {
=begin wiki

!3 _sys_disp_logprev

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    if ( $opt_log_file ) { $log_file = $opt_log_file; }
    $log_filefull = $path_log_dir . $log_file;
    if ( -e $log_filefull ) {
        print "Log: $log_filefull\n";
        system "cat $log_filefull";
        print "\n";
        exit 0;
    }
    print "No previous log file found\n\n";
    return 0;
}

sub _sys_disp_logarch {
=begin wiki

!3 _sys_disp_logarch

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    if ( $opt_log_file ) { $log_file = $opt_log_file; }
    $log_filefull = $path_log_dir . $log_file;
    my @logs = glob $log_filefull . '.*';
    if ( @logs ) {
        foreach my $log ( sort @logs ) {
            print "Log: $log\n";
            system "cat $log";
        }
        print "\n";
        exit 0;
    }
    print "No archived log files found\n\n";
    return 0;
}

sub _sys_disp_jobs {
=begin wiki

!3 _sys_disp_jobs

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my @jobs = glob $path_bin_dir.'*.pl';
    if ( @jobs ) {
        foreach my $job ( sort @jobs ) {
            my $description = 'No description found';
            open my $fh, "<", $job or sys_die( "Unable to open $job", 0 );
            while ( <$fh> ) {
                chomp;
                if ( /^\#\#\$\$/ ) {
                    $description = substr $_, 4;
                }
            }
            close $fh;
            $job =~ s{^\/.*\/}{};
            print "Job: $job\n";
            print "     $description\n";
        }
        print "\n";
        exit 0;
    }
    print "No archived job files found\n\n";
    return 0;
}

sub _sys_disp_active_jobs {
=begin wiki

!3 _sys_disp_active_jobs

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my $logging = shift;  ## needs implementing

    my @actjobs = glob $path_conf_dir.'/*.running';
    print 'Jobs currently active: ' . scalar @actjobs . "\n";
    if ( @actjobs ) {
        foreach my $job ( sort @actjobs ) {
            my $conf = new Config::IniFiles( -file => $job );
            unless ( defined $conf ) { sys_die( "Error opening $job" ); }
            my $pid = $conf->val( 'pid', 'pid' );
            ## NOTE: use Unix::PID to determine if pid is still runninng...
            ## If pid is no longer running, replace "Job:" with "???:".
            my $starttime = $conf->val( 'starttime', 'starttime' );
            my $fmtdtime = time2str( '%Y/%m/%d %T', $starttime );
            $job =~ s{^\/.*\/}{};
            $job =~ s{\.\d+\.running$}{};
            print "Job: $job\n";
            print "     pid=$pid\n";
            print "     starttime=$fmtdtime\n";
            $conf = undef;
        }
    }
    print "\n";
    exit 0;
}

sub _sys_disp_doc {
=begin wiki

!3 _sys_disp_doc

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    if ( -e $script_filefull ) {
        my %podparams = (
            infile  => $script_filefull,
            outfile => "STDOUT",
        );
        wikipod2text( %podparams );
    } else {
        print "File not found $script_filefull\n\n";
    }
    exit 0;
}

sub _sys_disp_sql {
=begin wiki

!3 _sys_disp_sql

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my @query_names = keys %{$conf_query{$jobname}};
    if ( @query_names ) {
        foreach my $query_name ( sort @query_names ) {
            my $query = $conf_query{$jobname}{$query_name};
            print "Query: $query_name\n";
            print $query;
            print "\n\n";
        }
    } else {
        print "No querys found\n\n";
    }
    exit 0;
}

sub _sys_disp_params {
=begin wiki

!3 _sys_disp_params

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my $dblen = 0;
    foreach my $db ( @databases ) {
        if ( length $dbname{$db} > $dblen ) { $dblen = length $dbname{$db}; }
    }
    print "\n" . uc($dataenvr) . " Database Connections:\n";
    foreach my $db ( @databases ) {
        my $dbstr =  sprintf "%-${dblen}s", $dbname{$db};
        $dbstr .= ' = ' . $db . '/' . $dbdefenvr{$db};
        print "    $dbstr\n",;
    }

    print "\n" . uc($dataenvr) . " Job Settings:\n";
    print "    Job Name           = ", $jobname, "\n";
    print "    Log File           = ", $log_file, "\n";
    print "    Log Logging Levels = ", $log_logging_levels, "\n";
    print "    Log Console Levels = ", $log_console_levels, "\n";
    print "    Log Gdg            = ", $log_gdg, "\n";
    print "    Path Bin Dir       = ", $path_bin_dir, "\n";
    print "    Path Log Dir       = ", $path_log_dir, "\n";
    print "    Path Lib Dir       = ", $path_lib_dir, "\n";
    print "    Path Conf Dir      = ", $path_conf_dir, "\n";
    print "    Path Plugin Dir    = ", $path_plugin_dir, "\n";
    print "    Path Load Dir      = ", $path_load_dir, "\n";
    print "    path Extract Dir   = ", $path_extr_dir, "\n";
    print "    path Prev Dir      = ", $path_prev_dir, "\n";
    print "    path Scripts Dir   = ", $path_scripts_dir, "\n";
    print "    Mail Server        = ", $mail_server, "\n";
    print "    Mail Email From    = ", $mail_from, "\n";
    print "    Mail Email To      = ", $mail_emailto, "\n";
    print "    Mail Pager To      = ", $mail_pagerto, "\n";
    print "    Mail Email Levels  = ", $mail_email_levels, "\n";
    print "    Mail Pager Levels  = ", $mail_pager_levels, "\n";
    print "\n";
    exit 0;
}

sub _sys_send_email_message {
=begin wiki

!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

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my $verbose = shift;
    $verbose = 0 unless $verbose;
    my $section;

    if ( $verbose == 0 ) {
        print "\nUSAGE\n      $script_file [options]\n\n";
        print "Use option -h   for help with options\n";
        print "Use option -hp  for help with option parameters\n";
        print "Use option -man for system documentation\n";
        exit 1;
    }

    if ( $verbose == 1 ) { $section = 'OPTIONS'; };
    if ( $verbose == 2 ) { $section = 'ARGUMENTS'; };

    print "\n";
    my %podparams = (
        infile  => $path_lib_dir."DBIx/JCL.pm",
        outfile => "STDOUT",
        section => $section,
    );
    wikipod2text( %podparams );
    exit 1;
}

sub _log_init_log_file {
=begin wiki

!3 _log_init_log_file

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    ## log file rotation if generations > 0
    if ( -e $log_filefull && $log_gdg > 0 ) {
        _log_rotate();
    }

    ## create new locked log file
    ## if the file is already locked, will wait until the file is unlocked
    my $fh = new IO::LockedFile(">$log_filefull")
        or sys_die( 'Failed opening log file', 0 );
    ## close and unlock the file
    $fh->close();

    $sys_log_open = 1;

    return 0;
}

sub _log_write_to_log {
=begin wiki

!3 _log_write_to_log

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my ($level, $force, $msg, $exmsg) = @_;
    my ($message,$exmessage);

    if ( ref $exmsg eq 'ARRAY' ) {
        my $lead = ' ' x 18;
        $lead .= '+ ';
        my @output = map { $lead . $_ . "\n" } @{$exmsg};
        my $exmessage = join '', @output;
        $exmessage =~ s/\n$//ms;
        $message = $msg . "\n" . $exmessage;
    } else {
        $message = $msg;
        $message =~ s/\n/ /g;
    }

    if ( $log_logging_levels =~ /$level/ || $force ) {
        _log_print_log( $level, $message );
    }

    _log_send_notifications( $level, $force, $msg );

    return 0;
}

sub _log_write_to_screen {
=begin wiki

!3 _log_write_to_screen

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my ($level, $force, $msg, $exmsg) = @_;
    my ($message,$exmessage);

    if ( ref $exmsg eq 'ARRAY' ) {
        my $lead = ' ' x 18;
        $lead .= '+ ';
        my @output = map { $lead . $_ . "\n" } @{$exmsg};
        my $exmessage = join '', @output;
        $message = $msg . "\n" . $exmessage;
    } else {
        $message = $msg;
        $message =~ s/\n/ /g;
    }

    $message = _log_trim_msg( $message );

    if ( $opt_verbose ) {
        print "$message\n";
    } else {
        if ( $log_console_levels =~ /$level/ || $force ) {
            print "$message\n";
        }
    }

    return 0;
}

sub _log_print_log {
=begin wiki

!3 _log_print_log

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my ($level, $message) = @_;

    my $preamble = time2str( '%Y/%m/%d %T', time );
    if ( $level eq 'FATAL' ) { $preamble .= ' FATAL'; }
    if ( $level eq 'ERROR' ) { $preamble .= ' ERROR'; }
    if ( $level eq 'WARN'  ) { $preamble .= ' WARNING'; }

    ## open locked log file for appending
    ## if the file is already locked, will wait until the file is unlocked
    my $fh = new IO::LockedFile(">>$log_filefull")
        or sys_die( 'Failed opening log file', 0 );
    print {$fh} "$preamble $message\n";
    ## close and unlock the file
    $fh->close();
    return 0;
}

sub _log_trim_msg {
=begin wiki

!3 _log_trim_msg

Parameters: ( message )

Format log file text so that it looks good when printed to STDOUT.  This \
function is only called from the logging functions. This takes message \
text that was previously retrieved by dbms_output_get and stringified by \
a logging function and removes the leading whitespace from each line of \
text, if there is any. This is made necessary due to the fact that this \
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;
}

sub _log_send_notifications {
=begin wiki

!3 _log_send_notifications

Parameters: ( message, severity_level )

Send email and pager notifications based on supplied severity. If the \
severity levels for email and or pager notifications are at or below the \
severity level supplied to this function, a notification will be sent.

Note: if running under test harness (different than test mode), all \
messages are logged, but no notifications of any severity will be generated. \
Generation of actual email and pager notices is not testable using the test \
harness.

Returns:

=cut
    my ($level, $force, $message) = @_;

#    if ( $tst_harness ) {
#        return 0;
#    }

    if ( $mail_email_levels =~ /$level/ || $force ) {
        _log_send_mail( $message, $level );
    }
    if ( $mail_pager_levels =~ /$level/ || $force ) {
        _log_send_page( $message, $level );
    }
    return 0;
}

sub _log_send_mail {
=begin wiki

!3 _log_send_mail

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my ($message, $severity) = @_;
    return 0 unless $mail_emailto;
    return 0 if $mail_emailto =~ /NONE/i;

    my ($subject, $job);

    if ( $severity eq 'MESSAGE' ) {
        $subject = 'Message from ' . uc $dataenvr;
    } else {
        $subject = uc($dataenvr). ' Batch Notice';
        $message = time2str("%Y/%m/%d %H:%M:%S : ", time) . uc($severity) . " : $script_file : $message";
    }

    ## get the log file contents and append to message
    if ( ! $severity eq 'MESSAGE' ) {
        if ( -e $log_filefull ) {
            $message .= "\nLog Entries:\n";
            open my $fh, "<", $log_filefull;
            while ( <$fh> ) {
                $message .= $_;
            }
            close $fh;
        }
    }

    MIME::Lite->send('smtp', $mail_server, Timeout => 60);

    my $msg = MIME::Lite->new(
        From     => $mail_from,
        To       => $mail_emailto,
        Subject  => $subject,
        Data     => $message
    );
    $msg->send;
    return 0;
}

sub _log_send_page {
=begin wiki

!3 _log_send_page

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my ($message, $severity) = @_;
    return 0 unless $mail_pagerto;
    return 0 if $mail_pagerto =~ /NONE/i;

    my ($subject, $job);

    if ( $severity eq 'MESSAGE' ) {
        $subject = 'Message from ' . uc $dataenvr;
    } else {
        my $subject = uc($dataenvr). ' Batch Notice';
        $message = time2str("%Y/%m/%d %H:%M:%S : ", time) . uc($severity) . " : $script_file : $message";
    }

    MIME::Lite->send('smtp', $mail_server, Timeout => 60);

    my $msg = MIME::Lite->new(
        From     => $mail_from,
        To       => $mail_pagerto,
        Subject  => $subject,
        Data     => $message
    );
    $msg->send;
    return 0;
}

sub _log_rotate {
=begin wiki

!3 _log_rotate

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my ($prev,$next,$i,$j);

    my $curr = $log_filefull;
    my $currn = $curr;

    for ($i = $log_gdg; $i > 1; $i--) {
        $j = $i - 1;
            my $nextgen = sprintf("%0${log_radix}d", $i);
            my $prevgen = sprintf("%0${log_radix}d", $j);
            $next = "${currn}." . $nextgen; ##. $ext;
            $prev = "${currn}." . $prevgen; ##. $ext;
        if ( -r $prev && -f $prev ) {
            move($prev,$next) or sys_die( "Log move failed: ($prev,$next)" );
        }
    }

    ## copy current to next incremental
    my $nextgen = sprintf("%0${log_radix}d", 1);
    $next = "${currn}." . $nextgen;
    copy($curr, $next);

    ## preserve permissions and status
    my @stat = stat $curr;
    chmod( $stat[2], $next )           or sys_warn( "log chmod failed: ($next)" );
    utime( $stat[8], $stat[9], $next ) or sys_warn( "log utime failed: ($next)" );
    chown( $stat[4], $stat[5], $next ) or sys_warn( "log chown failed: ($next)" );

    ## now truncate the file
    truncate $curr, 0 or sys_die( "Could not truncate $curr" );

    return 0;
}

sub _db_connect_check_dependent {
=begin wiki

!3 _db_connect_check_dependent

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my ($dependent_jobname,$wait_duration,$wait_max_secs,$wait_action) = @_;
    my $starttime = time;
    while ( 1 ) {
        if ( _sys_job_dependent($dependent_jobname) ) {
            sleep $wait_duration;
            my $curtime = time;
            if ( $curtime - $starttime > $wait_max_secs ) {
                if ( $wait_action =~ m/^run$/ix ) {
                    log_info( "Maximum dependent job wait time exceeded, starting" );
                    last;
                } else {
                    sys_die( "Maximum dependent job wait time exceeded, aborting" );
                    return 1;   ## reachable if $sys_test_harness
                }
            }
        } else {
            last;
        }
    }
    return 0;
}

sub _db_connect_retry {
=begin wiki

!3 _db_connect_retry

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my ($db,$un,$pw,$retry_duration,$retry_max_secs) = @_;
    my $dbh = 0;
    my $starttime = time;
    while ( 1 ) {
        $dbh = DBI->connect( $db, $un, $pw, { RaiseError => 0, AutoCommit => 0 } );
        if ( DBI->errstr ) {
            if ( $retry_max_secs < 1 ) {
                sys_die( DBI->errstr );
                return 1;   ## reachable if $sys_test_harness
            }
            if ( DBI->err == 1017 ) {   ## ora invalid account or password
                sys_die( DBI->errstr );
                return 1;   ## reachable if $sys_test_harness
            }
            log_info( DBI->errstr );
            log_info( "Connection retry requested, waiting" );
            sleep $retry_duration;
            my $curtime = time;
            if ( $curtime - $starttime > $retry_max_secs ) {
                sys_die( "Maximum connection retry time exceeded, aborting" );
                return 1;   ## reachable if $sys_test_harness
            }
        } else {
            last;
        }
    }
    return $dbh;
}

sub _db_vdn {
=begin wiki

!3 _db_vdn

Parameters: ( caller_id_string, vdn )

This function accepts a caller id string and a virtual database name. A \
virtual database name is a text string which identifies a database \
connection. If we are running in test mode and the caller is not the \
db_connect function, this function will gracefully shut-down. Otherwise \
it returns either raw database connection information or it returns the \
appropriate database handle and statement handle for the named database.

Returns:

=cut
    my ($caller, $vdn) = @_;

    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'
    if ( $caller eq 'connect' ) {
        my $database = $dbconn{$this_db}{$this_inst}{'database'};
        my $username = $dbconn{$this_db}{$this_inst}{'username'};
        my $password = $dbconn{$this_db}{$this_inst}{'password'};
        return ($database, $username, $password);
    }

#    ## shutdown gracefully if running under the 'test connections' flag
#    if ( $opt_test ) {
#        log_close( "End connection test: $jobname" );
#        sys_end();
#        exit 0;
#    }

    ## return database and statement handles for this vdn
    my $dbh = $dbhandles{$this_db}{'dbh'};
    my $sth = $dbhandles{$vdn}{$sth_name};
    return ($dbh, $sth);
}

sub _db_netservice {
=begin wiki

!3 _db_netservice

Parameters: ( vdn )

This function accepts a virtual database name that contains an explicit \
instance. A virtual database name is a text string which identifies a \
database connection. The "network service", i.e., remote database \
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

!3 _db_proc_build_sql

Parameters: ( package_name, procedure_name, parameters)

* /parameters/ - parameters is a reference to an array

This function builds a sql statement to execute an Oracle Stored Procedure. \
The sql statement uses generated variable names, e.g., :p1, :p2, :p3, etc. \
This works because functions that use this sql statement all pass parameters \
to the requested stored procedure positionally. The function accepts a \
reference to an array of param in parameters. This is used only to get a \
count of the number of parameters in the procedure's signature.

Returns:

=cut
    my ($package, $proc_name, $params) = @_;
    my $numparams = scalar @{$params};
    if ( $package ) { $proc_name = $package . '.' . $proc_name; }

    my $sql = 'BEGIN ' . $proc_name . '(';
    for my $i ( 0 .. $numparams - 1 ) {
        $sql .= ':p'.$i;
        if ( $i < $numparams - 1 ) { $sql .= ','; }
    }
    $sql .= '); END;';
    return $sql;
}

sub _db_sqlloaderx_parse_logfile {
=begin wiki

!3 _db_sqlloaderx_parse_logfile

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my $logfile = shift;
    %sqlloader_results = ();  ## hash of SQL*Loader results

    ## default values
    $sqlloader_results{'skipped'}      = "Problem obtaining value";
    $sqlloader_results{'read'}         = $sqlloader_results{'skipped'};
    $sqlloader_results{'rejected'}     = $sqlloader_results{'skipped'};
    $sqlloader_results{'discarded'}    = $sqlloader_results{'skipped'};
    $sqlloader_results{'elapsed_time'} = $sqlloader_results{'skipped'};
    $sqlloader_results{'cpu_time'}     = $sqlloader_results{'skipped'};

    my $log = new IO::File "<$logfile";
    if (! defined $log) {
        sys_warn( "Failed to open SQL*Loader log file $logfile" );
        return 1;
    }

    ## skip the first line, check the second for the SQL*Loader declaration
    my $line = <$log>;
    $line = <$log>;
    unless ($line =~ /^SQL\*Loader/) {
        sys_warn( 'File does not appear to be a valid SQL*Loader log file' );
        return 1;
    }

    while (<$log>) {
        chomp;
        if ( m/^Total logical records skipped:\s+(\d+)/ ) {
            $sqlloader_results{'skipped'} = $1;
            next;
        }
        if ( m/^Total logical records read:\s+(\d+)/ ) {
            $sqlloader_results{'read'} = $1;
            next;
        }
        if ( m/^Total logical records rejected:\s+(\d+)/ ) {
            $sqlloader_results{'rejected'} = $1;
            next;
        }
        if ( m/^Total logical records discarded:\s+(\d+)/ ) {
            $sqlloader_results{'discarded'} = $1;
            next;
        }
        if( m/^Elapsed time was:\s+(.+)/ ) {
            $sqlloader_results{'elapsed_time'} = $1;
            next;
        }
        if( m/^CPU time was:\s+(.+)/ ) {
            $sqlloader_results{'cpu_time'} = $1;
            next;
        }
    }

    $log->close;

    my @results;

    push @results, "Skipped: "      . $sqlloader_results{'skipped'};
    push @results, "Read: "         . $sqlloader_results{'read'};
    push @results, "Rejected: "     . $sqlloader_results{'rejected'};
    push @results, "Discarded: "    . $sqlloader_results{'discarded'};
    push @results, "Elapsed Time: " . $sqlloader_results{'elapsed_time'};
    push @results, "CPU Time: "     . $sqlloader_results{'cpu_time'};

    ## return ref to array of results
    return \@results;
}

sub _db_proc_bind_inparams {
=begin wiki

!3 _db_proc_bind_inparams

Parameters: ( statement_handle, parameters )

This function binds parameters to a prepared statement. The parameters are \
passed as a ref to an array. This uses the same parameter names as those \
defined by the build_sql function. All parameters are bound as type IN \
parameters.

Returns:

=cut
    my ($sth, $params) = @_;
    my $numparams = scalar @{$params};

    for my $i ( 0 .. $numparams - 1 ) {
        my $var = ':p'.$i;
        $sth->bind_param( $var, ${$params}[$i] );
    }
    return $sth;
}

sub _db_proc_bind_outparams {
=begin wiki

!3 _db_proc_bind_outparams

Parameters ( )

This function binds parameters to a prepared statement. The parameters are \
passed as a ref to an array. This uses the same parameter names as those \
defined by the build_sql function. All parameters are bound as type IN \
OUT/OUT parameters.

Returns:

=cut
    my ($sth, $params) = @_;
    my $numparams = scalar @{$params};

    for my $i ( 0 .. $numparams - 1 ) {
        my $var = ':p'.$i;
        $sth->bind_param_inout( $var, @{$params}[$i], 100 );
    }
    return $sth;
}

sub _db_proc_bind_inoutparams {
=begin wiki

!3 _db_proc_bind_inoutparams

Parameters: ( )

This function binds parameters to a prepared statement. The parameters are \
passed as a ref to an array. This uses the same parameter names as those \
defined by the build_sql function. All parameters are bound as type IN or \
as type IN OUT/OUT. If the user passes a ref as an array member, that element \
will be bound as IN OUT/OUT. If the users passes a scalar as an array member, \
that element will be bound as a type IN parameter.

Returns:

=cut
    my ($sth, $params) = @_;
    my $numparams = scalar @{$params};

    for my $i ( 0 .. $numparams - 1 ) {
        my $var = ':p'.$i;
        if ( ref @{$params}[$i] eq 'SCALAR' ) {
            $sth->bind_param_inout( $var, @{$params}[$i], 100 );
        } else {
            $sth->bind_param( $var, ${$params}[$i] );
        }
    }
    return $sth;
}

sub _db_is_oracle {
=begin wiki

!3 _db_is_oracle

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my $vdn = shift;
    my $inst = $dbdefenvr{$vdn};
    my $database = $dbconn{$vdn}{$inst}{'database'};  ## e.g., dbi:Oracle:myinst
    if ( $database=~ /^dbi:Oracle:/ ) {
        return 1;
    }
    return 0;
}

sub _db_null {
=begin wiki

!3 _db_null

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my $val = shift;
    return '' unless defined $val;
    return $val;
}

sub _db_query_to_file_protect {
=begin wiki

!3 _db_query_to_file_protect

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my ($row, $protect) = @_;

    return 0 if scalar @{$protect} < 1;

    foreach my $i ( @{$protect} ) {
        my $len = length @{$row}[$i];
        my $fil = '*'x$len;
        @{$row}[$i] = $fil;
    }

    return 0;
}

sub _check_array_val {
=begin wiki

!3 _check_array_val

Parameters: ( p1, p2, p3 )

Please write this documentation.

Returns:

=cut
    my ($val, $arr) = @_;
    if ( grep { $_ eq $val } @{$arr} ) {
        return 1;
    }
    return 0;
}

sub _trim {
=begin wiki

!3 _trim

Parameters: ( str )

Trim leading and trailing spaces from a string. Return the trimmed string.

Returns:

=cut
    my $str = shift;
    $str =~ s/^\s+//;
    $str =~ s/\s+$//;
    return $str;
}

sub _trim_lead {
=begin wiki

!3 _trim_lead

Parameters: ( str )

Trim leading spaces from a string. Return the trimmed string.

=cut
    my $str = shift;
    $str =~ s/^\s+//;
    return $str;
}

sub _trim_trail {
=begin wiki

!3 _trim_trail

Parameters: ( str )

Trim trailing spaces from a string. Return the trimmed string.

Results:

=cut
    my $str = shift;
    $str =~ s/\s+$//;
    return $str;
}

sub _is_yes {
=begin wiki

!3 _is_yes

Parameters: ( str )

Examing a string and determine if the string indicates 'YES'. The string is \
examined as case insensitive and must be either a 'y' or 'yes'. If so, the \
function returns true (1), otherwise it returns false (0).

You can use this as a conversion function to make tests simpler using a \
technique like this:

 % language=Perl
 % my $truth = 'Y';
 % $truth = _is_yes( $truth );
 % # later
 % if ( $truth ) {
 %     # do something
 % }
 %%

=cut
    my $str = shift;
    if ( $str =~ /^y$|^yes$/i ) { return 1; }
    return 0;
}

sub _is_no {
=begin wiki

!3 _is_no

Parameters: ( str )

Examing a string and determine if the string indicates 'NO'. The string is \
examined as case insensitive and must be either a 'n' or 'no' exactly. If so, \
the function returns true (1), otherwise it returns false (0).

Returns:

=cut
    my $str = shift;
    if ( $str =~ /^n$|^no$/i ) { return 1; }
    return 0;
}

sub END {
=begin wiki

!3 END

Parameters: None

Close all open statement handles and database handles. Statement handles and \
Database handles are stored for us by the database connection function. The \
end function in each loaded plugin is also called here. They are called in \
reverse load order. Send exit notifications if any have been requested.

Returns:

=cut
    ## remove job information from sys_environment.conf
    _sys_job_end();

    ## 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 ) {
        _log_send_page($msg, 'MESSAGE' );
    }
}

1;

=begin wiki

----

!1 Dependencies

The following modules are all used by DBIx-JCL.

* English
* Getopt::Long
* Config::IniFiles
* IO::File
* IO::Handle
* IO::LockedFile
* Fcntl
* File::Copy
* File::Bidirectional
* File::Basename
* MIME::Lite
* Date::Format
* Pod::WikiText
* DBI

----

!1 Incompatibilities

None currently documented. Please feel free to notify the author if you have \
concern that you would like to see addressed.

----

!1 Test Support

There are a number of test functions built-in to DBIx-JCL. Please see the \
function reference section for descriptions of all the testing functions.

----

!1 Tips

Here are some tips for using job scripts. (A job script is any perl script \
that uses the DBIx-JCL Module.

!2 Verbose and Very Verbose

If you are running jobs from the console and you want tactile feedback, use \
the Verbose C<-v> option. If your job is failing and your not sure why, turn \
on the Very Verbose C<-vv> option. Very Verbose gives you everything that \
Verbose gives you, plus more.

!2 Required Options

A "Run job" option is always required. This is to avoid accidentally invoking \
a job script.

!2 Built-in Display Features

There are several built-in display features that you will find useful. When \
you use the Help option, C<-h> and C<-ha>, these will be listed under the \
heading of "Information Options". The most useful is possibly the C<-dl> \
option, which will display the last log file generated by the script that you \
are currently running.

!2 Use the Test Options

Use the /-t/ option to invoke the job script and run it to the point of \
database connection and then exit after database connections have been made.

Use the /-tc/ option to test any database connection interactively without \
invoking the current job script. Very handy for diagnostic purposes.

!2 Multiple Database Connections

You can set up jobs that make multiple connections to the same database. To \
do that, you simply add another set of connection parameters in your data.conf \
file. So if for example you have a database named 'xyz1' in your list of \
databases in %data.conf%, add another database named 'xyz2' and duplicate all \
other connection parameters from 'xyz1' under the new key 'xyz2'.

!2 Global Variables

There are a number of global variables that are automatically imported into \
your script's namespace. These are listed below with a brief explanation of \
each.

* %$path_bin_dir        # path to bin directory%
* %$path_lib_dir        # path to lib directory%
* %$path_log_dir        # path to log directory%
* %$path_load_dir       # path to load directory%
* %$path_extr_dir       # path to extract directo%ry
* %$path_prev_dir       # path to store previous vrsion files%
* %$path_scripts_dir    # path to scripts directory%
* %$mail_server         # mail server address%
* %$mail_from           # from email address%
* %$mail_emailto        # email to address list%
* %$mail_pagerto        # pager to address list%
* %$mail_email_levels   # log levels which initiate email notifications%
* %$mail_pager_levels   # log levels which initiate pager notifications%
* %$log_file            # log file filename%
* %$log_filefull        # full path to log filename%
* %$log_logging_levels  # log levels which initiate log mesages%
* %$log_console_levels  # log levels which initiate console messages%
* %$log_gdg             # number of log archive files to maintain%

Default values for all of these are defined in system conf files. The value \
of many of these can be set at runtime using command line options.

A special global variable defines the current database environment. This is \
the $dataenvr variable.

----

!1 Source Code Validation

In order to help maintain consistency across an entire library of job \
scripts. Several aspects of script files are check for compliance before \
the job will be executed. The following rules are checked before a job \
will be run by DBIx-JCL

/Header Checks/

There must be valid %##@@% and %##$$% statements. These statements can be \
used to help manage script libraries. The %##$$% statement is also used by \
the display jobs option to provide a brief description of each job.

/Documentation Checks/

There needs to be valid Pod containing at least a DESCRIPTION section, a \
RECOVERY NOTES section, and a DEPENDENCIES section in each job script.

----

!1 File And Directory Permissions

This information is here to document one approach to file and directory \
permissions. You should not adopt these for your use without careful \
consideration and testing.

All files owned by the account which processes batch jobs should be set to \
permission level 750, which will give owner rwx, group r-x, and all others no \
access.

 % language=Ini_Files
 % >chmod 750 filename
 %
 % 7 - owner permissions (rwx) i.e., read & write & execute
 % 5 - group permissions (r-x) i.e., read & execute
 % 0 - world permissions (---) i.e., none
 %%

All directories owned by the account which processes batch jobs should \
normally be set to permission level 750.

Permission reference table:

|0 |--- |no access|
|1 |--x |execute|
|2 |-w- |write|
|3 |-wx |write and execute|
|4 |r-- |read|
|5 |r-x |read and execute|
|6 |rw- |read and write|
|7 |rwx |read write execute (full access)|

----

!1 Plugins

DBIx-JCL supports plugin modules using a simple plugin architecture. This \
will allow you to write your own modules and have them loaded at runtime to \
provide additional functionality for your job scripts. For example, you might \
want to write a module that uses http to turn off your web site before some \
processing in your batch job occurs.

Plugin modules are simple Perl modules with no exported functions or \
variables. Here is a trivial example of a plugin module:

 % language=Perl
 % package TestPlugin1;
 %
 % use strict;
 % use warnings;
 %
 % my $tp_num = 0;
 %
 % sub start {
 %     my ($path_conf_dir, $path_plugin_dir, $dataenvr) = @_;
 %     $tp_num = 100;
 %     print "TestPlugin1 start function\n";
 % }
 %
 % sub plugin_main {
 %     my $n = shift;
 %     $tp_num += $n;
 %     return $tp_num;
 % }
 %
 % sub tp_add {
 %     my $n = shift;
 %     $tp_num += $n;
 %     return $tp_num;
 % }
 %
 % sub end {
 %     print "TestPlugin1 end function\n";
 % }
 %
 % 1;
 %%

There are three functions that plugin modules are required to implement, a \
C, a C, and an C. The start and end functions \
are called automatically for you on load and script termination. The address \
to the C function is returned to you when your plugin is \
loaded. All of your plugin code can be implemented in C, or in \
additional functions that you supply. The decision will vary depending on \
your plugin's needs. All functions in your plugin module are callable, but \
the symantics vary.

!2 Loading your plugin

Your plugin is loaded using the C function. This function \
takes two parameters, The file name used by your plugin (without the .pm \
extension) and the package name used by your plugin. All plugins need to be \
installed in a plugins directory which has been specified in the system.conf \
file. For example, if you created the plugin shown above and placed it in a \
file named TestPlugin1.pm, you would load the plugin like this:

    sys_init_plugin( 'TestPlugin1', 'TestPlugin1' );

or

    my $plugin1 = 'TestPlugin1';
    sys_init_plugin( $plugin1, $plugin1 );

!2 Calling functions in plugin modules

There are three ways (probably more) to call functions in your plugin.

B>

Use the fully qualified package name and function name.

    sys_init_plugin( 'TestPlugin1', 'TestPlugin1' );

later

    TestPlugin1::tp_add(1);

B>

If you are going to call your plugin from serveral places in your script, \
you might prefer to take this approach.

    sys_init_plugin( 'TestPlugin1', 'TestPlugin1' );
    my $plug_1 = \&TestPlugin1::tp_add;

later

    $plug_1->(1);

B>

Probably the simplest approach it to implement as much of your plugin's code \
as possible within the C function. Then use the supplied \
coderef to execute your plugin.

    my $plug1 = sys_init_plugin( 'TestPlugin1', 'TestPlugin1' );

later

    $plug1->(1);

----

!1 Exported Variables

The following variables are available for use in job scripts and are \
exported by default.

|!Variable             |Mod?|Description|
|%$path_bin_dir%       |No  |path to bin directory|
|%$path_lib_dir%       |No  |path to lib directory|
|%$path_log_dir%       |No  |path to log directory|
|%$path_load_dir%      |No  |path to load data directory|
|%$path_extr_dir%      |No  |path to extract data directory|
|%$path_prev_dir%      |No  |path to previous version files|
|%$path_scripts_dir%   |No  |path to scripts directory|
|%$mail_server%        |.   |mail server|
|%$mail_from%          |.   |mail from address|
|%$mail_emailto%       |.   |email to address list|
|%$mail_pagerto%       |.   |pager to address list|
|%$mail_email_levels%  |.   |email severity/notification levels|
|%$mail_pager_levels%  |.   |pager severity/notification levels|
|%$log_file%           |No  |name of log file|
|%$log_filefull%       |No  |full name including path of log file|
|%$log_logging_levels% |.   |severity levels for log file logging|
|%$log_console_levels% |.   |severity levels for console logging|
|%$log_gdg%            |.   |number of generations for log archiving|
|%$dataenvr%           |No  |environment variable which holds default datbase/instance |
|%$commandline_ext%    |No  |extra command variables passed to job script|
|%$errorlevel%         |No  |.|

Variables with "No" should not be modified.

----

!1 Bugs And Limitations

Please report all bugs to the author. Every attempt will be made to \
incorporate bug fixes into future releases of this package.

----

!1 Author

Brad Adkins [e-mail].

You may contact the author regarding this module at [e-mail].

----

!1 License And Copyright

Copyright (c) 2008, Brad Adkins. All rights reserved.

This software may be freely distributed under the same terms as Perl itself.

----
=cut