ASNMTAP
view release on metacpan or search on metacpan
applications/archive.pl view on Meta::CPAN
}
}
if ($opt_f) {
if ($opt_f eq 'F' || $opt_f eq 'T') {
$doForce = ($opt_f eq 'F') ? 0 : 1;
} else {
usage("Invalid force: $opt_f\n");
}
}
if ($opt_D) {
if ($opt_D eq 'F' || $opt_D eq 'T' || $opt_D eq 'L') {
$debug = 0 if ($opt_D eq 'F');
$debug = 1 if ($opt_D eq 'T');
$debug = 2 if ($opt_D eq 'L');
} else {
usage("Invalid debug: $opt_D\n");
}
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
my $logger = LOG_init_log4perl ( 'archive', undef, $debug );
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
my @archivelisttable;
if ( $debug ) {
print "Current day : <", scalar(localtime($currentEpoch)), "><", $currentEpoch, ">\n";
print "Yesterday : <", scalar(localtime($yesterdayEpoch)), "><", $yesterdayEpoch, ">\n";
print "First day of yesterday week : <", scalar(localtime($firstDayOfWeekEpoch)), "><", $firstDayOfWeekEpoch, ">\n";
print "GZIP not debug files older then : <", scalar(localtime($gzipEpoch)), "><", $gzipEpoch, ">\n";
print "GZIP debug files older then : <", scalar(localtime($gzipDebugEpoch)), "><", $gzipDebugEpoch, ">\n";
print "Remove All/Nok files older then : <", scalar(localtime($removeAllNokEpoch)), "><", $removeAllNokEpoch, ">\n";
print "Remove GZIP files older then : <", scalar(localtime($removeGzipEpoch)), "><", $removeGzipEpoch, ">\n";
print "Remove Debug files older then : <", scalar(localtime($removeDebugEpoch)), "><", $removeDebugEpoch, ">\n";
print "Remove Week files older then : <", scalar(localtime($removeWeeksEpoch)), "><", $removeWeeksEpoch, ">\n";
print "Remove Cgisess files older then : <", scalar(localtime($removeCgisessEpoch)), "><", $removeCgisessEpoch, ">\n";
print "Remove Report files older then : <", scalar(localtime($removeReportsEpoch)), "><", $removeReportsEpoch, ">\n";
}
my ($emailReport, $rvOpen) = init_email_report (*EMAILREPORT, "archiverEmailReport.txt", $debug);
if ( $rvOpen ) {
@archivelisttable = read_table($prgtext, $archivelist, 0, $debug) if (defined $archivelist);
doBackupCsvSqlErrorWeekDebugReport ($RESULTSPATH, $DEBUGDIR, $REPORTDIR, $gzipEpoch, $removeAllNokEpoch, $removeGzipEpoch, $removeDebugEpoch, $removeReportsEpoch, $removeWeeksEpoch, $firstDayOfWeekEpoch, $yesterdayEpoch, $currentEpoch) if ($doRepor...
createCommentsAndEventsArchiveTables ( "-$doYearsAgo year" ) if ($doYearsAgo != -1);
if ($doDatabase) {
my $month = get_month ('today');
my $day = get_day ('today');
createCommentsAndEventsArchiveTables ( '+1 year' ) if ($month == 12 and $day >= 24);
archiveCommentsAndEventsTables ( '-14 days', '-1 year' );
}
removeCgisessFiles ($removeCgisessEpoch) if ($doCgisess);
my $emailreport = "\nRemove *-MySQL-sql-error.txt:\n-----------------------------\n";
if ( $debug ) { print "$emailreport"; } else { print EMAILREPORT "$emailreport"; }
my @sqlErrorTxtFiles = glob("$RESULTSPATH/*-MySQL-sql-error.txt");
foreach my $sqlErrorTxtFile (@sqlErrorTxtFiles) {
if ($debug) {
print "E- unlink <$sqlErrorTxtFile>\n";
} else {
print EMAILREPORT "E- unlink <$sqlErrorTxtFile>\n";
}
unlink ($sqlErrorTxtFile);
}
} else {
print "Cannot open $emailReport to print email report information\n";
}
my ($rc) = send_email_report (*EMAILREPORT, $emailReport, $rvOpen, $prgtext, $debug);
exit;
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub archiveCommentsAndEventsTables {
my ($eventsAgo, $commentsAgo) = @_;
print EMAILREPORT "\nArchive '$SERVERTABLCOMMENTS' and '$SERVERTABLEVENTS' tables:\n--------------------------------------------------\n" unless ( $debug );
# Init parameters
my ($rv, $dbh, $sth, $sql, $year, $month, $day, $timeslot, $yearMOVE, $monthMOVE, $sqlMOVE, $sqlUPDATE);
$rv = 1;
$dbh = DBI->connect("dbi:mysql:$DATABASE:$SERVERNAMEREADWRITE:$SERVERPORTREADWRITE", "$SERVERUSERREADWRITE", "$SERVERPASSREADWRITE" ) or $rv = errorTrapDBI("Cannot connect to the database", $debug);
if ($dbh and $rv) {
$year = get_year ($eventsAgo);
$month = get_month ($eventsAgo);
$day = get_day ($eventsAgo);
$timeslot = timelocal ( 0, 0, 0, $day, ($month-1), ($year-1900) );
if ($debug) {
$sql = "select SQL_NO_CACHE catalogID, id, endDate, startDate, timeslot, uKey from $SERVERTABLEVENTS force index (key_timeslot) where timeslot < '" .$timeslot. "'";
print "\nTable: '$SERVERTABLEVENTS', Year: '$year', Month: '$month', Day: '$day', Timeslot: '$timeslot', Date: " .scalar(localtime($timeslot)). "\n<$sql>\n";
} else {
$sql = "select SQL_NO_CACHE catalogID, id, endDate from $SERVERTABLEVENTS force index (key_timeslot) where timeslot < '" .$timeslot. "'";
print EMAILREPORT "\nTable: '$SERVERTABLEVENTS', Year: '$year', Month: '$month', Day: '$day', Timeslot: '$timeslot'\n";
}
$sth = $dbh->prepare($sql) or $rv = errorTrapDBI("dbh->prepare: $sql", $debug);
$rv = $sth->execute() or $rv = errorTrapDBI("sth->execute: $sql", $debug) if $rv;
if ( $rv ) {
while (my $ref = $sth->fetchrow_hashref()) {
($yearMOVE, $monthMOVE, undef) = split (/-/, $ref->{endDate});
print "\n", $ref->{catalogID}, " ", $ref->{id}, " ", $ref->{uKey}, " ", $ref->{startDate}, " ", $ref->{endDate}, " ",$ref->{timeslot}, " \n" if ($debug);
$sqlMOVE = 'REPLACE INTO `' .$SERVERTABLEVENTS. '_' .$yearMOVE. '_' .$monthMOVE. '` SELECT * FROM `' .$SERVERTABLEVENTS. '` WHERE catalogID = "' .$ref->{catalogID}. '" and id = "' .$ref->{id}. '"';
if ( $yearMOVE ne '0000' and $monthMOVE ne '00' ) {
print "$sqlMOVE\n" if ($debug);
$dbh->do( $sqlMOVE ) or $rv = errorTrapDBI("Cannot dbh->do: $sql", $debug) unless ( $debug );
if ( $rv ) {
$sqlMOVE = 'DELETE FROM `' .$SERVERTABLEVENTS. '` WHERE catalogID = "' .$ref->{catalogID}. '" and id = "' .$ref->{id}. '"';
print "$sqlMOVE\n" if ($debug);
$dbh->do( $sqlMOVE ) or $rv = errorTrapDBI("Cannot dbh->do: $sql", $debug) unless ( $debug );
}
} else {
if ($debug) {
print "DATABASE ERROR ... CRITICAL: Update table ${SERVERTABLEVENTS}_${yearMOVE}_${monthMOVE}' not possible for '$sqlMOVE'\n";
} else {
print EMAILREPORT "DATABASE ERROR ... CRITICAL: Update table ${SERVERTABLEVENTS}_${yearMOVE}_${monthMOVE}' not possible for '$sqlMOVE'\n";
}
}
}
$sth->finish() or $rv = errorTrapDBI("sth->finish", $debug);
}
$sql = "select SQL_NO_CACHE distinct $SERVERTABLCOMMENTS.catalogID, $SERVERTABLCOMMENTS.uKey, $SERVERTABLCOMMENTS.commentData from $SERVERTABLCOMMENTS, $SERVERTABLPLUGINS, $SERVERTABLVIEWS, $SERVERTABLDISPLAYDMNS, $SERVERTABLCRONTABS as crontabOu...
if ($debug) {
print "\nUpdate table '$SERVERTABLCOMMENTS': <$sql>\n";
} else {
print EMAILREPORT "\nUpdate table '$SERVERTABLCOMMENTS': <$sql>\n";
}
$sth = $dbh->prepare($sql) or $rv = errorTrapDBI("dbh->prepare: $sql", $debug);
$rv = $sth->execute() or $rv = errorTrapDBI("sth->execute: $sql", $debug) if $rv;
if ( $rv ) {
my ($localYear, $localMonth, $currentYear, $currentMonth, $currentDay, $currentHour, $currentMin, $currentSec) = ((localtime)[5], (localtime)[4], ((localtime)[5] + 1900), ((localtime)[4] + 1), (localtime)[3,2,1,0]);
my $solvedDate = "$currentYear-$currentMonth-$currentDay";
my $solvedTime = "$currentHour:$currentMin:$currentSec";
my $solvedTimeslot = timelocal($currentSec, $currentMin, $currentHour, $currentDay, $localMonth, $localYear);
while (my $ref = $sth->fetchrow_hashref()) {
$sqlUPDATE = 'UPDATE ' .$SERVERTABLCOMMENTS. ' SET replicationStatus="U", problemSolved="1", solvedDate="' .$solvedDate. '", solvedTime="' .$solvedTime. '", solvedTimeslot="' .$solvedTimeslot. '", commentData="' .$ref->{commentData}. '<br>AUT...
print "$sqlUPDATE;\n" if ($debug);
$dbh->do( $sqlUPDATE ) or $rv = errorTrapDBI("Cannot dbh->do: $sql", $debug) unless ( $debug );
}
$sth->finish() or $rv = errorTrapDBI("sth->finish", $debug);
}
$year = get_year ($commentsAgo);
$month = get_month ($commentsAgo);
$day = get_day ($commentsAgo);
$timeslot = timelocal ( 0, 0, 0, $day, ($month-1), ($year-1900) );
$sql = "select SQL_NO_CACHE catalogID, id, solvedDate, solvedTimeslot, uKey from $SERVERTABLCOMMENTS force index (solvedTimeslot) where problemSolved = '1' and solvedTimeslot < '" .$timeslot. "'";
if ($debug) {
print "\nTable: '$SERVERTABLCOMMENTS', Year: '$year', Month: '$month', Day: '$day', Timeslot: '$timeslot', Date: " .scalar(localtime($timeslot)). "\n<$sql>\n";
} else {
print EMAILREPORT "\nTable: '$SERVERTABLCOMMENTS', Year: '$year', Month: '$month', Day: '$day', Timeslot: '$timeslot'\n";
}
$sth = $dbh->prepare($sql) or $rv = errorTrapDBI("dbh->prepare: $sql", $debug);
$rv = $sth->execute() or $rv = errorTrapDBI("sth->execute: $sql", $debug) if $rv;
if ( $rv ) {
while (my $ref = $sth->fetchrow_hashref()) {
($yearMOVE, undef, undef) = split (/-/, $ref->{solvedDate});
print "\n", $ref->{catalogID}, " ", $ref->{id}, " ", $ref->{uKey}, " ", $ref->{solvedDate}, " ", $ref->{solvedTimeslot}, "\n" if ($debug);
$sqlMOVE = 'REPLACE INTO `' .$SERVERTABLCOMMENTS. '_' .$yearMOVE. '` SELECT * FROM `' .$SERVERTABLCOMMENTS. '` WHERE catalogID = "' .$ref->{catalogID}. '" and id = "' .$ref->{id}. '"';
if ( $yearMOVE ne '0000' ) {
print "$sqlMOVE\n" if ($debug);
$dbh->do( $sqlMOVE ) or $rv = errorTrapDBI("Cannot dbh->do: $sql", $debug) unless ( $debug );
if ( $rv ) {
$sqlMOVE = 'DELETE FROM `' .$SERVERTABLCOMMENTS. '` WHERE catalogID = "' .$ref->{catalogID}. '" and id = "' .$ref->{id}. '"';
print "$sqlMOVE\n" if ($debug);
$dbh->do( $sqlMOVE ) or $rv = errorTrapDBI("Cannot dbh->do: $sql", $debug) unless ( $debug );
}
} else {
if ($debug) {
print "DATABASE ERROR ... CRITICAL: Update table ${SERVERTABLCOMMENTS}_${yearMOVE}' not possible for '$sqlMOVE'\n";
} else {
print EMAILREPORT "DATABASE ERROR ... CRITICAL: Update table ${SERVERTABLCOMMENTS}_${yearMOVE}' not possible for '$sqlMOVE'\n";
}
}
}
$sth->finish() or $rv = errorTrapDBI("sth->finish", $debug);
}
# cleanup automatically scheduled donwtimes when sheduled OFFLINE
my ($localYear, $localMonth, $currentYear, $currentMonth, $currentDay, $currentHour, $currentMin, $currentSec) = ((localtime)[5], (localtime)[4], ((localtime)[5] + 1900), ((localtime)[4] + 1), (localtime)[3,2,1,0]);
my $solvedDate = "$currentYear-$currentMonth-$currentDay";
my $solvedTime = "$currentHour:$currentMin:$currentSec";
my $solvedTimeslot = timelocal($currentSec, $currentMin, $currentHour, $currentDay, $localMonth, $localYear);
my $sqlUPDATE = 'UPDATE ' .$SERVERTABLCOMMENTS. ' SET replicationStatus="U", problemSolved="1", solvedDate="' .$solvedDate. '", solvedTime="' .$solvedTime. '", solvedTimeslot="' .$solvedTimeslot. '" where catalogID="'. $CATALOGID. '" and problemS...
print "$sqlUPDATE\n" if ($debug);
$dbh->do ( $sqlUPDATE ) or $rv = errorTrapDBI("Cannot dbh->do: $sqlUPDATE", $debug) unless ( $debug );
$dbh->disconnect or $rv = errorTrapDBI("Sorry, the database was unable to add your entry.", $debug);
}
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub checkTableDBI {
my ($dbh, $database, $table, $op, $msg_type, $msg_text) = @_;
print "-> <$database.$table>, <$op>, <$msg_type>, <$msg_text>\n" if ($debug);
my ($Table, $Op, $Msg_type, $Msg_text) = '';
my $rv = 1;
my $sql = "check table $table";
my $sth = $dbh->prepare($sql) or $rv = errorTrapDBI("dbh->prepare: $sql", $debug);
$rv = $sth->execute() or $rv = errorTrapDBI("sth->execute: $sql", $debug) if $rv;
if ( $rv ) {
while (my $ref = $sth->fetchrow_hashref()) {
$Table = $ref->{Table};
$Op = $ref->{Op};
$Msg_type = $ref->{Msg_type};
$Msg_text = $ref->{Msg_text};
print "<- <$Table>, <$Op>, <$Msg_type>, <$Msg_text>\n" if ($debug);
}
$sth->finish() or $rv = errorTrapDBI("sth->finish", $debug);
$rv = ($rv and "$database.$table" eq $Table and $op eq $Op and $msg_type eq $Msg_type and $msg_text eq $Msg_text) ? 1 : 0;
}
return ($rv);
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub createCommentsAndEventsArchiveTables {
my ($daysBefore) = @_;
print EMAILREPORT "\nCreate '$SERVERTABLCOMMENTS' and '$SERVERTABLEVENTS' tables when needed:\n--------------------------------------------------\n" unless ( $debug );
# Init parameters
my ($rv, $dbh, $sql, $year, $month);
$year = get_year ($daysBefore);
$rv = 1;
$dbh = DBI->connect("dbi:mysql:$DATABASE:$SERVERNAMEREADWRITE:$SERVERPORTREADWRITE", "$SERVERUSERREADWRITE", "$SERVERPASSREADWRITE" ) or $rv = errorTrapDBI("Cannot connect to the database", $debug);
if ($dbh and $rv) {
foreach $month ('01'..'12') {
$sql = 'CREATE TABLE IF NOT EXISTS `'. $SERVERTABLEVENTS .'_'. $year .'_'. $month .'` LIKE `'. $SERVERTABLEVENTS .'`';
$rv = ! checkTableDBI ($dbh, $DATABASE, $SERVERTABLEVENTS .'_'. $year .'_'. $month, 'check', 'status', 'OK');
if ($rv) {
if ($debug) {
print "\nTable: '$SERVERTABLEVENTS', Year: '$year', Month: '$month'\n<$sql>\n";
} else {
print EMAILREPORT "\nTable: '$SERVERTABLEVENTS', Year: '$year', Month: '$month', Status: ";
$dbh->do( $sql ) or $rv = errorTrapDBI("Cannot dbh->do: $sql", $debug);
$rv = checkTableDBI ($dbh, $DATABASE, $SERVERTABLEVENTS .'_'. $year .'_'. $month, 'check', 'status', 'OK');
if ($rv) { print EMAILREPORT "Created\n"; } else { print EMAILREPORT "NOT CREATED, PLEASE VERIFY\n"; }
}
} else {
$rv = 1;
print "Table: '$SERVERTABLEVENTS', Year: '$year', Month: '$month', Status: ALREADY CREATED\n" if ($debug);
}
if ( $SERVERMYSQLMERGE eq '1' ) {
if ($debug) {
print "Table: '$SERVERTABLEVENTS', Year: '$year', Month: '$month', Status: ENGINE\n";
} else {
print EMAILREPORT "Table: '$SERVERTABLEVENTS', Year: '$year', Month: '$month', Status: ENGINE\n";
$sql = sprintf ("ALTER TABLE `%s_%s_%02d` ENGINE = MyISAM", $SERVERTABLEVENTS, $year, $month);
$dbh->do( $sql ) or $rv = errorTrapDBI("Cannot dbh->do: $sql", $debug);
if ($rv) { print EMAILREPORT "ENGINE = MyISAM\n\n"; } else { print EMAILREPORT "NOT ENGINE = MyISAM, PLEASE VERIFY '$sql'\n\n"; }
}
}
}
if ( $SERVERMYSQLMERGE eq '1' ) {
if ($debug) {
print "\nTable: '$SERVERTABLEVENTS', Year: '$year', Status: MERGE\n";
} else {
print EMAILREPORT "\nTable: '$SERVERTABLEVENTS', Year: '$year', Status: MERGE\n";
$sql = 'DROP TABLE IF EXISTS `'. $SERVERTABLEVENTS .'_'. $year .'`';
$dbh->do( $sql ) or $rv = errorTrapDBI("Cannot dbh->do: $sql", $debug);
if ($rv) {
$sql = 'CREATE TABLE IF NOT EXISTS `'. $SERVERTABLEVENTS .'_'. $year .'` LIKE `'. $SERVERTABLEVENTS .'_'. $year .'_01`';
$dbh->do( $sql ) or $rv = errorTrapDBI("Cannot dbh->do: $sql", $debug);
}
if ($rv) {
$sql = 'ALTER TABLE `'. $SERVERTABLEVENTS .'_'. $year .'` ENGINE=MERGE UNION=(`'. $SERVERTABLEVENTS .'_'. $year .'_01`, `'. $SERVERTABLEVENTS .'_'. $year .'_02`, `'. $SERVERTABLEVENTS .'_'. $year .'_03`, `'. $SERVERTABLEVENTS .'_'. $year .'...
$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"; }
}
foreach my $quarter (1..4) {
if ($debug) {
print "\nTable: '$SERVERTABLEVENTS', Year: '$year' Quarter: 'Q$quarter', Status: MERGE\n";
} 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' );
}
applications/archive.pl view on Meta::CPAN
}
}
} elsif ( $staart eq "$command-$catalogID_uKey-csv.txt" ) {
if ($datum le get_yearMonthDay($gzipEpoch)) {
if ($debug) {
print "C+ <$datum><", get_yearMonthDay($gzipEpoch), "><$path><$filename>\n";
} else {
print EMAILREPORT "C+ <$datum><", get_yearMonthDay($gzipEpoch), "> gzip <$path><$filename>\n";
my ($status, $stdout, $stderr) = call_system ('gzip --force '.$path.'/'.$filename, $debug);
print EMAILREPORT "C+ E R R O R: <$stderr>\n" unless ( $status );
}
}
} elsif ( $staart eq "$command-$catalogID_uKey-csv.txt.gz" ) {
if ($datum le get_yearMonthDay($removeGzipEpoch)) {
if ($debug) {
print "C- <$datum><", get_yearMonthDay($removeGzipEpoch), "><$path><$filename>\n";
} else {
print EMAILREPORT "C- <$datum><", get_yearMonthDay($removeGzipEpoch), "> unlink <$path><$filename>\n";
unlink ($path.'/'.$filename);
}
}
} elsif ( $staart eq "$command-$catalogID_uKey-csv-week.txt" ) {
my ($jaar, $week) = split(/w/, $datum);
my $jaarWeekFilename = int($jaar.$week);
my ( $tWeek, $tYear ) = get_week ('yesterday');
my $jaarWeekYesterday = int(get_year('yesterday'). $tWeek);
if ( $jaarWeekFilename lt $jaarWeekYesterday ) {
if ($debug) {
print "CW+<$jaarWeekYesterday><$jaarWeekFilename><$path><$filename>\n";
} else {
print EMAILREPORT "CW+<$jaarWeekYesterday><$jaarWeekFilename> gzip <$path><$filename>\n";
my ($status, $stdout, $stderr) = call_system ('gzip --force '.$path.'/'.$filename, $debug);
print EMAILREPORT "CW+ E R R O R: <$stderr>\n" unless ( $status );
}
}
} elsif ( $staart eq "$command-$catalogID_uKey-csv-week.txt.gz" ) {
my ($jaar, $week) = split(/w/, $datum);
my $jaarWeekFilename = int($jaar.$week);
my ( $tWeek, $tYear ) = get_week ('-'. $removeGzipWeeksAgo. ' weeks');
my $jaarWeekRemove = int(get_year('-'. $removeGzipWeeksAgo. ' weeks') .$tWeek);
if ( $jaarWeekFilename le $jaarWeekRemove ) {
if ($debug) {
print "CW-<$jaarWeekRemove><$jaarWeekFilename><", get_yearMonthDay($removeWeeksEpoch), "<$path><$filename>\n";
} else {
print EMAILREPORT "CW-<$jaarWeekRemove><$jaarWeekFilename><", get_yearMonthDay($removeWeeksEpoch), " unlink <$path><$filename>\n";
unlink ($path.'/'.$filename);
}
}
} elsif ( $staart eq "$command-$catalogID_uKey.sql" ) {
if ($debug) {
print "S+ <$datum><", get_yearMonthDay($gzipEpoch), "><$path><$filename>\n" if ($datum le get_yearMonthDay($gzipEpoch));
} elsif (! $doDatabase) {
# APE # TODO - REMOVE
# Init parameters
# my ($rv, $dbh, $sql);
# open connection to database and query data
# $rv = 1;
# $dbh = DBI->connect("dbi:mysql:$DATABASE:$SERVERNAMEREADWRITE:$SERVERPORTREADWRITE", "$SERVERUSERREADWRITE", "$SERVERPASSREADWRITE" ) or $rv = errorTrapDBI("Cannot connect to the database", $debug);
# if ($dbh and $rv) {
# $sql = "LOAD DATA LOW_PRIORITY LOCAL INFILE '$path/$filename' INTO TABLE $SERVERTABLEVENTS FIELDS TERMINATED BY ',' ENCLOSED BY '\"' LINES TERMINATED BY '\\n'";
# $dbh->do( $sql ) or $rv = errorTrapDBI("Cannot dbh->do: $sql", $debug);
# if ( $rv ) {
# my $mysqlInfo = $dbh->{mysql_info};
# my ($records, $deleted, $skipped, $warnings) = ($mysqlInfo =~ /^Records:\s+(\d+)\s+Deleted:\s+(\d+)\s+Skipped:\s+(\d+)\s+Warnings: (\d+)$/);
# if ($deleted eq '0' and $skipped eq '0' and $warnings eq '0') {
# print EMAILREPORT "S+ LOAD DATA ... : $records record(s) added for $filename\n";
# my ($status, $stdout, $stderr) = call_system ('gzip --force '.$path.'/'.$filename, $debug);
# print EMAILREPORT "S+ E R R O R: <$stderr>\n" unless ( $status );
# } else {
# print EMAILREPORT "S+ LOAD DATA ... WARNING for $filename: $mysqlInfo, <$records> <$deleted> <$skipped> <$warnings>\n";
# rename("$path/$filename", "$path/$filename-LOAD-DATA-FAILED");
# }
# }
# $dbh->disconnect or $rv = errorTrapDBI("Sorry, the database was unable to add your entry.", $debug);
# }
my $_debug = ( ( $debug eq 'T' ) ? 1 : 0);
my $dbh = CSV_prepare_table ("$path/", $filename, '', $SERVERTABLEVENTS, \@EVENTS, \%EVENTS, \$logger, $_debug);
my $rv = CSV_import_from_table (1, $dbh, $SERVERTABLEVENTS, \@EVENTS, 'id', $doForce, \$logger, $_debug);
if ( $rv ) {
if ($debug) {
print "S+ IMPORT CSV DATA ... OK: ALL records imported from $path/$filename\n";
} else {
print EMAILREPORT "S+ IMPORT CSV DATA ... OK: ALL records imported from $path/$filename\n";
my ($status, $stdout, $stderr) = call_system ('gzip --force '.$path.'/'.$filename, $debug);
print EMAILREPORT "S+ E R R O R: <$stderr>\n" unless ( $status );
}
} else {
if ($debug) {
print "S- IMPORT CSV DATA ... CRITICAL: ZERO records imported from $path/$filename\n";
} else {
print EMAILREPORT "S- IMPORT CSV DATA ... CRITICAL: ZERO records imported from $path/$filename\n";
rename("$path/$filename", "$path/$filename-LOAD-DATA-FAILED");
}
}
CSV_cleanup_table ($dbh, \$logger, $_debug);
}
} elsif ( $staart eq "$command-$catalogID_uKey.sql.gz" ) {
if ($datum le get_yearMonthDay($removeGzipEpoch)) {
if ($debug) {
print "S- <$datum><", get_yearMonthDay($removeGzipEpoch), "><$path><$filename>\n";
} else {
print EMAILREPORT "S- <$datum><", get_yearMonthDay($removeGzipEpoch), "> unlink <$path><$filename>\n";
unlink ($path.'/'.$filename);
}
}
} elsif ( $staart eq "$command-$catalogID_uKey-sql-error.txt" ) {
if ($datum le get_yearMonthDay($removeGzipEpoch)) {
if ($debug) {
print "SE-<$datum><", get_yearMonthDay($removeDebugEpoch), "><$path><$filename>\n";
} else {
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";
}
}
}
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
applications/archive.pl view on Meta::CPAN
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
email to $SENDEMAILTO
";
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
( run in 1.952 second using v1.01-cache-2.11-cpan-39bf76dae61 )