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

applications/archive.pl  view on Meta::CPAN

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