view release on metacpan or  search on metacpan

lib/ASNMTAP/Asnmtap/Applications.pm  view on Meta::CPAN

sub DBI_connect {
  my ($database, $server, $port, $user, $passwd, $alarm, $DBI_error_trap, $DBI_error_trap_Arguments, $logger, $debug, $boolean_debug_all) = @_;

  $$logger->info(" IN: DBI_connect: port: $port - alarm: $alarm") if ( defined $$logger and $$logger->is_info() );

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

  sub _DBI_handle_error {
    my ($error, $dbh) = @_;

    no warnings;
    print "     _DBI_handle_error: $error\n";
    $$logger->error("     _DBI_handle_error: $error");
    use warnings;
  }

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

  my ($rv, $dbh, $alarmMessage) = 1;

  unless ( $alarm ) {
    $$logger->info("     DBI_connect: NO SIGNAL") if ( defined $$logger and $$logger->is_info() );

    if ( $boolean_debug_all ) {
      $dbh = DBIx::Log4perl->connect("dbi:mysql:$database:$server:$port", "$user", "$passwd", { RaiseError => 0, PrintError => 1, ShowErrorStatement => 1 } ) or $rv = $DBI_error_trap->(@{$DBI_error_trap_Arguments}, $logger, $debug);
      $dbh->dbix_l4p_getattr('dbix_l4p_logger'); # $$logger = $dbh->dbix_l4p_getattr('dbix_l4p_logger');
    } else {
      $dbh = DBI->connect("dbi:mysql:$database:$server:$port", "$user", "$passwd", { RaiseError => 1, PrintError => 0, ShowErrorStatement => 1 } ) or $rv = $DBI_error_trap->(@{$DBI_error_trap_Arguments}, $logger, $debug);
    }
  } else {
    $$logger->info("     DBI_connect: SIGNAL") if ( defined $$logger and $$logger->is_info() );

    use POSIX ':signal_h';
    my $DBI_CONNECT_ALARM_OFF = 0;
    my $_mask      = POSIX::SigAction->new ( SIGALRM ); # list of signals to mask in the handler
    my $_actionNew = POSIX::SigAction->new ( sub { $DBI_CONNECT_ALARM_OFF = $alarm; die "DBI_CONNECT_ALARM_OFF = $alarm\n"; }, $_mask );
    my $_actionOld = POSIX::SigAction->new ();
    sigaction ( SIGALRM, $_actionNew, $_actionOld );

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

    eval {
      $DBI_CONNECT_ALARM_OFF = 1;
      alarm($alarm);

      if ( $boolean_debug_all ) {
        $dbh = DBIx::Log4perl->connect("dbi:mysql:$database:$server:$port", "$user", "$passwd", { RaiseError => 0, PrintError => 1, ShowErrorStatement => 1 } ) or $rv = $DBI_error_trap->(@{$DBI_error_trap_Arguments}, $logger, $debug);
        $dbh->dbix_l4p_getattr('dbix_l4p_logger'); # $$logger = $dbh->dbix_l4p_getattr('dbix_l4p_logger');
      } else {
        $dbh = DBI->connect("dbi:mysql:$database:$server:$port", "$user", "$passwd", { RaiseError => 1, PrintError => 0, ShowErrorStatement => 1 } ) or $rv = $DBI_error_trap->(@{$DBI_error_trap_Arguments}, $logger, $debug);
      }

      alarm(0);
      $DBI_CONNECT_ALARM_OFF = 0;
    };

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

    alarm(0);
    sigaction( SIGALRM, $_actionOld ); # restore original signal handler

    if ( $DBI_CONNECT_ALARM_OFF ) {
      $dbh = undef;
      $rv = $DBI_error_trap->(@{$DBI_error_trap_Arguments}, $logger, $debug);
      $alarmMessage = "DBI_CONNECT_ALARM_OFF = $DBI_CONNECT_ALARM_OFF";
      $$logger->debug("     DBI_CONNECT_ALARM_OFF: Connection to '$database' timed out") if ( defined $$logger and $$logger->is_debug() );
    }
  }

  # set up error handling
  $dbh->{HandleError} = sub { _DBI_handle_error(@_) } if ( defined $dbh and $rv );

  $$logger->info('OUT: DBI_connect') if ( defined $$logger and $$logger->is_info() );
  return ($dbh, $rv, $alarmMessage);
}

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

sub DBI_do {
  my ($rv, $dbh, $statement, $alarm, $DBI_error_trap, $DBI_error_trap_Arguments, $logger, $debug) = @_;

  $$logger->info(" IN: DBI_do: rv: $rv - alarm: $alarm") if ( defined $$logger and $$logger->is_info() );
  my ($affected, $alarmMessage) = (0);

  if ( $rv ) {
    unless ( $alarm ) {
      $$logger->info("     DBI_do: NO SIGNAL") if ( defined $$logger and $$logger->is_info() );
      $affected = $$dbh->do($statement) or $rv = $DBI_error_trap->(@{$DBI_error_trap_Arguments}, $logger, $debug);
    } else {
      $$logger->info("     DBI_do: SIGNAL") if ( defined $$logger and $$logger->is_info() );

      use POSIX ':signal_h';
      my $DBI_DO_ALARM_OFF = 0;
      my $_mask      = POSIX::SigAction->new ( SIGALRM ); # list of signals to mask in the handler
      my $_actionNew = POSIX::SigAction->new ( sub { $DBI_DO_ALARM_OFF = $alarm; die "DBI_DO_ALARM_OFF = $alarm\n"; }, $_mask );
      my $_actionOld = POSIX::SigAction->new ();
      sigaction ( SIGALRM, $_actionNew, $_actionOld );

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

      eval {
        $DBI_DO_ALARM_OFF = 1;
        alarm($alarm);
        $affected = $$dbh->do($statement) or $rv = $DBI_error_trap->(@{$DBI_error_trap_Arguments}, $logger, $debug);
        alarm(0);
        $DBI_DO_ALARM_OFF = 0;
      };

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

      alarm(0);
      sigaction( SIGALRM, $_actionOld ); # restore original signal handler

      if ( $DBI_DO_ALARM_OFF ) {
        $rv = $DBI_error_trap->(@{$DBI_error_trap_Arguments}, $logger, $debug);
        $alarmMessage = "DBI_DO_ALARM_OFF = $DBI_DO_ALARM_OFF";
        $$logger->debug("     DBI_DO_ALARM_OFF: dbh->do timed out") if ( defined $$logger and $$logger->is_debug() );
      }
    }
  }

  $$logger->info("OUT: DBI_do") if ( defined $$logger and $$logger->is_info() );
  return ( $rv, $alarmMessage, $affected );
}

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

