ASNMTAP

 view release on metacpan or  search on metacpan

applications/archive.pl  view on Meta::CPAN

        } else {
          print EMAILREPORT "\nTable: '$SERVERTABLEVENTS', Year: '$year' Quarter: 'Q$quarter', Status: MERGE\n";
          $sql = 'DROP TABLE IF EXISTS `'. $SERVERTABLEVENTS .'_'. $year .'_Q'. $quarter .'`';
          $dbh->do( $sql ) or $rv = errorTrapDBI("Cannot dbh->do: $sql", $debug);

          if ($rv) {
            $sql = 'CREATE TABLE IF NOT EXISTS `'. $SERVERTABLEVENTS .'_'. $year .'_Q'. $quarter .'` LIKE `'. $SERVERTABLEVENTS .'_'. $year .'_'. sprintf ("%02d", ($quarter * 3 ) - 2) .'`';
            $dbh->do( $sql ) or $rv = errorTrapDBI("Cannot dbh->do: $sql", $debug);
          }

          if ($rv) {
            $sql = 'ALTER TABLE `'. $SERVERTABLEVENTS .'_'. $year .'_Q'. $quarter .'` ENGINE=MERGE UNION=(`'. $SERVERTABLEVENTS .'_'. $year .'_'. sprintf ("%02d", ($quarter * 3 ) - 2) .'`, `'. $SERVERTABLEVENTS .'_'. $year .'_'. sprintf ("%02d", ($qu...
            $dbh->do( $sql ) or $rv = errorTrapDBI("Cannot dbh->do: $sql", $debug);
          }

          if ($rv) { print EMAILREPORT "MERGED\n\n"; } else { print EMAILREPORT "NOT MERGED, PLEASE VERIFY '$sql'\n\n"; }
        }
      }
    }

    $sql = "CREATE TABLE IF NOT EXISTS `". $SERVERTABLCOMMENTS .'_'. $year ."` LIKE `$SERVERTABLCOMMENTS`";
    $rv = ! checkTableDBI ($dbh, $DATABASE, $SERVERTABLCOMMENTS .'_'. $year, 'check', 'status', 'OK');

    if ($rv) {
      if ($debug) {
        print "\nTable: '$SERVERTABLCOMMENTS', Year: '$year'\n<$sql>\n";
      } else {
        print EMAILREPORT "\nTable: '$SERVERTABLCOMMENTS', Year: '$year', Status: ";
        $dbh->do( $sql ) or $rv = errorTrapDBI("Cannot dbh->do: $sql", $debug);
        $rv = checkTableDBI ($dbh, $DATABASE, $SERVERTABLCOMMENTS .'_'. $year, 'check', 'status', 'OK');
        if ($rv) { print EMAILREPORT "Created\n\n"; } else { print EMAILREPORT "NOT CREATED, PLEASE VERIFY\n\n"; }
      }
    } else {
      print "Table: '$SERVERTABLCOMMENTS', Year: '$year', Status: ALREADY CREATED\n\n" if ($debug);
    }

    $dbh->disconnect or $rv = errorTrapDBI("Sorry, the database was unable to add your entry.", $debug);
  }
}

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

