view release on metacpan or  search on metacpan

lib/DBIx/JCL.pm  view on Meta::CPAN

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