sub DBI_execute {
  my ($rv, $sth, $alarm, $DBI_error_trap, $DBI_error_trap_Arguments, $logger, $debug) = @_;

  $$logger->info(" IN: DBI_execute: rv: $rv - alarm: $alarm") if ( defined $$logger and $$logger->is_info() );
  my $alarmMessage;

  if ( $rv ) {
    unless ( $alarm ) {
      $$logger->info("     DBI_execute: NO SIGNAL") if ( defined $$logger and $$logger->is_info() );
      $$sth->execute() or $rv = $DBI_error_trap->(@{$DBI_error_trap_Arguments}, $logger, $debug);
    } else {
      $$logger->info("     DBI_execute: SIGNAL") if ( defined $$logger and $$logger->is_info() );

      use POSIX ':signal_h';
      my $DBI_EXECUTE_ALARM_OFF = 0;
      my $_mask      = POSIX::SigAction->new ( SIGALRM ); # list of signals to mask in the handler
      my $_actionNew = POSIX::SigAction->new ( sub { $DBI_EXECUTE_ALARM_OFF = $alarm; die "DBI_EXECUTE_ALARM_OFF = $alarm\n"; }, $_mask );
      my $_actionOld = POSIX::SigAction->new ();
      sigaction ( SIGALRM, $_actionNew, $_actionOld );

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

      eval {
        $DBI_EXECUTE_ALARM_OFF = 1;
        alarm($alarm);
        $$sth->execute() or $rv = $DBI_error_trap->(@{$DBI_error_trap_Arguments}, $logger, $debug);
        alarm(0);
        $DBI_EXECUTE_ALARM_OFF = 0;
      };

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

      alarm(0);
      sigaction( SIGALRM, $_actionOld ); # restore original signal handler

      if ( $DBI_EXECUTE_ALARM_OFF ) {
        $rv = $DBI_error_trap->(@{$DBI_error_trap_Arguments}, $logger, $debug);
        $alarmMessage = "DBI_EXECUTE_ALARM_OFF = $DBI_EXECUTE_ALARM_OFF";
        $$logger->debug("     DBI_EXECUTE_ALARM_OFF: sth->execute timed out") if ( defined $$logger and $$logger->is_debug() );
      }
    }
  }

  $$logger->info("OUT: DBI_execute") if ( defined $$logger and $$logger->is_info() );
  return ( $rv, $alarmMessage );
}

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

sub DBI_error_trap {
  my ($EMAILREPORT, $error_message, $logger, $debug) = @_;

  use Scalar::Util qw(openhandle);
  my $error = "  > DBI Error:\n" .$error_message. "\nERROR: $DBI::err ($DBI::errstr)\n";
  if ( ! $debug and defined $EMAILREPORT and openhandle($EMAILREPORT) ) { print $EMAILREPORT $error; } else { print $error; }
  $$logger->info("DBI Error:" .$error_message. "ERROR: $DBI::err ($DBI::errstr)") if ( defined $$logger and $$logger->is_info() );
  return 0;
}

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

sub LOG_init_log4perl {
  my ($item, $config, $boolean_debug_all) = @_;

  my $logger;

  if ( $boolean_debug_all ) {
    eval {
      use Log::Log4perl qw(get_logger);
      use DBIx::Log4perl;

      if ( -e "$APPLICATIONPATH/log4perl.cnf" ) {
        Log::Log4perl->init_and_watch("$APPLICATIONPATH/log4perl.cnf", 'HUP');
      } else {
        my $log4perl_cnf;

        if ( defined $config ) {
          $log4perl_cnf = $config;
        } else {
          $log4perl_cnf = qq(
            log4perl.logger                       = TRACE, LOGFILE, LOGSCREEN

            log4perl.appender.LOGFILE             = Log::Log4perl::Appender::File
            log4perl.appender.LOGFILE.filename    = $LOGPATH/root.log
            log4perl.appender.LOGFILE.mode        = append
            log4perl.appender.LOGFILE.Threshold   = ERROR
            log4perl.appender.LOGFILE.layout      = PatternLayout
            log4perl.appender.LOGFILE.layout.ConversionPattern = [%d] %F %L %c - %m%n

            log4perl.appender.LOGSCREEN           = Log::Log4perl::Appender::Screen
            log4perl.appender.LOGSCREEN.stderr    = 0
            log4perl.appender.LOGSCREEN.layout    = PatternLayout
            log4perl.appender.LOGSCREEN.layout.ConversionPattern = [%d] %F %L %c - %m%n