sub doBackupCsvSqlErrorWeekDebugReport {
  my ($RESULTSPATH, $DEBUGDIR, $REPORTDIR, $gzipEpoch, $removeAllNokEpoch, $removeGzipEpoch, $removeDebugEpoch, $removeReportsEpoch, $removeWeeksEpoch, $firstDayOfWeekEpoch, $yesterdayEpoch, $currentEpoch) =  @_;

  print EMAILREPORT "\nDo backup, csv, sql, error, week, and debug files:\n--------------------------------------------------\n" unless ( $debug );
  my ($darchivelist, $dtest, $pagedir, $ttest, $command, $rvOpendir, $path, $filename, $debugPath, $debugFilename, $reportPath, $reportFilename, $weekFilename);
  my @files = ();

  foreach $darchivelist (@archivelisttable) {
    ($pagedir, $ttest) = split(/\#/, $darchivelist, 2);
    my @stest = split(/\|/, $ttest);

    $path = $RESULTSPATH .'/'. $pagedir;
    $debugPath = $path .'/'. $DEBUGDIR;
    $reportPath = $path .'/'. $REPORTDIR;

    if ($debug) {
      print "\n", "<$RESULTSPATH><$pagedir><$path><$DEBUGDIR><$REPORTDIR>\n" 
    } else {
      print EMAILREPORT "\nPlugin: '$ttest', results directory: '$path'\n";
    }

    $rvOpendir = opendir(DIR, $path);

    if ($rvOpendir) {
      @files = readdir(DIR);
      closedir(DIR);
    }

    if (-e $debugPath) {
      $rvOpendir = opendir(DIR, $debugPath);

      if ($rvOpendir) {
        while ($debugFilename = readdir(DIR)) {
          print "Debug Filename: <$debugFilename>\n" if ($debug >= 2);
          gzipOrRemoveHttpDumpDebug ($gzipDebugEpoch, $removeDebugEpoch, $debugPath, $debugFilename);
        }

        closedir(DIR);
      }
    }

    if (-e $reportPath) {
      $rvOpendir = opendir(DIR, $reportPath);

      if ($rvOpendir) {
        while ($reportFilename = readdir(DIR)) {
          print "Report Filename: <$reportFilename>\n" if ($debug >= 2);
          removeOldReportFiles ($removeReportsEpoch, $removeGzipEpoch, $reportPath, $reportFilename);
        }

        closedir(DIR);
      }
    }

    foreach $dtest (@stest) {
      my ($catalogID_uKey, $test) = split(/\#/, $dtest);
      ($command, undef) = split(/\.pl/, $test);
      my ($catalogID, $uKey) = split(/_/, $catalogID_uKey);

      unless ( defined $uKey ) {
        $uKey = $catalogID;
        $catalogID = $CATALOGID;
        $catalogID_uKey = $catalogID .'_'. $uKey unless ( $catalogID eq 'CID' );
      }

      my ( $tWeek, $tYear ) = get_week('yesterday');
      $weekFilename = get_year('yesterday') ."w$tWeek-$command-$catalogID_uKey-csv-week.txt";
      if (-e "$path/$weekFilename") { unlink ($path.'/'.$weekFilename); }
      print "Test          : <$dtest>\n" if ($debug);

      foreach $filename (@files) {
        print "Filename      : <$filename>\n" if ($debug >= 2);
        catAllCsvFilesYesterdayWeek ($firstDayOfWeekEpoch, $yesterdayEpoch, $catalogID_uKey, $command, $path, $weekFilename, $filename);
        removeAllNokgzipCsvSqlErrorWeekFilesOlderThenAndMoveToBackupShare ($gzipEpoch, $removeAllNokEpoch, $removeGzipEpoch, $removeDebugEpoch, $removeWeeksEpoch, $catalogID_uKey, $command, $path, $filename);
      }
    }
  }
}

applications/archive.pl  view on Meta::CPAN

          print EMAILREPORT "SE-<$datum><", get_yearMonthDay($removeDebugEpoch), "> unlink <$path><$filename>\n";
          unlink ($path.'/'.$filename);
        }
      }
    } elsif ( $staart eq "nok.txt" ) {
      if ($datum le get_yearMonthDay($removeAllNokEpoch)) {
	      if ($debug) {
          print "N- <$datum><", get_yearMonthDay($removeAllNokEpoch), "><$path><$filename>\n";
        } else {
          print EMAILREPORT "N- <$datum><", get_yearMonthDay($removeAllNokEpoch), "> unlink <$path><$filename>\n";
          unlink ($path.'/'.$filename);
        }
      }
    }
  }
}

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

sub catAllCsvFilesYesterdayWeek {
  my ($firstDayOfWeekEpoch, $yesterdayEpoch, $catalogID_uKey, $command, $path, $weekFilename, $filename) =  @_;

  for (my $loop = $firstDayOfWeekEpoch; $loop <= $yesterdayEpoch; $loop += 86400) {
    if ($filename eq get_yearMonthDay($loop)."-$command-$catalogID_uKey-csv.txt") {
      my $rvOpen = open(CAT, ">>$path/$weekFilename");

      if ($rvOpen) {
        $rvOpen = open(CSV, "$path/$filename");

        if ($rvOpen) {
          while (<CSV>) {
            chomp;

            unless ( /^#/ ) {
              my $dummy = $_;
              $dummy =~ s/\ {1,}//g;
              if ($dummy ne '') { print CAT $_, "\n"; }
            }
          }

          close(CSV);
          my ( $tWeek, $tYear ) = get_week ('yesterday');
          print "WF <week$tWeek><$filename>\nW  <$path/$weekFilename>\n" if ($debug);
        } else {
          print "Cannot open $filename!\n";
        }

        close(CAT);
      } else {
        print "Cannot open $filename!\n";
      }
    }
  }
}

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

sub gzipOrRemoveHttpDumpDebug {
  my ($gzipDebugEpoch, $removeDebugEpoch, $debugPath, $debugFilename) = @_;

  my ($suffix, $extentie, $datum, $restant);

  print "<$debugFilename>\n" if ($debug);

  my $_debugFilename = reverse $debugFilename;
  my ($_suffix, $_extentie) = reverse split(/\./, $_debugFilename, 2);
  $suffix = reverse $_suffix;
  $extentie = reverse $_extentie;
  ($datum, $restant) = split(/\-/, $suffix, 2);

  if (defined $restant) {
    $datum = substr($datum, 0, 8);

    if ( $extentie ) {
      if ( $extentie eq 'htm' ) {
        if ($datum le get_yearMonthDay($gzipDebugEpoch)) {
          if ($debug) {
            print "HT+<$datum><".get_yearMonthDay($gzipDebugEpoch)."><$debugPath><$debugFilename>\n";
          } else {
            print EMAILREPORT "HT+<$datum><".get_yearMonthDay($gzipDebugEpoch)."> gzip <$debugPath><$debugFilename>\n";
            my ($status, $stdout, $stderr) = call_system ('gzip --force '.$debugPath.'/'.$debugFilename, $debug);
            print EMAILREPORT "HT+  E R R O R: <$stderr>\n" unless ( $status );
          }
        }
      } elsif ( $extentie eq 'htm.gz' ) {
        if ($datum le get_yearMonthDay($removeDebugEpoch)) {
    	  if ($debug) {
            print "HT-<$datum><".get_yearMonthDay($removeDebugEpoch)."><$debugPath><$debugFilename>\n";
          } else {
            print EMAILREPORT "HT-<$datum><".get_yearMonthDay($removeDebugEpoch)."> unlink <$debugPath><$debugFilename>\n";
            unlink ($debugPath.'/'.$debugFilename);
          }
        }
      }
    }
  }
}

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

sub removeCgisessFiles {
  my ($removeCgisessEpoch) = @_;

  my $emailreport = "\nRemove cgisess files:\n---------------------\n";
  if ( $debug ) { print "$emailreport"; } else { print EMAILREPORT "$emailreport"; }

  my @cgisessPathFilenames = glob("$CGISESSPATH/cgisess_*");

  foreach my $cgisessPathFilename (@cgisessPathFilenames) {
    my (undef, $cgisessFilename) = split (/^$CGISESSPATH\//, $cgisessPathFilename);
    my (undef, $sessionID) = split (/^cgisess_/, $cgisessFilename);
    print "Filename      : <$cgisessFilename><$sessionID>\n" if ($debug >= 2);
    my ($sessionExists, %session) = get_session_param ($sessionID, $CGISESSPATH, $cgisessFilename, $debug);

    if ( $sessionExists ) {
      if (defined $session{ASNMTAP}) {
        if ($session{ASNMTAP} eq 'LEXY') {
          print "              : <$removeCgisessEpoch><" .$session{_SESSION_CTIME}. ">\n" if ($debug >= 2);

          if ($removeCgisessEpoch > $session{_SESSION_CTIME}) {
            if ($debug) {
              print "CS <$cgisessPathFilename><" .$session{_SESSION_CTIME}. ">\n";
            } else {
              print EMAILREPORT "CS unlink <$cgisessPathFilename><" .$session{_SESSION_CTIME}. ">\n";
              my ($status, $stdout, $stderr) = call_system ('rm -f '.$cgisessPathFilename, $debug); # unlink ($cgisessPathFilename);
            }
          } else {
            print "CS-<$cgisessPathFilename><$removeCgisessEpoch><" .$session{_SESSION_CTIME}. ">\n" if ($debug >= 2);
          }
        } else {
          print "CS-<$cgisessPathFilename> ASNMTAP not LEXY>\n" if ($debug >= 2);
        }
      } else {
        if ($removeCgisessEpoch > $session{_SESSION_CTIME}) {
          if ($debug) {
            print "CS <$cgisessPathFilename><" .$session{_SESSION_CTIME}. ">\n";
          } else {
            print EMAILREPORT "CS unlink <$cgisessPathFilename><" .$session{_SESSION_CTIME}. ">\n";
            unlink ($cgisessPathFilename);
          }
        } else {
          print "CS-<$cgisessPathFilename> ASNMTAP not LEXY>\n" if ($debug >= 2);
        }
      }
    }
  }
}

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

sub removeOldReportFiles {
  my ($removeReportsEpoch, $removeGzipEpoch, $reportPath, $reportFilename) = @_;

  my ($suffix, $prefix, $datum, $plugin, $restant, $extentie);
  ($suffix, $prefix) = split(/\.pl/, $reportFilename, 2);
  ($datum, $plugin) = split(/\-/, $suffix, 2) if (defined $suffix);
  ($restant, $extentie) = split(/\./, $prefix, 2) if (defined $prefix);

  if ($debug) {
    print "<$reportFilename>";

    if ($debug >= 2) {
      print " S <$suffix>, P <$prefix>" if (defined $prefix);
      print " D <$datum>, P <$plugin>" if (defined $plugin);
      print " R <$restant>, E <$extentie>" if (defined $extentie);
    }

    print "\n";
  }

  if (defined $restant) {
    $datum = substr($datum, 0, 8);

    if ($extentie eq 'pdf') {
      if ($datum le get_yearMonthDay($removeReportsEpoch)) {
        if ($debug) {
          print "RP-<$datum><".get_yearMonthDay($removeReportsEpoch)."><$reportPath><$reportFilename>\n";
        } else {
          print EMAILREPORT "RP-<$datum><".get_yearMonthDay($removeReportsEpoch)."> unlink <$reportPath><$reportFilename>\n";
          unlink ($reportPath.'/'.$reportFilename);
        }
      } elsif ($restant =~ /\-Day_\w+\-id_\d+$/) {
        if ($datum le get_yearMonthDay($removeGzipEpoch)) {
          if ($debug) {
            print "RP-<$datum><".get_yearMonthDay($removeReportsEpoch)."><$reportPath><$reportFilename>\n";
          } else {
            print EMAILREPORT "RP-<$datum><".get_yearMonthDay($removeReportsEpoch)."> unlink <$reportPath><$reportFilename>\n";
            unlink ($reportPath.'/'.$reportFilename);
          }
        }
      }
    }
  }
}

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

sub errorTrapDBI {
  my ($error_message, $debug) = @_;

  print EMAILREPORT "   DBI Error:\n", $error_message, "\nERROR: $DBI::err ($DBI::errstr)\n";
  return 0;
}

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

sub print_usage () {
  print "Usage: $PROGNAME [-A <archivelist>] [-c F|T] [-r F|T] [-d F|T] [-y <years ago>] [-f F|T] [-D <debug>] [-V version] [-h help]\n";
}

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

sub print_help () {
  print_revision($PROGNAME, $version);
  print "ASNMTAP Archiver for the '$APPLICATION'

-A, --archivelist=<filename>
   FILENAME : filename from the archivelist for the html output loop (default undef)
-c, --cgisess=F|T
   F(alse)  : don't remove the cgisess files
   T(true)  : remove the cgisess files (default)
-r, --reports=F|T
   F(alse)  : don't backup Csv, Sql, Error, Week, Debug reports
   T(true)  : remove backup Csv, Sql, Error, Week, Debug reports (default)
-d, --database=F|T
   F(alse)  : don't archive the '$SERVERTABLEVENTS' and '$SERVERTABLCOMMENTS' tables (default)
   T(true)  : archive the '$SERVERTABLEVENTS' and '$SERVERTABLCOMMENTS' tables
-y, --yearsago=<years ago>
   YEARS AGO: c => current year or 1..9 => the number of years ago that the '$SERVERTABLEVENTS' 
              and '$SERVERTABLCOMMENTS' tables need to be created
-f, --force=F|T
   F(alse)  : don't force CSV import (default)
   T(true)  : force CSV import
-D, --debug=F|T|L
   F(alse)  : screendebugging off (default)
   T(true)  : normal screendebugging on
   L(ong)   : long screendebugging on
-V, --version
-h, --help

Send email to $SENDEMAILTO if you have questions regarding
use of this software. To submit patches or suggest improvements, send



( run in 1.564 second using v1.01-cache-2.11-cpan-d8267643d1d )