3382 lines
116 KiB
Perl
Executable File
3382 lines
116 KiB
Perl
Executable File
#! /usr/bin/perl -w
|
|
# arclog: Archive the log files monthly
|
|
|
|
# Copyright (c) 2001-2022 imacat.
|
|
#
|
|
# Licensed under the Apache License, Version 2.0 (the "License");
|
|
# you may not use this file except in compliance with the License.
|
|
# You may obtain a copy of the License at
|
|
#
|
|
# http://www.apache.org/licenses/LICENSE-2.0
|
|
#
|
|
# Unless required by applicable law or agreed to in writing, software
|
|
# distributed under the License is distributed on an "AS IS" BASIS,
|
|
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
|
# See the License for the specific language governing permissions and
|
|
# limitations under the License.
|
|
|
|
# First written: 2001/1/5
|
|
|
|
package main;
|
|
use 5.008;
|
|
use strict;
|
|
use warnings;
|
|
use ExtUtils::MakeMaker qw();
|
|
use Fcntl qw(:flock);
|
|
use File::Basename qw(basename);
|
|
use IO::Handle qw(autoflush);
|
|
use Getopt::Long qw(GetOptions);
|
|
use Cwd qw(cwd);
|
|
use File::Basename qw(basename fileparse);
|
|
use File::Spec::Functions qw(devnull file_name_is_absolute path catfile
|
|
splitdir curdir updir);
|
|
use File::Temp qw(tempfile);
|
|
use Config qw();
|
|
use base qw(Exporter);
|
|
our (@EXPORT, @EXPORT_OK);
|
|
BEGIN {
|
|
@EXPORT = qw(
|
|
COMPRESS_GZIP COMPRESS_BZIP2 COMPRESS_XZ COMPRESS_NONE
|
|
OVERRIDE_OVERWRITE OVERRIDE_APPEND OVERRIDE_IGNORE OVERRIDE_FAIL OVERRIDE_ASK
|
|
KEEP_ALL KEEP_RESTART KEEP_DELETE KEEP_THIS_MONTH
|
|
TYPE_PLAIN TYPE_GZIP TYPE_BZIP2 TYPE_XZ
|
|
TMP_SUFFIX where_is to_yyyymm format_number rel2abs);
|
|
@EXPORT_OK = @EXPORT;
|
|
# Prototype declaration
|
|
sub main();
|
|
sub parse_args();
|
|
sub where_is($);
|
|
sub to_yyyymm($);
|
|
sub format_number($);
|
|
sub rel2abs($;$);
|
|
}
|
|
|
|
our ($THIS_FILE, $VERBOSE);
|
|
our ($VERSION);
|
|
$THIS_FILE = basename($0);
|
|
$VERSION = "3.05";
|
|
$VERBOSE = 1;
|
|
|
|
our (%CONF, @LOGFILES, $THIS_MONTH, $PROGRESS_BAR);
|
|
our (%WHERE_IS);
|
|
$THIS_MONTH = to_yyyymm $^T;
|
|
|
|
# Constants
|
|
# The compress mode
|
|
use constant COMPRESS_GZIP => "gzip";
|
|
use constant COMPRESS_BZIP2 => "bzip2";
|
|
use constant COMPRESS_XZ => "xz";
|
|
use constant COMPRESS_NONE => "none";
|
|
use constant DEFAULT_COMPRESS => COMPRESS_GZIP;
|
|
# The override mode
|
|
use constant OVERRIDE_OVERWRITE => "overwrite";
|
|
use constant OVERRIDE_APPEND => "append";
|
|
use constant OVERRIDE_IGNORE => "ignore";
|
|
use constant OVERRIDE_FAIL => "fail";
|
|
use constant OVERRIDE_ASK => "ask";
|
|
sub DEFAULT_OVERRIDE() { -t STDIN? OVERRIDE_ASK: OVERRIDE_FAIL; }
|
|
# The keep mode
|
|
use constant KEEP_ALL => "all";
|
|
use constant KEEP_RESTART => "restart";
|
|
use constant KEEP_DELETE => "delete";
|
|
use constant KEEP_THIS_MONTH => "this-month";
|
|
use constant DEFAULT_KEEP => KEEP_THIS_MONTH;
|
|
# The file types
|
|
use constant TYPE_PLAIN => "text/plain";
|
|
use constant TYPE_GZIP => "application/x-gzip";
|
|
use constant TYPE_BZIP2 => "application/x-bzip2";
|
|
use constant TYPE_XZ => "application/x-xz";
|
|
# Other constants
|
|
use constant TMP_SUFFIX => ".tmp-arclog";
|
|
use constant GZIP_SUFFIX => ".gz";
|
|
use constant BZIP2_SUFFIX => ".bz2";
|
|
use constant DEFAULT_IS_PROGRESS_BAR => 1;
|
|
use constant DEFAULT_SORT => 0;
|
|
|
|
our ($VER_MSG, $HELP_MSG, $SHORT_HELP);
|
|
$VER_MSG = "$THIS_FILE v$VERSION by imacat <imacat\@mail.imacat.idv.tw>";
|
|
$SHORT_HELP = "Try `$THIS_FILE --help' for more information.";
|
|
$HELP_MSG = << "EOT";
|
|
Usage: $THIS_FILE [options] logfile... [output]
|
|
Archive the log files monthly.
|
|
|
|
logfile The log file to be archived.
|
|
output The prefix of the output files. The output files are
|
|
named as pre.yyyymm, ie: pre.200001, pre.200002. If not
|
|
specified, the default prefix is the logfile pathname.
|
|
--compress method Compress the archived files. Available methods are:
|
|
gzip, bzip2, xz, and none. The default is gzip.
|
|
--sort Sort the records in the log files by time.
|
|
--nosort Do not sort the records. (default)
|
|
--override mode The override behavior when the target archived files
|
|
exist. Available modes are: overwrite, append, ignore,
|
|
fail and ask. If not specified, the default is "ask" on
|
|
TTY, "fail" for else.
|
|
--keep mode What to keep in the logfile. Available modes are: all,
|
|
restart, delete and this-month. If not specified, the
|
|
default is "this-month".
|
|
-d,--debug Display debug messages. Multiple --debug to debug more.
|
|
-q,--quiet Disable debug messages. An opposite that cancels the
|
|
effect of --debug.
|
|
-h,--help Display this help.
|
|
-v,--version Display version number.
|
|
|
|
EOT
|
|
|
|
main;
|
|
exit 0;
|
|
|
|
# Main program
|
|
sub main() {
|
|
local ($_, %_);
|
|
my %ARC;
|
|
|
|
# Parse the arguments
|
|
parse_args;
|
|
|
|
# Create the temporary working files
|
|
$_->create_temp foreach @LOGFILES;
|
|
# Read the source files to temporary working files
|
|
$_->read_source foreach @LOGFILES;
|
|
# Process each log file
|
|
%ARC = qw();
|
|
foreach my $logfile (@LOGFILES) {
|
|
my ($label, $count, $dropped);
|
|
print STDERR "Archiving " . $logfile->{"file"} . " ... "
|
|
if $VERBOSE > 0 && !$CONF{"IS_PROGRESS_BAR"};
|
|
print STDERR "\n" if $VERBOSE > 1 && !$CONF{"IS_PROGRESS_BAR"};
|
|
$label = $logfile->{"file"};
|
|
$label = "-" . substr($label, -13) if length $label > 14;
|
|
($count, $dropped) = (0, 0);
|
|
if ($CONF{"IS_PROGRESS_BAR"}) {
|
|
$PROGRESS_BAR = _private::ProgressBar->new($label, $logfile->{"count"});
|
|
$PROGRESS_BAR->update(0);
|
|
}
|
|
# Sort each log record by month
|
|
while (defined($_ = $logfile->read_record)) {
|
|
my $month;
|
|
$month = $logfile->{"format"}->parse_month($_);
|
|
# Skip malformed records whose time is not parsable
|
|
if (!defined $month) {
|
|
$dropped++;
|
|
|
|
# This month to keep
|
|
} elsif ($CONF{"KEEP"} eq KEEP_THIS_MONTH && $month eq $THIS_MONTH) {
|
|
$logfile->save_this_month($_);
|
|
|
|
# Months to archive
|
|
} else {
|
|
# A new month
|
|
$ARC{$month} = _private::Archive->new($month)
|
|
if !exists $ARC{$month};
|
|
$ARC{$month}->add($_) if !$ARC{$month}->{"ignore"};
|
|
}
|
|
$count++;
|
|
$PROGRESS_BAR->update($count) if $CONF{"IS_PROGRESS_BAR"};
|
|
}
|
|
undef $PROGRESS_BAR if $CONF{"IS_PROGRESS_BAR"};
|
|
print STDERR "$count records\n"
|
|
if $VERBOSE > 0 && !$CONF{"IS_PROGRESS_BAR"};
|
|
warn "Dropping $dropped malformed records\n"
|
|
if $dropped > 0;
|
|
}
|
|
# Sorting
|
|
if ($CONF{"SORT"}) {
|
|
foreach my $month (sort grep !$ARC{$_}->{"ignore"}, keys %ARC) {
|
|
$ARC{$month}->sort;
|
|
}
|
|
}
|
|
# Store the archived log records
|
|
foreach my $month (sort grep !$ARC{$_}->{"ignore"}, keys %ARC) {
|
|
$ARC{$month}->store_archive;
|
|
}
|
|
# Return the records of this month
|
|
if ($CONF{"KEEP"} eq KEEP_THIS_MONTH) {
|
|
$_->restore_this_month foreach @LOGFILES;
|
|
}
|
|
# Remove the temporarily working files
|
|
$_->remove_temp foreach @LOGFILES;
|
|
|
|
# Print the statistics
|
|
printf STDERR "%d archive files written, %d seconds elapsed.\n",
|
|
scalar(grep !$ARC{$_}->{"ignore"}, keys %ARC), (time - $^T)
|
|
if $VERBOSE > 0;
|
|
return;
|
|
}
|
|
|
|
# Parse the arguments
|
|
sub parse_args() {
|
|
local ($_, %_);
|
|
my ($has_stdin, $one_arg);
|
|
|
|
%CONF = qw();
|
|
$CONF{"SORT"} = DEFAULT_SORT;
|
|
# Get the arguments
|
|
eval {
|
|
local $SIG{"__WARN__"} = sub { die $_[0]; };
|
|
Getopt::Long::Configure(qw(no_auto_abbrev bundling));
|
|
GetOptions( "compress|c=s"=>sub {
|
|
if ($_[1] =~ /^(?:g|gzip)$/i) {
|
|
$CONF{"COMPRESS"} = COMPRESS_GZIP;
|
|
} elsif ($_[1] =~ /^(?:b|bzip2)$/i) {
|
|
$CONF{"COMPRESS"} = COMPRESS_BZIP2;
|
|
} elsif ($_[1] =~ /^(?:x|xz)$/i) {
|
|
$CONF{"COMPRESS"} = COMPRESS_XZ;
|
|
} elsif ($_[1] =~ /^(?:n|none)$/i) {
|
|
$CONF{"COMPRESS"} = COMPRESS_NONE;
|
|
} else {
|
|
die "$THIS_FILE: Unknown compress mode: $_[1]\n";
|
|
} },
|
|
"nocompress"=>sub { $CONF{"COMPRESS"} = COMPRESS_NONE; },
|
|
"sort|s!"=>\$CONF{"SORT"},
|
|
"override|o=s"=>sub {
|
|
if ($_[1] =~ /^(?:o|overwrite)$/i) {
|
|
$CONF{"OVERRIDE"} = OVERRIDE_OVERWRITE;
|
|
} elsif ($_[1] =~ /^(?:a|append)$/i) {
|
|
$CONF{"OVERRIDE"} = OVERRIDE_APPEND;
|
|
} elsif ($_[1] =~ /^(?:i|ignore)$/i) {
|
|
$CONF{"OVERRIDE"} = OVERRIDE_IGNORE;
|
|
} elsif ($_[1] =~ /^(?:f|fail)$/i) {
|
|
$CONF{"OVERRIDE"} = OVERRIDE_FAIL;
|
|
} elsif ($_[1] =~ /^(?:ask)$/i) {
|
|
$CONF{"OVERRIDE"} = OVERRIDE_ASK;
|
|
} else {
|
|
die "$THIS_FILE: Unknown override mode: $_[1]\n";
|
|
} },
|
|
"keep|k=s"=>sub {
|
|
if ($_[1] =~ /^(?:a|all)$/i) {
|
|
$CONF{"KEEP"} = KEEP_ALL;
|
|
} elsif ($_[1] =~ /^(?:r|restart)$/i) {
|
|
$CONF{"KEEP"} = KEEP_RESTART;
|
|
} elsif ($_[1] =~ /^(?:d|delete)$/i) {
|
|
$CONF{"KEEP"} = KEEP_DELETE;
|
|
} elsif ($_[1] =~ /^(?:t|this-month)$/i) {
|
|
$CONF{"KEEP"} = KEEP_THIS_MONTH;
|
|
} else {
|
|
die "$THIS_FILE: Unknown keep mode: $_[1]\n";
|
|
} },
|
|
"debug|d+"=>\$VERBOSE,
|
|
"quiet|q"=>sub { $VERBOSE-- if $VERBOSE > 0; },
|
|
"help|h"=>sub { print $HELP_MSG; exit 0; },
|
|
"version|v"=>sub { print "$VER_MSG\n"; exit 0; });
|
|
};
|
|
die "$THIS_FILE: $@$SHORT_HELP\n" if $@ ne "";
|
|
|
|
# Save the original STDIN and STDOUT
|
|
open $STDIN, "<&", \*STDIN or die "$THIS_FILE: STDIN: $!";
|
|
open $STDOUT, ">&", \*STDOUT or die "$THIS_FILE: STDOUT: $!";
|
|
|
|
# Set the verbose level
|
|
autoflush STDERR if $VERBOSE > 1;
|
|
$CONF{"IS_PROGRESS_BAR"} = DEFAULT_IS_PROGRESS_BAR;
|
|
$CONF{"IS_PROGRESS_BAR"} = 0 if $VERBOSE == 0 || !-t STDERR;
|
|
if ($CONF{"IS_PROGRESS_BAR"}) {
|
|
# Check if we have Term::ReadKey
|
|
$CONF{"IS_PROGRESS_BAR"} = 0 unless eval { require Term::ReadKey; 1; };
|
|
}
|
|
|
|
# Check the arguments
|
|
# Arguments are source files
|
|
@LOGFILES = qw();
|
|
while (@ARGV > 0) {
|
|
$_ = shift @ARGV;
|
|
# Treat /dev/stdin as - on UNIX-like systems
|
|
$_ = "-" if $_ eq "/dev/stdin" && devnull eq "/dev/null";
|
|
push @LOGFILES, $_;
|
|
$_{$_} = 1;
|
|
}
|
|
die "$THIS_FILE: Which log file do you want to archive?\n$SHORT_HELP\n"
|
|
if @LOGFILES == 0;
|
|
$has_stdin = scalar grep $_ eq "-", @LOGFILES;
|
|
# The output prefix
|
|
$one_arg = (@LOGFILES == 1);
|
|
if ($one_arg) {
|
|
# STDIN must specify the output prefix
|
|
die "$THIS_FILE: You must specify the output prefix for STDIN\n$SHORT_HELP\n"
|
|
if $LOGFILES[0] eq "-";
|
|
$CONF{"OUTPUT"} = $LOGFILES[0];
|
|
} else {
|
|
$CONF{"OUTPUT"} = pop @LOGFILES;
|
|
die "$THIS_FILE: You cannot specify STDOUT as the output prefix\n$SHORT_HELP\n"
|
|
if $CONF{"OUTPUT"} eq "-";
|
|
}
|
|
# Check the duplicates - after removing the output prefix
|
|
%_ = qw();
|
|
foreach (@LOGFILES) {
|
|
die "$THIS_FILE: $_: You can only specify a file once\n$SHORT_HELP\n"
|
|
if exists $_{$_};
|
|
$_{$_} = 1;
|
|
}
|
|
|
|
# Set the default override mode
|
|
$CONF{"OVERRIDE"} = DEFAULT_OVERRIDE if !exists $CONF{"OVERRIDE"};
|
|
# Set the default keep mode
|
|
$CONF{"KEEP"} = DEFAULT_KEEP if !exists $CONF{"KEEP"};
|
|
# Set the default compress mode
|
|
$CONF{"COMPRESS"} = DEFAULT_COMPRESS if !exists $CONF{"COMPRESS"};
|
|
|
|
# Cannot keep the records of this month back in STDIN
|
|
if ($has_stdin && $CONF{"KEEP"} eq KEEP_THIS_MONTH) {
|
|
warn "$THIS_FILE: Cannot keep this-month in STDIN. Change to keep all.\n";
|
|
$CONF{"KEEP"} = KEEP_ALL;
|
|
}
|
|
# Cannot delete STDIN
|
|
if ($has_stdin && $CONF{"KEEP"} eq KEEP_DELETE) {
|
|
warn "$THIS_FILE: Cannot delete the STDIN. Change to keep all.\n";
|
|
$CONF{"KEEP"} = KEEP_ALL;
|
|
}
|
|
# Cannot restart STDIN
|
|
if ($has_stdin && $CONF{"KEEP"} eq KEEP_RESTART) {
|
|
warn "$THIS_FILE: Cannot restart the STDIN. Change to keep all.\n";
|
|
$CONF{"KEEP"} = KEEP_ALL;
|
|
}
|
|
# Cannot get the log file and the answer both from STDIN
|
|
if ($has_stdin && $CONF{"OVERRIDE"} eq OVERRIDE_ASK) {
|
|
warn "$THIS_FILE: Cannot read from STDIN in ask mode. Change to fail mode.\n";
|
|
$CONF{"OVERRIDE"} = "fail";
|
|
}
|
|
|
|
# Check the log files
|
|
@LOGFILES = map _private::LogFile->new($_), @LOGFILES;
|
|
if ((@_ = grep $_->{"is_empty"}, @LOGFILES) > 0) {
|
|
print STDERR "Skipping empty files: " . join(", ", map $_->{"file"}, @_) . "\n"
|
|
if $VERBOSE > 0;
|
|
@LOGFILES = grep !$_->{"is_empty"}, @LOGFILES;
|
|
# Close empty files - do this after $_->{"is_empty"},
|
|
# so that $_->{"is_empty"} is still accessible.
|
|
foreach (@_) {
|
|
$_->{"io"}->close;
|
|
undef $_;
|
|
}
|
|
if (@LOGFILES == 0) {
|
|
print STDERR "$THIS_FILE: No non-empty files left. Exiting.\n"
|
|
if $VERBOSE > 0;
|
|
exit 0;
|
|
}
|
|
$has_stdin = scalar grep $_->{"stdin"}, @LOGFILES;
|
|
}
|
|
# Check if the formats of the files are consistent
|
|
%_ = map { $_->{"format"} => 1 } @LOGFILES;
|
|
die "$THIS_FILE: Cannot archive log files in different formats at a time.\n"
|
|
. join "", map sprintf(" %s : %s\n", $_->{"file"}, $_->{"format"}),
|
|
@LOGFILES
|
|
if keys %_ > 1;
|
|
$CONF{"FORMAT"} = $LOGFILES[0]->{"format"};
|
|
|
|
# Check the output file prefix
|
|
# Strip the filename suffix of the compressed files
|
|
if ($one_arg) {
|
|
$CONF{"OUTPUT"} =~ s/\.gz$// if $LOGFILES[0]->{"type"} eq TYPE_GZIP;
|
|
$CONF{"OUTPUT"} =~ s/\.bz2$// if $LOGFILES[0]->{"type"} eq TYPE_BZIP2;
|
|
$CONF{"OUTPUT"} =~ s/\.xz// if $LOGFILES[0]->{"type"} eq TYPE_XZ;
|
|
}
|
|
die "$THIS_FILE: Please specify output prefix\n$SHORT_HELP\n"
|
|
if !defined $CONF{"OUTPUT"};
|
|
$CONF{"OUTPUT"} = rel2abs $CONF{"OUTPUT"};
|
|
$_ = (fileparse $CONF{"OUTPUT"})[1];
|
|
die "$THIS_FILE: $_: Not found\n$SHORT_HELP\n"
|
|
if !-e $_;
|
|
die "$THIS_FILE: $_: Not a directory\n$SHORT_HELP\n"
|
|
if !-d $_;
|
|
die "$THIS_FILE: $_: Permission denied\n$SHORT_HELP\n"
|
|
if !-w $_;
|
|
|
|
return;
|
|
}
|
|
|
|
# Find an executable
|
|
# Code inspired from CPAN::FirstTime
|
|
sub where_is($) {
|
|
local ($_, %_);
|
|
my ($file, $path);
|
|
$file = $_[0];
|
|
return $WHERE_IS{$file} if exists $WHERE_IS{$file};
|
|
foreach my $dir (path) {
|
|
print STDERR " Checking $dir ... " if $VERBOSE > 3;
|
|
if (defined($path = MM->maybe_command(catfile($dir, $file)))) {
|
|
print STDERR "$path\n found " if $VERBOSE > 3;
|
|
return ($WHERE_IS{$file} = $path);
|
|
}
|
|
print STDERR "no\n" if $VERBOSE > 3;
|
|
}
|
|
return ($WHERE_IS{$file} = undef);
|
|
}
|
|
|
|
# convert timestamp to yyyymm
|
|
sub to_yyyymm($) {
|
|
local ($_, %_);
|
|
@_ = localtime $_[0];
|
|
return sprintf "%04d%02d", $_[5] + 1900, $_[4] + 1;
|
|
}
|
|
|
|
# Format the number every 3 digit
|
|
sub format_number($) {
|
|
local $_;
|
|
$_ = $_[0];
|
|
# Group every 3 digit
|
|
$_ = $1 . "," . $2 . $3 while /^([^\.]*\d)(\d\d\d)(.*)$/;
|
|
return $_;
|
|
}
|
|
|
|
# Convert a relative path to an absolute path
|
|
sub rel2abs($;$) {
|
|
local ($_, %_);
|
|
my ($path, $base);
|
|
($path, $base) = @_;
|
|
|
|
# Turn the base absolute
|
|
$base = cwd unless defined $base;
|
|
$base = rel2abs $base if !file_name_is_absolute $base;
|
|
|
|
# Deal with the ~ user home directories under UNIX
|
|
if (defined $Config::Config{"d_getpwent"}) {
|
|
@_ = splitdir($path);
|
|
# If it starts from the user home directory
|
|
if ($_[0] =~ /^~(.*)$/) {
|
|
my ($user, @pwent, $home);
|
|
$user = $1;
|
|
# The same as the current user
|
|
if ( (@pwent = getpwuid $>) > 0
|
|
&& ($user eq "" || $user eq $pwent[0])) {
|
|
# Replace with the user home directory
|
|
# Respect the HOME environment variable if exists
|
|
$home = exists $ENV{"HOME"}? $ENV{"HOME"}: $pwent[7];
|
|
@_ = (splitdir($home), @_[1...$#_]);
|
|
# Get the user home directory
|
|
} elsif ((@pwent = getpwnam $user) > 0) {
|
|
# Replace with the user home directory
|
|
$home = $pwent[7];
|
|
@_ = (splitdir($home), @_[1...$#_]);
|
|
}
|
|
# Compose the path
|
|
$path = catfile @_;
|
|
}
|
|
}
|
|
|
|
# Append the current directory if relative
|
|
$path = catfile($base, $path) unless file_name_is_absolute $path;
|
|
|
|
@_ = splitdir($path); # Split into directory components
|
|
# Add an empty filename level if last level is a directory
|
|
push @_, "" if ($_[@_-1] eq curdir || $_[@_-1] eq updir);
|
|
for ($_ = 1; $_ < @_; $_++) { # Parse each level one by one
|
|
# If it is this directory
|
|
if ($_[$_] eq curdir) {
|
|
splice @_, $_, 1; # Remove this level directly
|
|
$_--; # The level number drop by 1
|
|
# If it is the parent directory
|
|
} elsif ($_ > 1 && $_[$_] eq updir && $_[$_-1] ne updir) {
|
|
splice @_, $_-1, 2; # Remove this and the previous level
|
|
$_ -= 2; # The level number drop by 2
|
|
}
|
|
}
|
|
$path = catfile @_; # Compose the full path
|
|
return $path;
|
|
}
|
|
|
|
|
|
# _private::ProgressBar: The progress bar display
|
|
package _private::ProgressBar;
|
|
use 5.008;
|
|
use strict;
|
|
use warnings;
|
|
|
|
# Initialize the progress bar handler
|
|
sub new : method {
|
|
local ($_, %_);
|
|
my ($class, $self, $label, $total);
|
|
($class, $label, $total) = @_;
|
|
$self = bless {}, $class;
|
|
$self->{"label"} = $label;
|
|
$self->{"total"} = $total;
|
|
$self->{"start"} = time;
|
|
$self->{"last_line"} = undef;
|
|
require Term::ReadKey;
|
|
return $self;
|
|
}
|
|
|
|
# Update the progress bar
|
|
sub update : method {
|
|
local ($_, %_);
|
|
my ($self, $cur, $label, $width, $elapsed, $min, $sec, $bar, $line);
|
|
($self, $cur, $label) = @_;
|
|
$label = $self->{"label"} if !defined $label;
|
|
|
|
# Not enough space for a progress bar
|
|
return if ($width = (Term::ReadKey::GetTerminalSize())[0] - 30) < 1;
|
|
# Calculate the elapsed time
|
|
$elapsed = time - $self->{"start"};
|
|
$sec = $elapsed % 60;
|
|
$min = ($elapsed - $sec) / 60;
|
|
# Calculate the percentage and the progress bar
|
|
$bar = "=" x sprintf("%1.0f", ($cur / $self->{"total"}) * $width);
|
|
# Compose the line
|
|
$line = sprintf "\r%-14.14s [%-".$width."s] %3.0f%% %02d:%02d",
|
|
$label, $bar, ($cur / $self->{"total"}) * 100, $min, $sec;
|
|
# Print if changed
|
|
if (!defined $self->{"last_line"} || $self->{"last_line"} ne $line) {
|
|
# Print it
|
|
print STDERR "\r$line";
|
|
# Record the current line
|
|
$self->{"last_line"} = $line;
|
|
}
|
|
# Finished
|
|
print STDERR "\n" if $cur == $self->{"total"};
|
|
return;
|
|
}
|
|
|
|
|
|
# _private::LogFile: The source log file
|
|
package _private::LogFile;
|
|
use 5.008;
|
|
use strict;
|
|
use warnings;
|
|
BEGIN {
|
|
import main;
|
|
}
|
|
|
|
use Fcntl qw(:flock :seek);
|
|
use File::Basename qw(fileparse);
|
|
use File::Temp qw(tempfile);
|
|
|
|
# Constants
|
|
# The file type checkers
|
|
use constant MAGIC_PM => "File::MMagic";
|
|
use constant MAGIC_EXEC => "file";
|
|
use constant MAGIC_SUFFIX => "suffix";
|
|
|
|
our ($MAGIC_METHOD, $MAGIC);
|
|
BEGIN {
|
|
undef $MAGIC_METHOD;
|
|
undef $MAGIC;
|
|
}
|
|
|
|
# Initialize the source log file processor
|
|
sub new : method {
|
|
local ($_, %_);
|
|
my ($class, $self, $file, $FH, $f0);
|
|
($class, $file) = @_;
|
|
|
|
# STDIN is another class
|
|
if ($file eq "-") {
|
|
$class .= "::STDIN";
|
|
return $class->new(@_[1...$#_]);
|
|
}
|
|
|
|
$self = bless {}, $class;
|
|
$self->{"stdin"} = 0;
|
|
$self->{"keep"} = $CONF{"KEEP"};
|
|
$self->{"override"} = $CONF{"OVERRIDE"};
|
|
$self->{"tmp"} = undef;
|
|
|
|
# Load the File::MMagic first before opening anything, or the seek
|
|
# method will not be loaded into IO::Handle
|
|
$self->check_magic;
|
|
$self->{"check_type"} = $file if $MAGIC_METHOD eq MAGIC_EXEC;
|
|
|
|
$self->{"file"} = rel2abs $file;
|
|
($f0, $file) = ($file, $self->{"file"});
|
|
# Open the file
|
|
if ($self->{"keep"} eq KEEP_ALL) {
|
|
open $FH, $file or die "$THIS_FILE: $file: $!";
|
|
flock $FH, LOCK_SH;
|
|
} else {
|
|
open $FH, "+<", $file or die "$THIS_FILE: $file: $!";
|
|
flock $FH, LOCK_EX;
|
|
}
|
|
$self->{"FH"} = $FH;
|
|
|
|
# Check the file type
|
|
print STDERR "Checking file type of $f0 ... " if $VERBOSE > 1;
|
|
$self->{"type"} = $self->check_type;
|
|
print STDERR $self->{"type"} . "\n" if $VERBOSE > 1;
|
|
# Check the I/O handler to use
|
|
$self->{"io"} = $self->check_io;
|
|
# Open the file
|
|
$self->{"io"}->open_read($file, $self->{"FH"});
|
|
# Check the log file format
|
|
$self->{"format"} = $self->check_format;
|
|
# Not empty
|
|
if (!$self->{"is_empty"}) {
|
|
# Check the temporarily working file availability
|
|
$self->{"temp"} = $self->check_temp;
|
|
}
|
|
|
|
return $self;
|
|
}
|
|
|
|
# Check the temporarily working file availability
|
|
sub check_temp : method {
|
|
local ($_, %_);
|
|
my ($self, $file, $dir, $suf);
|
|
$self = $_[0];
|
|
|
|
# No need to create a named temporarily file if we keep the log file
|
|
if ($CONF{"KEEP"} eq KEEP_ALL) {
|
|
# Create an anonymous temporary file
|
|
return undef;
|
|
}
|
|
|
|
if ($self->{"type"} eq TYPE_GZIP) {
|
|
($file, $dir, $suf) = fileparse $self->{"file"}, ".gz";
|
|
} elsif ($self->{"type"} eq TYPE_BZIP2) {
|
|
($file, $dir, $suf) = fileparse $self->{"file"}, ".bz2";
|
|
} elsif ($self->{"type"} eq TYPE_XZ) {
|
|
($file, $dir, $suf) = fileparse $self->{"file"}, ".xz";
|
|
} else {
|
|
($file, $dir, $suf) = fileparse $self->{"file"};
|
|
}
|
|
|
|
$_ = $dir . $file . TMP_SUFFIX;
|
|
# Does the temporary working file exists?
|
|
die "$THIS_FILE: $_: Temporary working file exists\n$SHORT_HELP\n"
|
|
if -e $_;
|
|
|
|
# Check if we can create the temporarily working file
|
|
die "$THIS_FILE: $dir: File exists\n$SHORT_HELP\n"
|
|
if !-e $dir;
|
|
die "$THIS_FILE: $dir: Not a directory\n$SHORT_HELP\n"
|
|
if !-d $dir;
|
|
die "$THIS_FILE: $dir: Permission denied\n$SHORT_HELP\n"
|
|
if !-w $dir;
|
|
|
|
return $_;
|
|
}
|
|
|
|
# Check the log file format
|
|
sub check_format : method {
|
|
local ($_, %_);
|
|
my $self;
|
|
$self = $_[0];
|
|
|
|
# Read the first line from the source file
|
|
$self->{"first_line"} = $self->{"io"}->readline;
|
|
# Skip empty files
|
|
$self->{"is_empty"} = !defined $self->{"first_line"};
|
|
if ($self->{"is_empty"}) {
|
|
print STDERR "File is empty.\n" if $VERBOSE > 1;
|
|
return undef;
|
|
}
|
|
|
|
# Check the log file format
|
|
print STDERR "Checking the log file format... " if $VERBOSE > 1;
|
|
print STDERR "\n" if $VERBOSE > 2;
|
|
$_ = _private::Format->check_format($self->{"first_line"});
|
|
# Unrecognized log record
|
|
if (!defined $_) {
|
|
print STDERR "unknown\n" if $VERBOSE > 1;
|
|
die "$THIS_FILE: Unrecognized log file format";
|
|
}
|
|
print STDERR "$_\n" if $VERBOSE > 1;
|
|
return $_;
|
|
}
|
|
|
|
# Create the temporary working file
|
|
sub create_temp : method {
|
|
local ($_, %_);
|
|
my ($self, $temp, $FHT);
|
|
$self = $_[0];
|
|
|
|
# Create a named temporarily working file
|
|
if (defined $self->{"temp"}) {
|
|
$temp = $self->{"temp"};
|
|
print STDERR "Creating $temp ... " if $VERBOSE > 2;
|
|
open $FHT, "+>", $temp or die "$THIS_FILE: $temp: $!";
|
|
flock $FHT, LOCK_EX;
|
|
$self->{"FHT"} = $FHT;
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
return $FHT;
|
|
|
|
# Create an anonymous temporarily working file
|
|
} else {
|
|
print STDERR "Creating temporary working file for " . $self->{"file"} . " ... "
|
|
if $VERBOSE > 2;
|
|
$self->{"FHT"} = tempfile or die "$THIS_FILE: tempfile: $!";
|
|
flock $self->{"FHT"}, LOCK_EX;
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
return $self->{"FHT"};
|
|
}
|
|
}
|
|
|
|
# Remove the temporary working file
|
|
sub remove_temp : method {
|
|
local ($_, %_);
|
|
my ($self, $temp, $FHT);
|
|
$self = $_[0];
|
|
($FHT, $temp) = ($self->{"FHT"}, $self->{"temp"});
|
|
# A named temporarily file
|
|
if (defined $self->{"temp"}) {
|
|
print STDERR "Removing $temp ... " if $VERBOSE > 2;
|
|
close $FHT or die "$THIS_FILE: $temp: $!";
|
|
unlink $temp or die "$THIS_FILE: $temp: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
|
|
# An anonymous temporarily working file
|
|
} else {
|
|
print STDERR "Closing temporary working file ... " if $VERBOSE > 2;
|
|
close $FHT or die "$THIS_FILE: tempfile: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
}
|
|
return;
|
|
}
|
|
|
|
# Read the source file
|
|
sub read_source : method {
|
|
local ($_, %_);
|
|
my ($self, $file, $FHT, $count);
|
|
$self = $_[0];
|
|
($file, $FHT) = ($self->{"file"}, $self->{"FHT"});
|
|
print STDERR "Reading from $file ... " if $VERBOSE > 1;
|
|
print STDERR "\n" if $VERBOSE > 2;
|
|
print STDERR " Reading source records ... " if $VERBOSE > 2;
|
|
$count = 0;
|
|
# The first line is already read, to determine the format
|
|
$_ = $self->{"first_line"};
|
|
print $FHT $_ or die "$THIS_FILE: tempfile: $!";
|
|
$count++;
|
|
# The rest lines
|
|
while (defined($_ = $self->{"io"}->readline)) {
|
|
print $FHT $_ or die "$THIS_FILE: tempfile: $!";
|
|
$count++;
|
|
}
|
|
print STDERR "$count records\n" if $VERBOSE > 2;
|
|
$self->{"io"}->close($self->{"keep"}, $self->{"tmp"});
|
|
print STDERR "$count records\n" if $VERBOSE > 1;
|
|
$self->{"count"} = $count;
|
|
return $count;;
|
|
}
|
|
|
|
# Read a record, returning the record and its month
|
|
sub read_record : method {
|
|
local ($_, %_);
|
|
my ($self, $FHT);
|
|
$self = $_[0];
|
|
$FHT = $self->{"FHT"};
|
|
# Reset when start reading
|
|
if (!exists $self->{"reading_record"}) {
|
|
seek $FHT, 0, SEEK_SET or die "$THIS_FILE: tempfile: $!";
|
|
$self->{"reading_record"} = 1;
|
|
}
|
|
$_ = <$FHT>;
|
|
# End of read
|
|
delete $self->{"reading_record"} if !defined $_;
|
|
return $_;
|
|
}
|
|
|
|
# Save the records of this month
|
|
sub save_this_month : method {
|
|
local ($_, %_);
|
|
my ($self, $record, $FH);
|
|
($self, $record) = @_;
|
|
# Create the temporary saving space
|
|
if (!exists $self->{"FH_TM"}) {
|
|
print STDERR "\n" if $VERBOSE > 2 && defined $PROGRESS_BAR;
|
|
print STDERR " Creating buffer for this month ... "
|
|
if $VERBOSE > 2;
|
|
$FH = tempfile or die "$THIS_FILE: tempfile: $!";
|
|
flock $FH, LOCK_EX or die "$THIS_FILE: tempfile: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
$self->{"FH_TM"} = $FH;
|
|
$self->{"count_this_month"} = 0;
|
|
$self->{"size_this_month"} = 0;
|
|
} else {
|
|
$FH = $self->{"FH_TM"};
|
|
}
|
|
# Save the record
|
|
print $FH $record or die "$THIS_FILE: tempfile: $!";
|
|
$self->{"count_this_month"}++;
|
|
$self->{"size_this_month"} += length $record;
|
|
return;
|
|
}
|
|
|
|
# Return the records of this month to the log file
|
|
sub restore_this_month : method {
|
|
local ($_, %_);
|
|
my ($self, $file, $FH);
|
|
$self = $_[0];
|
|
# Bounce if no record to restore
|
|
return unless exists $self->{"FH_TM"};
|
|
($file, $FH) = ($self->{"file"}, $self->{"FH_TM"});
|
|
|
|
# Prepend the records using the I/O class implementation
|
|
ref($self->{"io"})->prepend_records($file, $FH);
|
|
|
|
# Report the statistics
|
|
printf STDERR "%s: keeping %s records, %s bytes\n",
|
|
$file, format_number($self->{"count_this_month"}),
|
|
format_number($self->{"size_this_month"})
|
|
if $VERBOSE > 0;
|
|
|
|
return;
|
|
}
|
|
|
|
# Check the source file type
|
|
sub check_type : method {
|
|
local ($_, %_);
|
|
my ($self, $file, $FH, $PH, $CMD);
|
|
$self = $_[0];
|
|
($file, $FH) = ($self->{"file"}, $self->{"FH"});
|
|
|
|
# Check the file type checker to use
|
|
$self->check_magic;
|
|
die "$THIS_FILE: Cannot check STDIN from the filename suffix.\n"
|
|
if $self->{"stdin"} && $MAGIC_METHOD eq MAGIC_SUFFIX;
|
|
|
|
# Check by file name suffix
|
|
# Check by file name suffix on empty files, too.
|
|
if (-z $FH || $MAGIC_METHOD eq MAGIC_SUFFIX) {
|
|
return TYPE_GZIP if $file =~ /\.gz$/;
|
|
return TYPE_BZIP2 if $file =~ /\.bz2$/;
|
|
return TYPE_XZ if $file =~ /\.xz/;
|
|
# Otherwise we assume it to be text/plain
|
|
return TYPE_PLAIN;
|
|
}
|
|
|
|
# Check the file format
|
|
# Check by File::MMagic
|
|
if ($MAGIC_METHOD eq MAGIC_PM) {
|
|
$_ = $MAGIC->checktype_filehandle($FH);
|
|
seek $FH, 0, SEEK_SET or die "$THIS_FILE: $file: $!";
|
|
|
|
# Check by the file program
|
|
} elsif ($MAGIC_METHOD eq MAGIC_EXEC) {
|
|
flock $FH, LOCK_UN;
|
|
@_ = ($MAGIC, $self->{"check_type"});
|
|
@_ = map "\"$_\"", @_ if $^O eq "MSWin32";
|
|
$CMD = join " ", @_;
|
|
# Start the process
|
|
if ($^O eq "MSWin32") {
|
|
open $PH, "$CMD |" or die "$THIS_FILE: $CMD: $!";
|
|
} else {
|
|
open $PH, "-|", @_ or die "$THIS_FILE: $CMD: $!";
|
|
}
|
|
$_ = join "", <$PH>;
|
|
close $PH or die "$THIS_FILE: $CMD: $!";
|
|
if ($self->{"keep"} eq KEEP_ALL) {
|
|
flock $FH, LOCK_SH;
|
|
} else {
|
|
flock $FH, LOCK_EX;
|
|
}
|
|
}
|
|
|
|
# Check the returned file type text
|
|
return TYPE_GZIP if /gzip/i;
|
|
return TYPE_BZIP2 if /bzip2/i;
|
|
return TYPE_XZ if /xz/i;
|
|
# Default everything to text/plain
|
|
return TYPE_PLAIN;
|
|
}
|
|
|
|
# Check the I/O handler to use
|
|
sub check_io : method {
|
|
local ($_, %_);
|
|
my $self;
|
|
$self = $_[0];
|
|
# We need a gzip compression I/O handler
|
|
return _private::IO->check_gzip if $self->{"type"} eq TYPE_GZIP;
|
|
# We need a bzip2 compression I/O handler
|
|
return _private::IO->check_bzip2 if $self->{"type"} eq TYPE_BZIP2;
|
|
# We need a xz compression I/O handler
|
|
return _private::IO->check_xz if $self->{"type"} eq TYPE_XZ;
|
|
# We need a plain I/O handler
|
|
return _private::IO::Plain->new;
|
|
}
|
|
|
|
# Check the file type checker to use
|
|
sub check_magic : method {
|
|
local ($_, %_);
|
|
my $self;
|
|
$self = $_[0];
|
|
|
|
# Checked before
|
|
return $MAGIC_METHOD if defined $MAGIC_METHOD;
|
|
|
|
print STDERR "Checking file type checker to use ... " if $VERBOSE > 1;
|
|
print STDERR "\n Checking File::MMagic ... " if $VERBOSE > 2;
|
|
# Check if we have File::MMagic
|
|
if (eval { require File::MMagic; 1; }) {
|
|
print STDERR "OK\nfound " if $VERBOSE > 2;
|
|
print STDERR "File::MMagic\n" if $VERBOSE > 1;
|
|
$MAGIC = File::MMagic->new;
|
|
return ($MAGIC_METHOD = MAGIC_PM);
|
|
}
|
|
# Not found
|
|
print STDERR "no\n" if $VERBOSE > 2;
|
|
$@ =~ s/^(Can't locate \S+ in \@INC).*\n/$1\n/; # '
|
|
warn "$@" if $VERBOSE == 1;
|
|
|
|
# Looking for file from PATH
|
|
print STDERR " Checking file ... " if $VERBOSE > 2;
|
|
# Found in PATH
|
|
if (defined($MAGIC = where_is "file")) {
|
|
print STDERR "$MAGIC\nfound " if $VERBOSE > 2;
|
|
print STDERR "$MAGIC\n" if $VERBOSE > 1;
|
|
warn "$THIS_FILE: We will check with $MAGIC instead\n"
|
|
if $VERBOSE > 0;
|
|
return ($MAGIC_METHOD = MAGIC_EXEC);
|
|
}
|
|
# Not found
|
|
print STDERR "no\n" if $VERBOSE > 2;
|
|
|
|
# Check by file name suffix
|
|
print STDERR " Fall back using file name suffix instead\n" if $VERBOSE > 2;
|
|
print STDERR "file name suffix\n" if $VERBOSE > 1;
|
|
warn "$THIS_FILE: We will check by file name suffix instead\n"
|
|
if $VERBOSE == 1;
|
|
return ($MAGIC_METHOD = MAGIC_SUFFIX);
|
|
}
|
|
|
|
|
|
# _private::LogFile::STDIN: The source log file as STDIN
|
|
package _private::LogFile::STDIN;
|
|
use 5.008;
|
|
use strict;
|
|
use warnings;
|
|
use base qw(_private::LogFile);
|
|
BEGIN {
|
|
import main;
|
|
}
|
|
|
|
use IO::Handle;
|
|
use Fcntl qw(:flock :seek);
|
|
use File::Temp qw(tempfile unlink0);
|
|
|
|
# Initialize the source log file processor
|
|
sub new : method {
|
|
local ($_, %_);
|
|
my ($class, $self, $file, $FH, $tmp);
|
|
($class, $file) = @_;
|
|
|
|
# We only initialize STDIN
|
|
return $file if ref($file) ne "" || $file ne "-";
|
|
|
|
$self = bless {}, $class;
|
|
$self->{"stdin"} = 1;
|
|
$self->{"keep"} = KEEP_ALL;
|
|
$self->{"override"} = OVERRIDE_OVERWRITE;
|
|
$self->{"tmp"} = undef;
|
|
|
|
# Load the File::MMagic first before opening anything, or the seek
|
|
# method will not be loaded into IO::Handle
|
|
$self->check_magic;
|
|
|
|
# Save STDIN to somewhere
|
|
$file = "the STDIN buffer";
|
|
if ($_private::LogFile::MAGIC_METHOD eq _private::LogFile::MAGIC_EXEC) {
|
|
($FH, $tmp) = tempfile(undef, UNLINK => 1)
|
|
or die "$THIS_FILE: tempfile: $!";
|
|
$self->{"check_type"} = $tmp;
|
|
$self->{"tmp"} = $tmp;
|
|
} else {
|
|
undef $tmp;
|
|
$FH = tempfile or die "$THIS_FILE: tempfile: $!";
|
|
}
|
|
($self->{"FH"}, $self->{"file"}) = ($FH, $file);
|
|
flock $FH, LOCK_EX;
|
|
print STDERR "Saving STDIN to a buffer ... " if $VERBOSE > 1;
|
|
while (defined($_ = <STDIN>)) {
|
|
print $FH $_ or die "$THIS_FILE: $file: $!";
|
|
}
|
|
seek $FH, 0, SEEK_SET or die "$THIS_FILE: $file: $!";
|
|
print STDERR "done\n" if $VERBOSE > 1;
|
|
|
|
# Check the file type
|
|
print STDERR "Checking file type of STDIN ... " if $VERBOSE > 1;
|
|
$self->{"type"} = $self->check_type;
|
|
# Unlink after check_type() with file executable
|
|
if ($_private::LogFile::MAGIC_METHOD eq _private::LogFile::MAGIC_EXEC) {
|
|
unlink0($FH, $tmp) or die "$THIS_FILE: $tmp: $!";
|
|
}
|
|
print STDERR $self->{"type"} . "\n" if $VERBOSE > 1;
|
|
# Check the I/O handler to use
|
|
$self->{"io"} = $self->check_io;
|
|
# Open the file
|
|
$self->{"io"}->open_read($file, $self->{"FH"});
|
|
# Check the log file format
|
|
$self->{"format"} = $self->check_format;
|
|
# STDIN always goes to an anonymous temporarily working file
|
|
$self->{"temp"} = undef;
|
|
|
|
return $self;
|
|
}
|
|
|
|
# Remove the temporary working file
|
|
sub remove_temp : method {
|
|
local ($_, %_);
|
|
$_ = $_[0];
|
|
print STDERR "Closing temporary working file for STDIN ... " if $VERBOSE > 2;
|
|
close $_->{"FHT"} or die "$THIS_FILE: tempfile: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
return;
|
|
}
|
|
|
|
|
|
# _private::Archive: The result archived log file
|
|
package _private::Archive;
|
|
use 5.008;
|
|
use strict;
|
|
use warnings;
|
|
BEGIN {
|
|
import main;
|
|
}
|
|
|
|
use Date::Parse qw(str2time);
|
|
use Fcntl qw(:flock :seek);
|
|
use File::Basename qw(basename);
|
|
use File::Temp qw(tempfile);
|
|
|
|
# Initialize the result archive file processor
|
|
sub new : method {
|
|
local ($_, %_);
|
|
my ($class, $self, $month, $file, $FH);
|
|
($class, $month) = @_;
|
|
$self = bless {}, $class;
|
|
$self->{"month"} = $month;
|
|
$self->{"override"} = $CONF{"OVERRIDE"};
|
|
$self->{"format"} = $CONF{"FORMAT"};
|
|
if ($CONF{"COMPRESS"} eq COMPRESS_GZIP) {
|
|
$self->{"io"} = _private::IO->check_gzip;
|
|
} elsif ($CONF{"COMPRESS"} eq COMPRESS_BZIP2) {
|
|
$self->{"io"} = _private::IO->check_bzip2;
|
|
} elsif ($CONF{"COMPRESS"} eq COMPRESS_XZ) {
|
|
$self->{"io"} = _private::IO->check_xz;
|
|
} else {
|
|
$self->{"io"} = _private::IO::Plain->new;
|
|
}
|
|
# The resulted output file
|
|
$self->{"file"} = $CONF{"OUTPUT"} . "." . $month
|
|
. $self->{"io"}->suffix;
|
|
$file = $self->{"file"};
|
|
$self->{"ignore"} = 0;
|
|
# The resulted output file exists
|
|
if (-e $file) {
|
|
# If we should ask
|
|
# Jump off the progress bar
|
|
print STDERR "\n"
|
|
if $self->{"override"} eq OVERRIDE_ASK && defined $PROGRESS_BAR;
|
|
while ($self->{"override"} eq OVERRIDE_ASK) {
|
|
printf STDERR "$file exists, (O)overwrite, (A)append, (I)ignore, (F)fail? [F] ";
|
|
$_ = <STDIN>;
|
|
# Fail if not answered
|
|
if (!defined $_) {
|
|
print STDERR "\nhat.. you are not here. I had better drop it right now.\n";
|
|
$self->{"override"} = OVERRIDE_FAIL;
|
|
last;
|
|
}
|
|
chomp;
|
|
# Overwrite
|
|
if (lc $_ eq "o" || lc $_ eq "overwrite") {
|
|
$self->{"override"} = OVERRIDE_OVERWRITE;
|
|
# Append
|
|
} elsif (lc $_ eq "a" || lc $_ eq "append") {
|
|
$self->{"override"} = OVERRIDE_APPEND;
|
|
# Ignore
|
|
} elsif (lc $_ eq "i" || lc $_ eq "ignore") {
|
|
$self->{"override"} = OVERRIDE_IGNORE;
|
|
# Fail
|
|
} elsif (lc $_ eq "f" || lc $_ eq "fail" || lc $_ eq "") {
|
|
$self->{"override"} = OVERRIDE_FAIL;
|
|
# Else, ask again
|
|
} else {
|
|
print STDERR "What?\n";
|
|
$self->{"override"} = OVERRIDE_ASK;
|
|
}
|
|
}
|
|
# Overwrite or append
|
|
if ( $self->{"override"} eq OVERRIDE_OVERWRITE
|
|
|| $self->{"override"} eq OVERRIDE_APPEND) {
|
|
# OK
|
|
} elsif ($self->{"override"} eq OVERRIDE_IGNORE) {
|
|
$self->{"ignore"} = 1;
|
|
} elsif ($self->{"override"} eq OVERRIDE_FAIL) {
|
|
die "$THIS_FILE: $file: Output file exists\n";
|
|
}
|
|
|
|
# Not exists - we always create it
|
|
} else {
|
|
$self->{"override"} = OVERRIDE_OVERWRITE;
|
|
}
|
|
# The temporary log record bucket
|
|
if (!$self->{"ignore"}) {
|
|
print STDERR "\n" if $VERBOSE > 2 && defined $PROGRESS_BAR;
|
|
print STDERR " Creating buffer for $month ... "
|
|
if $VERBOSE > 2;
|
|
$FH = tempfile or die "$THIS_FILE: tempfile: $!";
|
|
flock $FH, LOCK_EX or die "$THIS_FILE: tempfile: $!";
|
|
$self->{"FH"} = $FH;
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
}
|
|
$self->{"size_original"} = 0;
|
|
return $self;
|
|
}
|
|
|
|
# Add a record to the temporarily archive file
|
|
sub add : method {
|
|
local ($_, %_);
|
|
my ($self, $FH);
|
|
($self, $_) = @_;
|
|
$FH = $self->{"FH"};
|
|
print $FH $_ or die "$THIS_FILE: tempfile: $!";
|
|
$self->{"size_original"} += length $_;
|
|
return;
|
|
}
|
|
|
|
# Sort the records
|
|
sub sort : method {
|
|
local ($_, %_);
|
|
my ($self, $FH0, $FH1, $month, $count, $pos, $t, @recs);
|
|
$self = $_[0];
|
|
($FH0, $month) = ($self->{"FH"}, $self->{"month"});
|
|
|
|
print STDERR "Sorting records of $month ... " if $VERBOSE > 1;
|
|
print STDERR "\n" if $VERBOSE > 2;
|
|
|
|
# Obtain the information of each record
|
|
print STDERR " Obtain the time and position of the records ... "
|
|
if $VERBOSE > 2;
|
|
seek $FH0, 0, SEEK_SET or die "$THIS_FILE: tempfile: $!";
|
|
@recs = qw();
|
|
($pos = tell $FH0) != -1 or die "$THIS_FILE: tempfile: $!";
|
|
$count = 0;
|
|
while (defined($_ = <$FH0>)) {
|
|
$t = str2time($self->{"format"}->match($_));
|
|
push @recs, { "pos" => $pos, "time" => $t };
|
|
$count++;
|
|
($pos = tell $FH0) != -1 or die "$THIS_FILE: tempfile: $!";
|
|
}
|
|
print STDERR "$count records\n" if $VERBOSE > 2;
|
|
|
|
# Sort by time and then original order
|
|
print STDERR " Sorting the records by time ... " if $VERBOSE > 2;
|
|
@recs = CORE::sort { $$a{"time"} <=> $$b{"time"}
|
|
|| $$a{"pos"} <=> $$b{"pos"} } @recs;
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
|
|
# Store the records according to the new order
|
|
print STDERR " Creating new buffer for $month ... " if $VERBOSE > 2;
|
|
$FH1 = tempfile or die "$THIS_FILE: tempfile: $!";
|
|
flock $FH1, LOCK_EX or die "$THIS_FILE: tempfile: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
print STDERR " Storing sorted records to the new buffer ... "
|
|
if $VERBOSE > 2;
|
|
$count = 0;
|
|
foreach my $r (@recs) {
|
|
seek $FH0, $$r{"pos"}, SEEK_SET or die "$THIS_FILE: tempfile: $!";
|
|
$_ = <$FH0>;
|
|
print $FH1 $_ or die "$THIS_FILE: tempfile: $!";
|
|
$count++;
|
|
}
|
|
print STDERR "$count records\n" if $VERBOSE > 2;
|
|
|
|
# Use the new buffer instead of the old one
|
|
print STDERR " Switching to the new buffer ... " if $VERBOSE > 2;
|
|
flock $FH0, LOCK_UN or die "$THIS_FILE: tempfile: $!";
|
|
close $FH0 or die "$THIS_FILE: tempfile: $!";
|
|
$self->{"FH"} = $FH1;
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
|
|
print STDERR "$count records\n" if $VERBOSE > 1;
|
|
return;
|
|
}
|
|
|
|
# Store the archived log records
|
|
sub store_archive : method {
|
|
local ($_, %_);
|
|
my ($self, $FH, $file, $count);
|
|
$self = $_[0];
|
|
($FH, $file) = ($self->{"FH"}, $self->{"file"});
|
|
# Reset the file reader
|
|
seek $FH, 0, SEEK_SET or die "$THIS_FILE: tempfile: $!";
|
|
# Overwrite
|
|
if ($self->{"override"} eq OVERRIDE_OVERWRITE) {
|
|
print STDERR "Writing to $file ... " if $VERBOSE > 1;
|
|
print STDERR "\n" if $VERBOSE > 2;
|
|
$self->{"io"}->open_write($file);
|
|
# Append
|
|
} elsif ($self->{"override"} eq OVERRIDE_APPEND) {
|
|
print STDERR "Appending to $file ... " if $VERBOSE > 1;
|
|
print STDERR "\n" if $VERBOSE > 2;
|
|
$self->{"size_compressed"} = (stat $file)[7];
|
|
$self->{"io"}->open_append($file);
|
|
}
|
|
# Copy the data to the archive file
|
|
print STDERR " Writing records ... " if $VERBOSE > 2;
|
|
$count = 0;
|
|
while (defined($_ = <$FH>)) {
|
|
$self->{"io"}->write($_);
|
|
$count++;
|
|
}
|
|
print STDERR "$count records\n" if $VERBOSE > 2;
|
|
$self->{"io"}->close;
|
|
print STDERR "$count records\n" if $VERBOSE > 1;
|
|
# Report the statistics
|
|
# Overwrite
|
|
if ($self->{"override"} eq OVERRIDE_OVERWRITE) {
|
|
$self->{"size_compressed"} = (stat $file)[7];
|
|
printf STDERR "%s: writing %s records, %s bytes, %s bytes, %0.2f%%\n",
|
|
$self->{"month"}, format_number($count),
|
|
format_number($self->{"size_original"}),
|
|
format_number($self->{"size_compressed"}),
|
|
($self->{"size_compressed"}*100/$self->{"size_original"})
|
|
if $VERBOSE > 0;
|
|
|
|
# Append
|
|
} elsif ($self->{"override"} eq OVERRIDE_APPEND) {
|
|
$self->{"size_compressed"} = (stat $file)[7] - $self->{"size_compressed"};
|
|
printf STDERR "%s: adding %s records, %s bytes, %s bytes, %0.2f%%\n",
|
|
$self->{"month"}, format_number($count),
|
|
format_number($self->{"size_original"}),
|
|
format_number($self->{"size_compressed"}),
|
|
($self->{"size_compressed"}*100/$self->{"size_original"})
|
|
if $VERBOSE > 0;
|
|
}
|
|
return;
|
|
}
|
|
|
|
# _private::IO: The abstract I/O handler interface
|
|
package _private::IO;
|
|
use 5.008;
|
|
use strict;
|
|
use warnings;
|
|
BEGIN {
|
|
import main;
|
|
}
|
|
|
|
use Fcntl qw(:seek);
|
|
|
|
our ($GZIP_IO, $BZIP2_IO, $XZ_IO);
|
|
BEGIN {
|
|
undef $GZIP_IO;
|
|
undef $BZIP2_IO;
|
|
undef $XZ_IO;
|
|
}
|
|
|
|
# Initialize the I/O handler interface
|
|
sub new : method { bless {}, $_[0]; }
|
|
|
|
# The file name suffix of this mime type
|
|
sub suffix : method { ""; }
|
|
|
|
# Check for compression method of gzip
|
|
sub check_gzip : method {
|
|
local ($_, %_);
|
|
|
|
# Checked before
|
|
return ref($GZIP_IO)->new if defined $GZIP_IO;
|
|
|
|
# See whether IO::Compress::Gzip or gzip
|
|
print STDERR "Checking gzip I/O handler to use ... " if $VERBOSE > 1;
|
|
print STDERR "\n Checking IO::Compress::Gzip ... " if $VERBOSE > 2;
|
|
# Check if we have IO::Compress::Gzip
|
|
if (eval { require IO::Compress::Gzip; require IO::Uncompress::Gunzip; 1; }) {
|
|
print STDERR "OK\nfound " if $VERBOSE > 2;
|
|
print STDERR "IO::Compress::Gzip\n" if $VERBOSE > 1;
|
|
return ($GZIP_IO = _private::IO::Gzip::PM->new);
|
|
}
|
|
# Not found
|
|
print STDERR "no\n" if $VERBOSE > 2;
|
|
# It's OK not to warn
|
|
|
|
# Looking for gzip from PATH
|
|
print STDERR " Checking gzip... " if $VERBOSE > 2;
|
|
# Found in PATH
|
|
if (defined($_ = where_is "gzip")) {
|
|
print STDERR "$_\nfound " if $VERBOSE > 2;
|
|
print STDERR "$_\n" if $VERBOSE > 1;
|
|
return ($GZIP_IO = _private::IO::Gzip::Exec->new);
|
|
}
|
|
# Not found
|
|
print STDERR "no\n" if $VERBOSE > 2;
|
|
|
|
print STDERR "not found\n" if $VERBOSE > 1;
|
|
die "$THIS_FILE: Necessary IO::Compress::Gzip or gzip not available.\n$SHORT_HELP\n";
|
|
}
|
|
|
|
# Check for compression method of bzip2
|
|
sub check_bzip2 : method {
|
|
local ($_, %_);
|
|
|
|
# Checked before
|
|
return ref($BZIP2_IO)->new if defined $BZIP2_IO;
|
|
|
|
# See whether IO::Compress::Bzip2 or bzip2
|
|
print STDERR "Checking bzip2 I/O handler to use ... " if $VERBOSE > 1;
|
|
print STDERR "\n Checking IO::Compress::Bzip2 ... " if $VERBOSE > 2;
|
|
# Check if we have IO::Compress::Bzip2
|
|
if (eval { require IO::Compress::Bzip2; require IO::Uncompress::Bunzip2; 1; }) {
|
|
print STDERR "OK\nfound " if $VERBOSE > 2;
|
|
print STDERR "IO::Compress::Bzip2\n" if $VERBOSE > 1;
|
|
return ($BZIP2_IO = _private::IO::Bzip2::PM->new);
|
|
}
|
|
# Not found
|
|
print STDERR "no\n" if $VERBOSE > 2;
|
|
# It's OK not to warn
|
|
|
|
# Looking for bzip2 from PATH
|
|
print STDERR " Checking bzip2... " if $VERBOSE > 2;
|
|
# Found in PATH
|
|
if (defined($_ = where_is "bzip2")) {
|
|
print STDERR "$_\nfound " if $VERBOSE > 2;
|
|
print STDERR "$_\n" if $VERBOSE > 1;
|
|
return ($BZIP2_IO = _private::IO::Bzip2::Exec->new);
|
|
}
|
|
# Not found
|
|
print STDERR "no\n" if $VERBOSE > 2;
|
|
|
|
print STDERR "not found\n" if $VERBOSE > 1;
|
|
die "$THIS_FILE: Necessary IO::Compress::Bzip2 or bzip2 not available.\n$SHORT_HELP\n";
|
|
}
|
|
|
|
# Check for compression method of xz
|
|
sub check_xz : method {
|
|
local ($_, %_);
|
|
|
|
# Checked before
|
|
return ref($XZ_IO)->new if defined $XZ_IO;
|
|
|
|
# See whether IO::Compress::Xz or xz
|
|
print STDERR "Checking xz I/O handler to use ... " if $VERBOSE > 1;
|
|
print STDERR "\n Checking IO::Compress::Xz ... " if $VERBOSE > 2;
|
|
# Check if we have IO::Compress::Xz
|
|
if (eval { require IO::Compress::Xz; require IO::Uncompress::UnXz; 1; }) {
|
|
print STDERR "OK\nfound " if $VERBOSE > 2;
|
|
print STDERR "IO::Compress::Xz\n" if $VERBOSE > 1;
|
|
return ($XZ_IO = _private::IO::Xz::PM->new);
|
|
}
|
|
# Not found
|
|
print STDERR "no\n" if $VERBOSE > 2;
|
|
# It's OK not to warn
|
|
|
|
# Looking for xz from PATH
|
|
print STDERR " Checking xz... " if $VERBOSE > 2;
|
|
# Found in PATH
|
|
if (defined($_ = where_is "xz")) {
|
|
print STDERR "$_\nfound " if $VERBOSE > 2;
|
|
print STDERR "$_\n" if $VERBOSE > 1;
|
|
return ($XZ_IO = _private::IO::Xz::Exec->new);
|
|
}
|
|
# Not found
|
|
print STDERR "no\n" if $VERBOSE > 2;
|
|
|
|
print STDERR "not found\n" if $VERBOSE > 1;
|
|
die "$THIS_FILE: Necessary IO::Compress::Xz or xz not available.\n$SHORT_HELP\n";
|
|
}
|
|
|
|
# Prepend records to an existing file
|
|
# * static method *
|
|
# For most I/O we read records out and write back with 2 I/O accesses.
|
|
# But for plain text we need only open the file once.
|
|
# This implementation is for most I/O. Plain text implement this itself.
|
|
sub prepend_records : method {
|
|
local ($_, %_);
|
|
my ($class, $file, $FHT, $io, $count);
|
|
($class, $file, $FHT) = @_;
|
|
|
|
# Read the current records (added after program execution)
|
|
$io = $class->new;
|
|
print STDERR "Reading new records from $file ... " if $VERBOSE > 1;
|
|
print STDERR "\n" if $VERBOSE > 2;
|
|
$io->open_read($file);
|
|
print STDERR " Reading new records ... " if $VERBOSE > 2;
|
|
$count = 0;
|
|
while (defined($_ = $io->readline)) {
|
|
print $FHT $_ or die "$THIS_FILE: tempfile: $!";
|
|
$count++;
|
|
}
|
|
print STDERR "$count records\n" if $VERBOSE > 2;
|
|
$io->close;
|
|
print STDERR "$count records\n" if $VERBOSE > 1;
|
|
|
|
# Returning all the records
|
|
# Start a new I/O handler of the same class
|
|
seek $FHT, 0, SEEK_SET or die "$THIS_FILE: tempfile: $!";
|
|
$io = $class->new;
|
|
print STDERR "Returning all records to $file ... " if $VERBOSE > 1;
|
|
print STDERR "\n" if $VERBOSE > 2;
|
|
$io->open_write($file);
|
|
print STDERR " Writing records ... " if $VERBOSE > 2;
|
|
$count = 0;
|
|
while (defined($_ = <$FHT>)) {
|
|
$io->write($_);
|
|
$count++;
|
|
}
|
|
print STDERR "$count records\n" if $VERBOSE > 2;
|
|
$io->close;
|
|
print STDERR "$count records\n" if $VERBOSE > 1;
|
|
|
|
return;
|
|
}
|
|
|
|
|
|
# _private::IO::Plain: The plain I/O handler
|
|
package _private::IO::Plain;
|
|
use 5.008;
|
|
use strict;
|
|
use warnings;
|
|
use base qw(_private::IO);
|
|
BEGIN {
|
|
import main;
|
|
}
|
|
|
|
use Fcntl qw(:flock :seek);
|
|
|
|
# Open the file for reading
|
|
sub open_read : method {
|
|
local ($_, %_);
|
|
my ($self, $file, $FH);
|
|
($self, $file, $FH) = @_;
|
|
# Open the file if it is not opened yet
|
|
if (!defined $FH) {
|
|
print STDERR " Opening file in read mode ... " if $VERBOSE > 2;
|
|
open $FH, "+<", $file or die "$THIS_FILE: $file: $!";
|
|
flock $FH, LOCK_EX;
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
}
|
|
($self->{"file"}, $self->{"FH"}) = ($file, $FH);
|
|
return;
|
|
}
|
|
|
|
# Open the file for writing
|
|
sub open_write : method {
|
|
local ($_, %_);
|
|
my ($self, $file, $FH);
|
|
($self, $file, $FH) = @_;
|
|
# Open the file if it is not opened yet
|
|
if (!defined $FH) {
|
|
print STDERR " Creating file in write mode ... " if $VERBOSE > 2;
|
|
open $FH, "+>", $file or die "$THIS_FILE: $file: $!";
|
|
flock $FH, LOCK_EX;
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
}
|
|
($self->{"file"}, $self->{"FH"}) = ($file, $FH);
|
|
return;
|
|
}
|
|
|
|
# Open the file for appending
|
|
sub open_append : method {
|
|
local ($_, %_);
|
|
my ($self, $file, $FH);
|
|
($self, $file, $FH) = @_;
|
|
# Open the file if it is not opened yet
|
|
if (!defined $FH) {
|
|
print STDERR " Opening file in append mode ... " if $VERBOSE > 2;
|
|
open $FH, ">>", $file or die "$THIS_FILE: $file: $!";
|
|
flock $FH, LOCK_EX;
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
}
|
|
($self->{"file"}, $self->{"FH"}) = ($file, $FH);
|
|
return;
|
|
}
|
|
|
|
# Read a line from the I/O stream
|
|
sub readline : method {
|
|
local ($_, %_);
|
|
my ($self, $FH);
|
|
$self = $_[0];
|
|
$FH = $self->{"FH"};
|
|
return <$FH>;
|
|
}
|
|
|
|
# Output data to the I/O stream
|
|
sub write : method {
|
|
local ($_, %_);
|
|
my ($self, $file, $FH);
|
|
($self, $_) = @_;
|
|
($file, $FH) = ($self->{"file"}, $self->{"FH"});
|
|
print $FH $_ or die "$THIS_FILE: $file: $!";
|
|
return;
|
|
}
|
|
|
|
# Close the I/O stream
|
|
sub close : method {
|
|
local ($_, %_);
|
|
my ($self, $keep, $tmp, $file, $FH);
|
|
($self, $keep, $tmp) = @_;
|
|
$keep = KEEP_ALL if @_ < 2;
|
|
($file, $FH) = ($self->{"file"}, $self->{"FH"});
|
|
|
|
# Restart the file
|
|
if ($keep eq KEEP_RESTART || $keep eq KEEP_THIS_MONTH) {
|
|
# Empty the source file
|
|
print STDERR " Emptying file ... " if $VERBOSE > 2;
|
|
seek $FH, 0, SEEK_SET or die "$THIS_FILE: $file: $!";
|
|
truncate $FH, 0 or die "$THIS_FILE: $file: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
}
|
|
|
|
CORE::close $FH or die "$THIS_FILE: $file: $!";
|
|
delete $self->{"FH"};
|
|
delete $self->{"file"};
|
|
|
|
# Delete the file
|
|
if ($keep eq KEEP_DELETE) {
|
|
print STDERR " Deleting file ... " if $VERBOSE > 2;
|
|
unlink $file or die "$THIS_FILE: $file: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
}
|
|
# Delete the temporary file if needed
|
|
if (defined $tmp && -e $tmp) {
|
|
unlink $tmp or die "$THIS_FILE: $tmp: $!";
|
|
}
|
|
return;
|
|
}
|
|
|
|
# Prepend records to an existing file
|
|
# * static method *
|
|
# Plain text version that only open the file once
|
|
sub prepend_records : method {
|
|
local ($_, %_);
|
|
my ($class, $file, $FHT, $FHC, $count);
|
|
($class, $file, $FHT) = @_;
|
|
|
|
# Read the current records (added after program execution)
|
|
print STDERR "Reading new records from $file ... " if $VERBOSE > 1;
|
|
print STDERR "\n" if $VERBOSE > 2;
|
|
|
|
print STDERR " Opening file in read/write mode ... " if $VERBOSE > 2;
|
|
open $FHC, "+<", $file or die "$THIS_FILE: $file: $!";
|
|
flock $FHC, LOCK_EX;
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
|
|
# Read the new records
|
|
print STDERR " Reading new records ... " if $VERBOSE > 2;
|
|
$count = 0;
|
|
while (defined($_ = <$FHC>)) {
|
|
print $FHT $_ or die "$THIS_FILE: tempfile: $!";
|
|
$count++;
|
|
}
|
|
print STDERR "$count records\n" if $VERBOSE > 2;
|
|
|
|
# Reset the reader/writer
|
|
seek $FHT, 0, SEEK_SET or die "$THIS_FILE: tempfile: $!";
|
|
seek $FHC, 0, SEEK_SET or die "$THIS_FILE: $file: $!";
|
|
truncate $FHC, 0 or die "$THIS_FILE: $file: $!";
|
|
|
|
# Return all the records
|
|
print STDERR " Writing records ... " if $VERBOSE > 2;
|
|
$count = 0;
|
|
while (defined($_ = <$FHT>)) {
|
|
print $FHC $_ or die "$THIS_FILE: $file: $!";
|
|
$count++;
|
|
}
|
|
print STDERR "$count records\n" if $VERBOSE > 2;
|
|
|
|
CORE::close $FHC or die "$THIS_FILE: $file: $!";
|
|
print STDERR "$count records\n" if $VERBOSE > 1;
|
|
|
|
return;
|
|
}
|
|
|
|
|
|
# _private::IO::Gzip::PM: The gzip module compression I/O handler
|
|
package _private::IO::Gzip::PM;
|
|
use 5.008;
|
|
use strict;
|
|
use warnings;
|
|
use base qw(_private::IO);
|
|
BEGIN {
|
|
import main;
|
|
}
|
|
|
|
use Fcntl qw(:flock :seek);
|
|
use File::Temp qw(tempfile);
|
|
|
|
# The file name suffix of this mime type
|
|
sub suffix : method { ".gz"; }
|
|
|
|
# Open the file for reading
|
|
sub open_read : method {
|
|
local ($_, %_);
|
|
my ($self, $file, $FH);
|
|
($self, $file, $FH) = @_;
|
|
# Open the file if it is not opened yet
|
|
if (!defined $FH) {
|
|
print STDERR " Opening file in read mode ... " if $VERBOSE > 2;
|
|
open $FH, "+<", $file or die "$THIS_FILE: $file: $!";
|
|
binmode $FH or die "$THIS_FILE: $file: $!";
|
|
flock $FH, LOCK_EX;
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
}
|
|
($self->{"file"}, $self->{"FH"}) = ($file, $FH);
|
|
print STDERR " Attaching file with IO::Uncompress::Gunzip ... " if $VERBOSE > 2;
|
|
$self->{"gz"} = IO::Uncompress::Gunzip->new($FH)
|
|
or die "$THIS_FILE: $file: $IO::Uncompress::Gunzip::GunzipError";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
return;
|
|
}
|
|
|
|
# Open the file for writing
|
|
sub open_write : method {
|
|
local ($_, %_);
|
|
my ($self, $file, $FH);
|
|
($self, $file, $FH) = @_;
|
|
# Open the file if it is not opened yet
|
|
if (!defined $FH) {
|
|
print STDERR " Creating file in write mode ... " if $VERBOSE > 2;
|
|
open $FH, "+>", $file or die "$THIS_FILE: $file: $!";
|
|
binmode $FH or die "$THIS_FILE: $file: $!";
|
|
flock $FH, LOCK_EX;
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
}
|
|
($self->{"file"}, $self->{"FH"}) = ($file, $FH);
|
|
print STDERR " Attaching file with IO::Compress::Gzip ... " if $VERBOSE > 2;
|
|
$self->{"gz"} = IO::Compress::Gzip->new($FH)
|
|
or die "$THIS_FILE: $file: $IO::Compress::Gzip::GzipError";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
return;
|
|
}
|
|
|
|
# Open the file for appending
|
|
sub open_append : method {
|
|
local ($_, %_);
|
|
my ($self, $file, $FH, $gz);
|
|
($self, $file, $FH) = @_;
|
|
# Open the file if it is not opened yet
|
|
if (!defined $FH) {
|
|
print STDERR " Opening file in read/write mode ... " if $VERBOSE > 2;
|
|
open $FH, "+<", $file or die "$THIS_FILE: $file: $!";
|
|
binmode $FH or die "$THIS_FILE: $file: $!";
|
|
flock $FH, LOCK_EX;
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
}
|
|
($self->{"file"}, $self->{"FH"}) = ($file, $FH);
|
|
|
|
# Save the original data if file has content so that file size is
|
|
# greater than 0. STDOUT is always of size 0.
|
|
if ((stat $FH)[7] > 0) {
|
|
my ($count, $FHT, $gzt, $n);
|
|
seek $FH, 0, SEEK_SET or die "$THIS_FILE: $file: $!";
|
|
# Copy the original content to a buffer
|
|
print STDERR " Reading compressed data to the buffer ... " if $VERBOSE > 2;
|
|
$FHT = tempfile or die "$THIS_FILE: tempfile: $!";
|
|
while (defined($_ = <$FH>)) {
|
|
print $FHT $_ or die "$THIS_FILE: tempfile: $!";
|
|
}
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
print STDERR " Restarting file ... " if $VERBOSE > 2;
|
|
seek $FHT, 0, SEEK_SET or die "$THIS_FILE: tempfile: $!";
|
|
seek $FH, 0, SEEK_SET or die "$THIS_FILE: $file: $!";
|
|
truncate $FH, 0 or die "$THIS_FILE: $file: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
|
|
# Decompress the buffer and save to our file
|
|
print STDERR " Attaching buffer with IO::Uncompress::Gunzip ... " if $VERBOSE > 2;
|
|
$gzt = IO::Uncompress::Gunzip->new($FHT)
|
|
or die "$THIS_FILE: tempfile: $IO::Uncompress::Gunzip::GunzipError";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
print STDERR " Attaching file with IO::Compress::Gzip ... " if $VERBOSE > 2;
|
|
$gz = IO::Compress::Gzip->new($FH)
|
|
or die "$THIS_FILE: $file: $IO::Compress::Gzip::GzipError";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
|
|
print STDERR " Reading old records back from the buffer ... " if $VERBOSE > 2;
|
|
$count = 0;
|
|
while (defined($_ = $gzt->getline)) {
|
|
($gz->write($_) == length $_)
|
|
or die "$THIS_FILE: $file: $IO::Compress::Gzip::GzipError";
|
|
$count++;
|
|
}
|
|
close $FHT or die "$THIS_FILE: tempfile: $!";
|
|
print STDERR "$count records\n" if $VERBOSE > 2;
|
|
|
|
# A whole new file
|
|
} else {
|
|
print STDERR " Attaching file with IO::Compress::Gzip ... " if $VERBOSE > 2;
|
|
$gz = IO::Compress::Gzip->new($FH)
|
|
or die "$THIS_FILE: $file: $IO::Compress::Gzip::GzipError";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
}
|
|
|
|
$self->{"gz"} = $gz;
|
|
return;
|
|
}
|
|
|
|
# Read a line from the I/O stream
|
|
sub readline : method {
|
|
return $_[0]->{"gz"}->getline();
|
|
}
|
|
|
|
# Output data to the I/O stream
|
|
sub write : method {
|
|
local ($_, %_);
|
|
my ($self, $file, $gz);
|
|
($self, $_) = @_;
|
|
($file, $gz) = ($self->{"file"}, $self->{"gz"});
|
|
($gz->write($_) == length $_) or die "$THIS_FILE: $file: $IO::Compress::Gzip::GzipError";
|
|
return;
|
|
}
|
|
|
|
# Close the I/O stream
|
|
sub close : method {
|
|
local ($_, %_);
|
|
my ($self, $keep, $tmp, $file, $FH, $gz);
|
|
($self, $keep, $tmp) = @_;
|
|
$keep = KEEP_ALL if @_ < 2;
|
|
($file, $FH, $gz) = ($self->{"file"}, $self->{"FH"}, $self->{"gz"});
|
|
|
|
# Restart the file
|
|
if ($keep eq KEEP_RESTART || $keep eq KEEP_THIS_MONTH) {
|
|
# Empty the source file
|
|
print STDERR " Emptying file ... " if $VERBOSE > 2;
|
|
seek $FH, 0, SEEK_SET or die "$THIS_FILE: $file: $!";
|
|
truncate $FH, 0 or die "$THIS_FILE: $file: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
|
|
# Create empty compressed content
|
|
print STDERR " Applying empty compressed content ... " if $VERBOSE > 2;
|
|
$_ = IO::Compress::Gzip->new($FH, Append => 0)
|
|
or die "$THIS_FILE: $file: $IO::Compress::Gzip::GzipError";
|
|
$_->close or die "$THIS_FILE: $file: $IO::Compress::Gzip::GzipError";
|
|
undef $_;
|
|
undef $gz;
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
}
|
|
|
|
if (defined $gz) {
|
|
$gz->close or die "$THIS_FILE: $file: $IO::Compress::Gzip::GzipError";
|
|
}
|
|
CORE::close $self->{"FH"} if $self->{"FH"}->opened;
|
|
delete $self->{"gz"};
|
|
delete $self->{"FH"};
|
|
delete $self->{"file"};
|
|
|
|
# Delete the file
|
|
if ($keep eq KEEP_DELETE) {
|
|
print STDERR " Deleting file ... " if $VERBOSE > 2;
|
|
unlink $file or die "$THIS_FILE: $file: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
}
|
|
# Delete the temporary file if needed
|
|
if (defined $tmp && -e $tmp) {
|
|
unlink $tmp or die "$THIS_FILE: $tmp: $!";
|
|
}
|
|
return;
|
|
}
|
|
|
|
|
|
# _private::IO::Gzip::Exec: The gzip executable compression I/O handler
|
|
package _private::IO::Gzip::Exec;
|
|
use 5.008;
|
|
use strict;
|
|
use warnings;
|
|
use base qw(_private::IO);
|
|
BEGIN {
|
|
import main;
|
|
}
|
|
|
|
use Fcntl qw(:flock :seek);
|
|
use File::Temp qw(tempfile);
|
|
|
|
our ($EXEC);
|
|
BEGIN {
|
|
undef $EXEC;
|
|
}
|
|
|
|
# The file name suffix of this mime type
|
|
sub suffix : method { ".gz"; }
|
|
|
|
# Open the file for reading
|
|
sub open_read : method {
|
|
local ($_, %_);
|
|
my ($self, $file, $FH, $PH, $CMD);
|
|
($self, $file, $FH) = @_;
|
|
# Open the file if it is not opened yet
|
|
if (!defined $FH) {
|
|
print STDERR " Opening file in read mode ... " if $VERBOSE > 2;
|
|
open $FH, "+<", $file or die "$THIS_FILE: $file: $!";
|
|
binmode $FH or die "$THIS_FILE: $file: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
} else {
|
|
flock $FH, LOCK_UN;
|
|
}
|
|
($self->{"file"}, $self->{"FH"}) = ($file, $FH);
|
|
$EXEC = where_is "gzip" if !defined $EXEC;
|
|
|
|
@_ = ($EXEC, "-cdf");
|
|
@_ = map "\"$_\"", @_ if $^O eq "MSWin32";
|
|
$CMD = join " ", @_;
|
|
print STDERR " Starting $CMD from file ... " if $VERBOSE > 2;
|
|
# Redirect STDIN to $FH
|
|
open STDIN, "<&", $FH or die "$THIS_FILE: $file: $!";
|
|
# Start the process
|
|
if ($^O eq "MSWin32") {
|
|
open $PH, "$CMD |" or die "$THIS_FILE: $CMD: $!";
|
|
} else {
|
|
open $PH, "-|", @_ or die "$THIS_FILE: $CMD: $!";
|
|
}
|
|
# Restore STDIN
|
|
open STDIN, "<&", $STDIN or die "$THIS_FILE: STDIN: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
($self->{"CMD"}, $self->{"PH"}) = ([@_], $PH);
|
|
return;
|
|
}
|
|
|
|
# Open the file for writing
|
|
sub open_write : method {
|
|
local ($_, %_);
|
|
my ($self, $file, $FH, $PH, $CMD);
|
|
($self, $file, $FH) = @_;
|
|
# Open the file if it is not opened yet
|
|
if (!defined $FH) {
|
|
print STDERR " Creating file in write mode ... " if $VERBOSE > 2;
|
|
open $FH, "+>", $file or die "$THIS_FILE: $file: $!";
|
|
binmode $FH or die "$THIS_FILE: $file: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
} else {
|
|
flock $FH, LOCK_UN;
|
|
}
|
|
($self->{"file"}, $self->{"FH"}) = ($file, $FH);
|
|
$EXEC = where_is "gzip" if !defined $EXEC;
|
|
|
|
@_ = ($EXEC, "-c9f");
|
|
@_ = map "\"$_\"", @_ if $^O eq "MSWin32";
|
|
$CMD = join " ", @_;
|
|
print STDERR " Starting $CMD to file ... " if $VERBOSE > 2;
|
|
# Redirect STDOUT to $FH
|
|
open STDOUT, ">&", $FH or die "$THIS_FILE: $file: $!";
|
|
# Start the process
|
|
if ($^O eq "MSWin32") {
|
|
open $PH, "| $CMD" or die "$THIS_FILE: $CMD: $!";
|
|
} else {
|
|
open $PH, "|-", @_ or die "$THIS_FILE: $CMD: $!";
|
|
}
|
|
# Restore STDOUT
|
|
open STDOUT, ">&", $STDOUT or die "$THIS_FILE: STDOUT: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
($self->{"CMD"}, $self->{"PH"}) = ([@_], $PH);
|
|
return;
|
|
}
|
|
|
|
# Open the file for appending
|
|
sub open_append : method {
|
|
local ($_, %_);
|
|
my ($self, $file, $FH, $PH, $CMD);
|
|
($self, $file, $FH) = @_;
|
|
# Open the file if it is not opened yet
|
|
if (!defined $FH) {
|
|
print STDERR " Opening file in read/write mode ... " if $VERBOSE > 2;
|
|
open $FH, "+<", $file or die "$THIS_FILE: $file: $!";
|
|
binmode $FH or die "$THIS_FILE: $file: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
} else {
|
|
flock $FH, LOCK_UN;
|
|
}
|
|
($self->{"file"}, $self->{"FH"}) = ($file, $FH);
|
|
$EXEC = where_is "gzip" if !defined $EXEC;
|
|
|
|
# Save the original data if file has content so that file size is
|
|
# greater than 0. STDOUT is always of size 0.
|
|
if ((stat $FH)[7] > 0) {
|
|
my ($count, $FHT, $PHT, $CMD_T);
|
|
seek $FH, 0, SEEK_SET or die "$THIS_FILE: $file: $!";
|
|
# Copy the original content to a buffer
|
|
print STDERR " Reading compressed data to the buffer ... " if $VERBOSE > 2;
|
|
$FHT = tempfile or die "$THIS_FILE: tempfile: $!";
|
|
while (defined($_ = <$FH>)) {
|
|
print $FHT $_ or die "$THIS_FILE: tempfile: $!";
|
|
}
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
print STDERR " Restarting file ... " if $VERBOSE > 2;
|
|
seek $FHT, 0, SEEK_SET or die "$THIS_FILE: tempfile: $!";
|
|
seek $FH, 0, SEEK_SET or die "$THIS_FILE: $file: $!";
|
|
truncate $FH, 0 or die "$THIS_FILE: $file: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
|
|
# Decompress the buffer and save to our file
|
|
@_ = ($EXEC, "-cdf");
|
|
@_ = map "\"$_\"", @_ if $^O eq "MSWin32";
|
|
$CMD_T = join " ", @_;
|
|
print STDERR " Starting $CMD_T from buffer ... " if $VERBOSE > 2;
|
|
# Redirect STDIN to $FH
|
|
open STDIN, "<&", $FHT or die "$THIS_FILE: tempfile: $!";
|
|
# Start the process
|
|
if ($^O eq "MSWin32") {
|
|
open $PHT, "$CMD_T |" or die "$THIS_FILE: $CMD_T: $!";
|
|
} else {
|
|
open $PHT, "-|", @_ or die "$THIS_FILE: $CMD_T: $!";
|
|
}
|
|
# Restore STDIN
|
|
open STDIN, "<&", $STDIN or die "$THIS_FILE: STDIN: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
|
|
@_ = ($EXEC, "-c9f");
|
|
@_ = map "\"$_\"", @_ if $^O eq "MSWin32";
|
|
$CMD = join " ", @_;
|
|
print STDERR " Starting $CMD to file ... " if $VERBOSE > 2;
|
|
# Redirect STDOUT to $FH
|
|
open STDOUT, ">&", $FH or die "$THIS_FILE: $file: $!";
|
|
# Start the process
|
|
if ($^O eq "MSWin32") {
|
|
open $PH, "| $CMD" or die "$THIS_FILE: $CMD: $!";
|
|
} else {
|
|
open $PH, "|-", @_ or die "$THIS_FILE: $CMD: $!";
|
|
}
|
|
# Restore STDOUT
|
|
open STDOUT, ">&", $STDOUT or die "$THIS_FILE: STDOUT: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
|
|
print STDERR " Reading old records back from the buffer ... " if $VERBOSE > 2;
|
|
$count = 0;
|
|
while (defined($_ = <$PHT>)) {
|
|
print $PH $_ or die "$THIS_FILE: $file: $!";
|
|
$count++;
|
|
}
|
|
close $PHT or die "$THIS_FILE: $CMD_T: $!";
|
|
close $FHT or die "$THIS_FILE: tempfile: $!";
|
|
print STDERR "$count records\n" if $VERBOSE > 2;
|
|
|
|
# A whole new file
|
|
} else {
|
|
@_ = ($EXEC, "-c9f");
|
|
@_ = map "\"$_\"", @_ if $^O eq "MSWin32";
|
|
$CMD = join " ", @_;
|
|
print STDERR " Starting $CMD to file ... " if $VERBOSE > 2;
|
|
# Redirect STDOUT to $FH
|
|
open STDOUT, ">&", $FH or die "$THIS_FILE: $file: $!";
|
|
# Start the process
|
|
if ($^O eq "MSWin32") {
|
|
open $PH, "| $CMD" or die "$THIS_FILE: $CMD: $!";
|
|
} else {
|
|
open $PH, "|-", @_ or die "$THIS_FILE: $CMD: $!";
|
|
}
|
|
# Restore STDOUT
|
|
open STDOUT, ">&", $STDOUT or die "$THIS_FILE: STDOUT: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
}
|
|
|
|
($self->{"CMD"}, $self->{"PH"}) = ([@_], $PH);
|
|
return;
|
|
}
|
|
|
|
# Read a line from the I/O stream
|
|
sub readline : method {
|
|
local ($_, %_);
|
|
my ($self, $PH);
|
|
$self = $_[0];
|
|
$PH = $self->{"PH"};
|
|
return <$PH>;
|
|
}
|
|
|
|
# Output data to the I/O stream
|
|
sub write : method {
|
|
local ($_, %_);
|
|
my ($self, $CMD, $PH);
|
|
($self, $_) = @_;
|
|
($CMD, $PH) = (join(" ", @{$self->{"CMD"}}), $self->{"PH"});
|
|
print $PH $_ or die "$THIS_FILE: $CMD: $!";
|
|
return;
|
|
}
|
|
|
|
# Close the I/O stream
|
|
sub close : method {
|
|
local ($_, %_);
|
|
my ($self, $keep, $tmp, $file, $FH, $CMD, $PH);
|
|
($self, $keep, $tmp) = @_;
|
|
$keep = KEEP_ALL if @_ < 2;
|
|
($file, $FH) = ($self->{"file"}, $self->{"FH"});
|
|
|
|
# Restart the file
|
|
if ($keep eq KEEP_RESTART || $keep eq KEEP_THIS_MONTH) {
|
|
# Empty the source file
|
|
print STDERR " Emptying file ... " if $VERBOSE > 2;
|
|
seek $FH, 0, SEEK_SET or die "$THIS_FILE: $file: $!";
|
|
truncate $FH, 0 or die "$THIS_FILE: $file: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
|
|
# Create empty compressed content
|
|
print STDERR " Applying empty compressed content ... " if $VERBOSE > 2;
|
|
$EXEC = where_is "gzip" if !defined $EXEC;
|
|
@_ = ($EXEC, "-c9f");
|
|
@_ = map "\"$_\"", @_ if $^O eq "MSWin32";
|
|
$CMD = join " ", @_;
|
|
# Redirect STDOUT to $FH
|
|
open STDOUT, ">&", $FH or die "$THIS_FILE: $file: $!";
|
|
# Start the process and end it
|
|
if ($^O eq "MSWin32") {
|
|
open $PH, "| $CMD" or die "$THIS_FILE: $CMD: $!";
|
|
} else {
|
|
open $PH, "|-", @_ or die "$THIS_FILE: $CMD: $!";
|
|
}
|
|
close $PH or die "$THIS_FILE: $CMD: $!";
|
|
# Restore STDOUT
|
|
open STDOUT, ">&", $STDOUT or die "$THIS_FILE: STDOUT: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
}
|
|
|
|
($CMD, $PH) = (join(" ", @{$self->{"CMD"}}), $self->{"PH"});
|
|
CORE::close $PH or die "$THIS_FILE: $CMD: $!";
|
|
CORE::close $FH or die "$THIS_FILE: $file: $!";
|
|
delete $self->{"PH"};
|
|
delete $self->{"CMD"};
|
|
delete $self->{"FH"};
|
|
delete $self->{"file"};
|
|
|
|
# Delete the file
|
|
if ($keep eq KEEP_DELETE) {
|
|
print STDERR " Deleting file ... " if $VERBOSE > 2;
|
|
unlink $file or die "$THIS_FILE: $file: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
}
|
|
# Delete the temporary file if needed
|
|
if (defined $tmp && -e $tmp) {
|
|
unlink $tmp or die "$THIS_FILE: $tmp: $!";
|
|
}
|
|
return;
|
|
}
|
|
|
|
|
|
# _private::IO::Bzip2::PM: The bzip2 module compression I/O handler
|
|
package _private::IO::Bzip2::PM;
|
|
use 5.008;
|
|
use strict;
|
|
use warnings;
|
|
use base qw(_private::IO);
|
|
BEGIN {
|
|
import main;
|
|
}
|
|
|
|
use Fcntl qw(:flock :seek);
|
|
use File::Temp qw(tempfile);
|
|
|
|
# The file name suffix of this mime type
|
|
sub suffix : method { ".bz2"; }
|
|
|
|
# Open the file for reading
|
|
sub open_read : method {
|
|
local ($_, %_);
|
|
my ($self, $file, $FH);
|
|
($self, $file, $FH) = @_;
|
|
# Open the file if it is not opened yet
|
|
if (!defined $FH) {
|
|
print STDERR " Opening file in read mode ... " if $VERBOSE > 2;
|
|
open $FH, "+<", $file or die "$THIS_FILE: $file: $!";
|
|
binmode $FH or die "$THIS_FILE: $file: $!";
|
|
flock $FH, LOCK_EX;
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
}
|
|
($self->{"file"}, $self->{"FH"}) = ($file, $FH);
|
|
print STDERR " Attaching file with IO::Uncompress::Bunzip2 ... " if $VERBOSE > 2;
|
|
$self->{"bz"} = IO::Uncompress::Bunzip2->new($FH)
|
|
or die "$THIS_FILE: $file: $IO::Uncompress::Bunzip2::Bunzip2Error";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
return;
|
|
}
|
|
|
|
# Open the file for writing
|
|
sub open_write : method {
|
|
local ($_, %_);
|
|
my ($self, $file, $FH);
|
|
($self, $file, $FH) = @_;
|
|
# Open the file if it is not opened yet
|
|
if (!defined $FH) {
|
|
print STDERR " Creating file in write mode ... " if $VERBOSE > 2;
|
|
open $FH, "+>", $file or die "$THIS_FILE: $file: $!";
|
|
binmode $FH or die "$THIS_FILE: $file: $!";
|
|
flock $FH, LOCK_EX;
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
}
|
|
($self->{"file"}, $self->{"FH"}) = ($file, $FH);
|
|
print STDERR " Attaching file with IO::Compress::Bzip2 ... " if $VERBOSE > 2;
|
|
$self->{"bz"} = IO::Compress::Bzip2->new($FH)
|
|
or die "$THIS_FILE: $file: $IO::Compress::Bzip2::Bzip2Error";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
return;
|
|
}
|
|
|
|
# Open the file for appending
|
|
sub open_append : method {
|
|
local ($_, %_);
|
|
my ($self, $file, $FH, $bz);
|
|
($self, $file, $FH) = @_;
|
|
# Open the file if it is not opened yet
|
|
if (!defined $FH) {
|
|
print STDERR " Opening file in read/write mode ... " if $VERBOSE > 2;
|
|
open $FH, "+<", $file or die "$THIS_FILE: $file: $!";
|
|
binmode $FH or die "$THIS_FILE: $file: $!";
|
|
flock $FH, LOCK_EX;
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
}
|
|
($self->{"file"}, $self->{"FH"}) = ($file, $FH);
|
|
|
|
# Save the original data if file has content so that file size is
|
|
# greater than 0. STDOUT is always of size 0.
|
|
if ((stat $FH)[7] > 0) {
|
|
my ($count, $FHT, $bzt, $n);
|
|
seek $FH, 0, SEEK_SET or die "$THIS_FILE: $file: $!";
|
|
# Copy the original content to a buffer
|
|
print STDERR " Reading compressed data to the buffer ... " if $VERBOSE > 2;
|
|
$FHT = tempfile or die "$THIS_FILE: tempfile: $!";
|
|
while (defined($_ = <$FH>)) {
|
|
print $FHT $_ or die "$THIS_FILE: tempfile: $!";
|
|
}
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
print STDERR " Restarting file ... " if $VERBOSE > 2;
|
|
seek $FHT, 0, SEEK_SET or die "$THIS_FILE: tempfile: $!";
|
|
seek $FH, 0, SEEK_SET or die "$THIS_FILE: $file: $!";
|
|
truncate $FH, 0 or die "$THIS_FILE: $file: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
|
|
# Decompress the buffer and save to our file
|
|
print STDERR " Attaching buffer with IO::Uncompress::Bunzip2 ... " if $VERBOSE > 2;
|
|
$bzt = IO::Uncompress::Bunzip2->new($FHT)
|
|
or die "$THIS_FILE: $file: $IO::Uncompress::Bunzip2::Bunzip2Error";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
print STDERR " Attaching file with IO::Compress::Bzip2 ... " if $VERBOSE > 2;
|
|
$bz = IO::Compress::Bzip2->new($FH)
|
|
or die "$THIS_FILE: $file: $IO::Compress::Bzip2::Bzip2Error";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
|
|
print STDERR " Reading old records back from the buffer ... " if $VERBOSE > 2;
|
|
$count = 0;
|
|
while (defined($_ = $bzt->getline)) {
|
|
($bz->write($_) == length $_)
|
|
or die "$THIS_FILE: $file: $IO::Compress::Bzip2::Bzip2Error";
|
|
$count++;
|
|
}
|
|
close $FHT or die "$THIS_FILE: tempfile: $!";
|
|
print STDERR "$count records\n" if $VERBOSE > 2;
|
|
|
|
# A whole new file
|
|
} else {
|
|
print STDERR " Attaching file with IO::Compress::Bzip2 ... " if $VERBOSE > 2;
|
|
$bz = IO::Compress::Bzip2->new($FH)
|
|
or die "$THIS_FILE: $file: $IO::Compress::Bzip2::Bzip2Error";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
}
|
|
|
|
$self->{"bz"} = $bz;
|
|
return;
|
|
}
|
|
|
|
# Read a line from the I/O stream
|
|
sub readline : method {
|
|
return $_[0]->{"bz"}->getline();
|
|
}
|
|
|
|
# Output data to the I/O stream
|
|
sub write : method {
|
|
local ($_, %_);
|
|
my ($self, $file, $bz);
|
|
($self, $_) = @_;
|
|
($file, $bz) = ($self->{"file"}, $self->{"bz"});
|
|
($bz->write($_) == length $_) or die "$THIS_FILE: $file: $IO::Compress::Xz::XzError";
|
|
return;
|
|
}
|
|
|
|
# Close the I/O stream
|
|
sub close : method {
|
|
local ($_, %_);
|
|
my ($self, $keep, $tmp, $file, $FH, $bz);
|
|
($self, $keep, $tmp) = @_;
|
|
$keep = KEEP_ALL if @_ < 2;
|
|
($file, $FH, $bz) = ($self->{"file"}, $self->{"FH"}, $self->{"bz"});
|
|
|
|
# Restart the file
|
|
if ($keep eq KEEP_RESTART || $keep eq KEEP_THIS_MONTH) {
|
|
# Empty the source file
|
|
print STDERR " Emptying file ... " if $VERBOSE > 2;
|
|
seek $FH, 0, SEEK_SET or die "$THIS_FILE: $file: $!";
|
|
truncate $FH, 0 or die "$THIS_FILE: $file: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
|
|
# Create empty compressed content
|
|
print STDERR " Applying empty compressed content ... " if $VERBOSE > 2;
|
|
$_ = IO::Compress::Bzip2->new($FH)
|
|
or die "$THIS_FILE: $file: $IO::Compress::Bzip2::Bzip2Error";
|
|
$_->close or die "$THIS_FILE: $file: $IO::Compress::Bzip2::Bzip2Error";
|
|
undef $_;
|
|
undef $bz;
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
}
|
|
|
|
if (defined $bz) {
|
|
$bz->close or die "$THIS_FILE: $file: $IO::Compress::Bzip2::Bzip2Error";
|
|
}
|
|
CORE::close $self->{"FH"} if $self->{"FH"}->opened;
|
|
delete $self->{"bz"};
|
|
delete $self->{"FH"};
|
|
delete $self->{"file"};
|
|
|
|
# Delete the file
|
|
if ($keep eq KEEP_DELETE) {
|
|
print STDERR " Deleting file ... " if $VERBOSE > 2;
|
|
unlink $file or die "$THIS_FILE: $file: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
}
|
|
# Delete the temporary file if needed
|
|
if (defined $tmp && -e $tmp) {
|
|
unlink $tmp or die "$THIS_FILE: $tmp: $!";
|
|
}
|
|
return;
|
|
}
|
|
|
|
|
|
# _private::IO::Bzip2::Exec: The bzip2 executable compression I/O handler
|
|
package _private::IO::Bzip2::Exec;
|
|
use 5.008;
|
|
use strict;
|
|
use warnings;
|
|
use base qw(_private::IO);
|
|
BEGIN {
|
|
import main;
|
|
}
|
|
|
|
use Fcntl qw(:flock :seek);
|
|
use File::Temp qw(tempfile);
|
|
|
|
our ($EXEC);
|
|
BEGIN {
|
|
undef $EXEC;
|
|
}
|
|
|
|
# The file name suffix of this mime type
|
|
sub suffix : method { ".bz2"; }
|
|
|
|
# Open the file for reading
|
|
sub open_read : method {
|
|
local ($_, %_);
|
|
my ($self, $file, $FH, $PH, $CMD);
|
|
($self, $file, $FH) = @_;
|
|
# Open the file if it is not opened yet
|
|
if (!defined $FH) {
|
|
print STDERR " Opening file in read mode ... " if $VERBOSE > 2;
|
|
open $FH, "+<", $file or die "$THIS_FILE: $file: $!";
|
|
binmode $FH or die "$THIS_FILE: $file: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
} else {
|
|
flock $FH, LOCK_UN;
|
|
}
|
|
($self->{"file"}, $self->{"FH"}) = ($file, $FH);
|
|
$EXEC = where_is "bzip2" if !defined $EXEC;
|
|
|
|
@_ = ($EXEC, "-cdf");
|
|
@_ = map "\"$_\"", @_ if $^O eq "MSWin32";
|
|
$CMD = join " ", @_;
|
|
print STDERR " Starting $CMD from file ... " if $VERBOSE > 2;
|
|
# Redirect STDIN to $FH
|
|
open STDIN, "<&", $FH or die "$THIS_FILE: $file: $!";
|
|
# Start the process
|
|
if ($^O eq "MSWin32") {
|
|
open $PH, "$CMD |" or die "$THIS_FILE: $CMD: $!";
|
|
} else {
|
|
open $PH, "-|", @_ or die "$THIS_FILE: $CMD: $!";
|
|
}
|
|
# Restore STDIN
|
|
open STDIN, "<&", $STDIN or die "$THIS_FILE: STDIN: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
($self->{"CMD"}, $self->{"PH"}) = ([@_], $PH);
|
|
return;
|
|
}
|
|
|
|
# Open the file for writing
|
|
sub open_write : method {
|
|
local ($_, %_);
|
|
my ($self, $file, $FH, $PH, $CMD);
|
|
($self, $file, $FH) = @_;
|
|
# Open the file if it is not opened yet
|
|
if (!defined $FH) {
|
|
print STDERR " Creating file in write mode ... " if $VERBOSE > 2;
|
|
open $FH, "+>", $file or die "$THIS_FILE: $file: $!";
|
|
binmode $FH or die "$THIS_FILE: $file: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
} else {
|
|
flock $FH, LOCK_UN;
|
|
}
|
|
($self->{"file"}, $self->{"FH"}) = ($file, $FH);
|
|
$EXEC = where_is "bzip2" if !defined $EXEC;
|
|
|
|
@_ = ($EXEC, "-9f");
|
|
@_ = map "\"$_\"", @_ if $^O eq "MSWin32";
|
|
$CMD = join " ", @_;
|
|
print STDERR " Starting $CMD to file ... " if $VERBOSE > 2;
|
|
# Redirect STDOUT to $FH
|
|
open STDOUT, ">&", $FH or die "$THIS_FILE: $file: $!";
|
|
# Start the process
|
|
if ($^O eq "MSWin32") {
|
|
open $PH, "| $CMD" or die "$THIS_FILE: $CMD: $!";
|
|
} else {
|
|
open $PH, "|-", @_ or die "$THIS_FILE: $CMD: $!";
|
|
}
|
|
# Restore STDOUT
|
|
open STDOUT, ">&", $STDOUT or die "$THIS_FILE: STDOUT: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
($self->{"CMD"}, $self->{"PH"}) = ([@_], $PH);
|
|
return;
|
|
}
|
|
|
|
# Open the file for appending
|
|
sub open_append : method {
|
|
local ($_, %_);
|
|
my ($self, $file, $FH, $PH, $CMD);
|
|
($self, $file, $FH) = @_;
|
|
# Open the file if it is not opened yet
|
|
if (!defined $FH) {
|
|
print STDERR " Opening file in read/write mode ... " if $VERBOSE > 2;
|
|
open $FH, "+<", $file or die "$THIS_FILE: $file: $!";
|
|
binmode $FH or die "$THIS_FILE: $file: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
} else {
|
|
flock $FH, LOCK_UN;
|
|
}
|
|
($self->{"file"}, $self->{"FH"}) = ($file, $FH);
|
|
$EXEC = where_is "bzip2" if !defined $EXEC;
|
|
|
|
# Save the original data if file has content so that file size is
|
|
# greater than 0. STDOUT is always of size 0.
|
|
if ((stat $FH)[7] > 0) {
|
|
my ($count, $FHT, $PHT, $CMD_T);
|
|
seek $FH, 0, SEEK_SET or die "$THIS_FILE: $file: $!";
|
|
# Copy the original content to a buffer
|
|
print STDERR " Reading compressed data to the buffer ... " if $VERBOSE > 2;
|
|
$FHT = tempfile or die "$THIS_FILE: tempfile: $!";
|
|
while (defined($_ = <$FH>)) {
|
|
print $FHT $_ or die "$THIS_FILE: tempfile: $!";
|
|
}
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
print STDERR " Restarting file ... " if $VERBOSE > 2;
|
|
seek $FHT, 0, SEEK_SET or die "$THIS_FILE: tempfile: $!";
|
|
seek $FH, 0, SEEK_SET or die "$THIS_FILE: $file: $!";
|
|
truncate $FH, 0 or die "$THIS_FILE: $file: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
|
|
# Decompress the buffer and save to our file
|
|
@_ = ($EXEC, "-cdf");
|
|
@_ = map "\"$_\"", @_ if $^O eq "MSWin32";
|
|
$CMD_T = join " ", @_;
|
|
print STDERR " Starting $CMD_T from buffer ... " if $VERBOSE > 2;
|
|
# Redirect STDIN to $FH
|
|
open STDIN, "<&", $FHT or die "$THIS_FILE: tempfile: $!";
|
|
# Start the process
|
|
if ($^O eq "MSWin32") {
|
|
open $PHT, "$CMD_T |" or die "$THIS_FILE: $CMD_T: $!";
|
|
} else {
|
|
open $PHT, "-|", @_ or die "$THIS_FILE: $CMD_T: $!";
|
|
}
|
|
# Restore STDIN
|
|
open STDIN, "<&", $STDIN or die "$THIS_FILE: STDIN: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
|
|
@_ = ($EXEC, "-9f");
|
|
@_ = map "\"$_\"", @_ if $^O eq "MSWin32";
|
|
$CMD = join " ", @_;
|
|
print STDERR " Starting $CMD to file ... " if $VERBOSE > 2;
|
|
# Redirect STDOUT to $FH
|
|
open STDOUT, ">&", $FH or die "$THIS_FILE: $file: $!";
|
|
# Start the process
|
|
if ($^O eq "MSWin32") {
|
|
open $PH, "| $CMD" or die "$THIS_FILE: $CMD: $!";
|
|
} else {
|
|
open $PH, "|-", @_ or die "$THIS_FILE: $CMD: $!";
|
|
}
|
|
# Restore STDOUT
|
|
open STDOUT, ">&", $STDOUT or die "$THIS_FILE: STDOUT: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
|
|
print STDERR " Reading old records back from the buffer ... " if $VERBOSE > 2;
|
|
$count = 0;
|
|
while (defined($_ = <$PHT>)) {
|
|
print $PH $_ or die "$THIS_FILE: $file: $!";
|
|
$count++;
|
|
}
|
|
close $PHT or die "$THIS_FILE: $CMD_T: $!";
|
|
close $FHT or die "$THIS_FILE: tempfile: $!";
|
|
print STDERR "$count records\n" if $VERBOSE > 2;
|
|
|
|
# A whole new file
|
|
} else {
|
|
@_ = ($EXEC, "-9f");
|
|
@_ = map "\"$_\"", @_ if $^O eq "MSWin32";
|
|
$CMD = join " ", @_;
|
|
print STDERR " Starting $CMD to file ... " if $VERBOSE > 2;
|
|
# Redirect STDOUT to $FH
|
|
open STDOUT, ">&", $FH or die "$THIS_FILE: $file: $!";
|
|
# Start the process
|
|
if ($^O eq "MSWin32") {
|
|
open $PH, "| $CMD" or die "$THIS_FILE: $CMD: $!";
|
|
} else {
|
|
open $PH, "|-", @_ or die "$THIS_FILE: $CMD: $!";
|
|
}
|
|
# Restore STDOUT
|
|
open STDOUT, ">&", $STDOUT or die "$THIS_FILE: STDOUT: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
}
|
|
|
|
($self->{"CMD"}, $self->{"PH"}) = ([@_], $PH);
|
|
return;
|
|
}
|
|
|
|
# Read a line from the I/O stream
|
|
sub readline : method {
|
|
local ($_, %_);
|
|
my ($self, $PH);
|
|
$self = $_[0];
|
|
$PH = $self->{"PH"};
|
|
return <$PH>;
|
|
}
|
|
|
|
# Output data to the I/O stream
|
|
sub write : method {
|
|
local ($_, %_);
|
|
my ($self, $CMD, $PH);
|
|
($self, $_) = @_;
|
|
($CMD, $PH) = (join(" ", @{$self->{"CMD"}}), $self->{"PH"});
|
|
print $PH $_ or die "$THIS_FILE: $CMD: $!";
|
|
return;
|
|
}
|
|
|
|
# Close the I/O stream
|
|
sub close : method {
|
|
local ($_, %_);
|
|
my ($self, $keep, $tmp, $file, $FH, $CMD, $PH);
|
|
($self, $keep, $tmp) = @_;
|
|
$keep = KEEP_ALL if @_ < 2;
|
|
($file, $FH) = ($self->{"file"}, $self->{"FH"});
|
|
|
|
# Restart the file
|
|
if ($keep eq KEEP_RESTART || $keep eq KEEP_THIS_MONTH) {
|
|
my ($CMD, $PH);
|
|
# Empty the source file
|
|
print STDERR " Emptying file ... " if $VERBOSE > 2;
|
|
seek $FH, 0, SEEK_SET or die "$THIS_FILE: $file: $!";
|
|
truncate $FH, 0 or die "$THIS_FILE: $file: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
|
|
# Create empty compressed content
|
|
print STDERR " Applying empty compressed content ... " if $VERBOSE > 2;
|
|
$EXEC = where_is "bzip2" if !defined $EXEC;
|
|
@_ = ($EXEC, "-9f");
|
|
@_ = map "\"$_\"", @_ if $^O eq "MSWin32";
|
|
$CMD = join " ", @_;
|
|
# Redirect STDOUT to $FH
|
|
open STDOUT, ">&", $FH or die "$THIS_FILE: $file: $!";
|
|
# Start the process and end it
|
|
if ($^O eq "MSWin32") {
|
|
open $PH, "| $CMD" or die "$THIS_FILE: $CMD: $!";
|
|
} else {
|
|
open $PH, "|-", @_ or die "$THIS_FILE: $CMD: $!";
|
|
}
|
|
close $PH or die "$THIS_FILE: $CMD: $!";
|
|
# Restore STDOUT
|
|
open STDOUT, ">&", $STDOUT or die "$THIS_FILE: STDOUT: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
}
|
|
|
|
($CMD, $PH) = (join(" ", @{$self->{"CMD"}}), $self->{"PH"});
|
|
CORE::close $PH or die "$THIS_FILE: $CMD: $!";
|
|
CORE::close $FH or die "$THIS_FILE: $file: $!";
|
|
delete $self->{"PH"};
|
|
delete $self->{"CMD"};
|
|
delete $self->{"FH"};
|
|
delete $self->{"file"};
|
|
|
|
# Delete the file
|
|
if ($keep eq KEEP_DELETE) {
|
|
print STDERR " Deleting file ... " if $VERBOSE > 2;
|
|
unlink $file or die "$THIS_FILE: $file: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
}
|
|
# Delete the temporary file if needed
|
|
if (defined $tmp && -e $tmp) {
|
|
unlink $tmp or die "$THIS_FILE: $tmp: $!";
|
|
}
|
|
return;
|
|
}
|
|
|
|
|
|
# _private::IO::Xz::PM: The xz module compression I/O handler
|
|
package _private::IO::Xz::PM;
|
|
use 5.008;
|
|
use strict;
|
|
use warnings;
|
|
use base qw(_private::IO);
|
|
BEGIN {
|
|
import main;
|
|
}
|
|
|
|
use Fcntl qw(:flock :seek);
|
|
use File::Temp qw(tempfile);
|
|
|
|
# The file name suffix of this mime type
|
|
sub suffix : method { ".xz"; }
|
|
|
|
# Open the file for reading
|
|
sub open_read : method {
|
|
local ($_, %_);
|
|
my ($self, $file, $FH);
|
|
($self, $file, $FH) = @_;
|
|
# Open the file if it is not opened yet
|
|
if (!defined $FH) {
|
|
print STDERR " Opening file in read mode ... " if $VERBOSE > 2;
|
|
open $FH, "+<", $file or die "$THIS_FILE: $file: $!";
|
|
binmode $FH or die "$THIS_FILE: $file: $!";
|
|
flock $FH, LOCK_EX;
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
}
|
|
($self->{"file"}, $self->{"FH"}) = ($file, $FH);
|
|
print STDERR " Attaching file with IO::Uncompress::UnXz ... " if $VERBOSE > 2;
|
|
$self->{"xz"} = IO::Uncompress::UnXz->new($FH)
|
|
or die "$THIS_FILE: $file: $IO::Uncompress::UnXz::UnXzError";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
return;
|
|
}
|
|
|
|
# Open the file for writing
|
|
sub open_write : method {
|
|
local ($_, %_);
|
|
my ($self, $file, $FH);
|
|
($self, $file, $FH) = @_;
|
|
# Open the file if it is not opened yet
|
|
if (!defined $FH) {
|
|
print STDERR " Creating file in write mode ... " if $VERBOSE > 2;
|
|
open $FH, "+>", $file or die "$THIS_FILE: $file: $!";
|
|
binmode $FH or die "$THIS_FILE: $file: $!";
|
|
flock $FH, LOCK_EX;
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
}
|
|
($self->{"file"}, $self->{"FH"}) = ($file, $FH);
|
|
print STDERR " Attaching file with IO::Compress::Xz ... " if $VERBOSE > 2;
|
|
$self->{"xz"} = IO::Compress::Xz->new($FH)
|
|
or die "$THIS_FILE: $file: $IO::Compress::Xz::XzError";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
return;
|
|
}
|
|
|
|
# Open the file for appending
|
|
sub open_append : method {
|
|
local ($_, %_);
|
|
my ($self, $file, $FH, $xz);
|
|
($self, $file, $FH) = @_;
|
|
# Open the file if it is not opened yet
|
|
if (!defined $FH) {
|
|
print STDERR " Opening file in read/write mode ... " if $VERBOSE > 2;
|
|
open $FH, "+<", $file or die "$THIS_FILE: $file: $!";
|
|
binmode $FH or die "$THIS_FILE: $file: $!";
|
|
flock $FH, LOCK_EX;
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
}
|
|
($self->{"file"}, $self->{"FH"}) = ($file, $FH);
|
|
|
|
# Save the original data if file has content so that file size is
|
|
# greater than 0. STDOUT is always of size 0.
|
|
if ((stat $FH)[7] > 0) {
|
|
my ($count, $FHT, $xzt, $n);
|
|
seek $FH, 0, SEEK_SET or die "$THIS_FILE: $file: $!";
|
|
# Copy the original content to a buffer
|
|
print STDERR " Reading compressed data to the buffer ... " if $VERBOSE > 2;
|
|
$FHT = tempfile or die "$THIS_FILE: tempfile: $!";
|
|
while (defined($_ = <$FH>)) {
|
|
print $FHT $_ or die "$THIS_FILE: tempfile: $!";
|
|
}
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
print STDERR " Restarting file ... " if $VERBOSE > 2;
|
|
seek $FHT, 0, SEEK_SET or die "$THIS_FILE: tempfile: $!";
|
|
seek $FH, 0, SEEK_SET or die "$THIS_FILE: $file: $!";
|
|
truncate $FH, 0 or die "$THIS_FILE: $file: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
|
|
# Decompress the buffer and save to our file
|
|
print STDERR " Attaching buffer with IO::Uncompress::UnXz ... " if $VERBOSE > 2;
|
|
$xzt = IO::Uncompress::UnXz->new($FHT)
|
|
or die "$THIS_FILE: tempfile: $IO::Uncompress::UnXz::UnXzError";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
print STDERR " Attaching file with IO::Compress::Xz ... " if $VERBOSE > 2;
|
|
$xz = IO::Compress::Xz->new($FH)
|
|
or die "$THIS_FILE: $file: $IO::Compress::Xz::XzError";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
|
|
print STDERR " Reading old records back from the buffer ... " if $VERBOSE > 2;
|
|
$count = 0;
|
|
while (defined($_ = $xzt->getline)) {
|
|
($xz->write($_) == length $_)
|
|
or die "$THIS_FILE: $file: $IO::Compress::Xz::XzError";
|
|
$count++;
|
|
}
|
|
close $FHT or die "$THIS_FILE: tempfile: $!";
|
|
print STDERR "$count records\n" if $VERBOSE > 2;
|
|
|
|
# A whole new file
|
|
} else {
|
|
print STDERR " Attaching file with IO::Compress::Xz ... " if $VERBOSE > 2;
|
|
$xz = IO::Compress::Xz->new($FH)
|
|
or die "$THIS_FILE: $file: $IO::Compress::Xz::XzError";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
}
|
|
|
|
$self->{"xz"} = $xz;
|
|
return;
|
|
}
|
|
|
|
# Read a line from the I/O stream
|
|
sub readline : method {
|
|
return $_[0]->{"xz"}->getline();
|
|
}
|
|
|
|
# Output data to the I/O stream
|
|
sub write : method {
|
|
local ($_, %_);
|
|
my ($self, $file, $xz);
|
|
($self, $_) = @_;
|
|
($file, $xz) = ($self->{"file"}, $self->{"xz"});
|
|
($xz->write($_) == length $_) or die "$THIS_FILE: $file: $IO::Compress::Xz::XzError";
|
|
return;
|
|
}
|
|
|
|
# Close the I/O stream
|
|
sub close : method {
|
|
local ($_, %_);
|
|
my ($self, $keep, $tmp, $file, $FH, $xz);
|
|
($self, $keep, $tmp) = @_;
|
|
$keep = KEEP_ALL if @_ < 2;
|
|
($file, $FH, $xz) = ($self->{"file"}, $self->{"FH"}, $self->{"xz"});
|
|
|
|
# Restart the file
|
|
if ($keep eq KEEP_RESTART || $keep eq KEEP_THIS_MONTH) {
|
|
# Empty the source file
|
|
print STDERR " Emptying file ... " if $VERBOSE > 2;
|
|
seek $FH, 0, SEEK_SET or die "$THIS_FILE: $file: $!";
|
|
truncate $FH, 0 or die "$THIS_FILE: $file: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
|
|
# Create empty compressed content
|
|
print STDERR " Applying empty compressed content ... " if $VERBOSE > 2;
|
|
$_ = IO::Compress::Xz->new($FH, Append => 0)
|
|
or die "$THIS_FILE: $file: $IO::Compress::Xz::XzError";
|
|
$_->close or die "$THIS_FILE: $file: $IO::Compress::Xz::XzError";
|
|
undef $_;
|
|
undef $xz;
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
}
|
|
|
|
if (defined $xz) {
|
|
$xz->close or die "$THIS_FILE: $file: $IO::Compress::Xz::XzError";
|
|
}
|
|
CORE::close $self->{"FH"} if $self->{"FH"}->opened;
|
|
delete $self->{"xz"};
|
|
delete $self->{"FH"};
|
|
delete $self->{"file"};
|
|
|
|
# Delete the file
|
|
if ($keep eq KEEP_DELETE) {
|
|
print STDERR " Deleting file ... " if $VERBOSE > 2;
|
|
unlink $file or die "$THIS_FILE: $file: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
}
|
|
# Delete the temporary file if needed
|
|
if (defined $tmp && -e $tmp) {
|
|
unlink $tmp or die "$THIS_FILE: $tmp: $!";
|
|
}
|
|
return;
|
|
}
|
|
|
|
|
|
# _private::IO::Xz::Exec: The xz executable compression I/O handler
|
|
package _private::IO::Xz::Exec;
|
|
use 5.008;
|
|
use strict;
|
|
use warnings;
|
|
use base qw(_private::IO);
|
|
BEGIN {
|
|
import main;
|
|
}
|
|
|
|
use Fcntl qw(:flock :seek);
|
|
use File::Temp qw(tempfile);
|
|
|
|
our ($EXEC);
|
|
BEGIN {
|
|
undef $EXEC;
|
|
}
|
|
|
|
# The file name suffix of this mime type
|
|
sub suffix : method { ".xz"; }
|
|
|
|
# Open the file for reading
|
|
sub open_read : method {
|
|
local ($_, %_);
|
|
my ($self, $file, $FH, $PH, $CMD);
|
|
($self, $file, $FH) = @_;
|
|
# Open the file if it is not opened yet
|
|
if (!defined $FH) {
|
|
print STDERR " Opening file in read mode ... " if $VERBOSE > 2;
|
|
open $FH, "+<", $file or die "$THIS_FILE: $file: $!";
|
|
binmode $FH or die "$THIS_FILE: $file: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
} else {
|
|
flock $FH, LOCK_UN;
|
|
}
|
|
($self->{"file"}, $self->{"FH"}) = ($file, $FH);
|
|
$EXEC = where_is "xz" if !defined $EXEC;
|
|
|
|
@_ = ($EXEC, "-cdf");
|
|
@_ = map "\"$_\"", @_ if $^O eq "MSWin32";
|
|
$CMD = join " ", @_;
|
|
print STDERR " Starting $CMD from file ... " if $VERBOSE > 2;
|
|
# Redirect STDIN to $FH
|
|
open STDIN, "<&", $FH or die "$THIS_FILE: $file: $!";
|
|
# Start the process
|
|
if ($^O eq "MSWin32") {
|
|
open $PH, "$CMD |" or die "$THIS_FILE: $CMD: $!";
|
|
} else {
|
|
open $PH, "-|", @_ or die "$THIS_FILE: $CMD: $!";
|
|
}
|
|
# Restore STDIN
|
|
open STDIN, "<&", $STDIN or die "$THIS_FILE: STDIN: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
($self->{"CMD"}, $self->{"PH"}) = ([@_], $PH);
|
|
return;
|
|
}
|
|
|
|
# Open the file for writing
|
|
sub open_write : method {
|
|
local ($_, %_);
|
|
my ($self, $file, $FH, $PH, $CMD);
|
|
($self, $file, $FH) = @_;
|
|
# Open the file if it is not opened yet
|
|
if (!defined $FH) {
|
|
print STDERR " Creating file in write mode ... " if $VERBOSE > 2;
|
|
open $FH, "+>", $file or die "$THIS_FILE: $file: $!";
|
|
binmode $FH or die "$THIS_FILE: $file: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
} else {
|
|
flock $FH, LOCK_UN;
|
|
}
|
|
($self->{"file"}, $self->{"FH"}) = ($file, $FH);
|
|
$EXEC = where_is "xz" if !defined $EXEC;
|
|
|
|
@_ = ($EXEC, "-9f");
|
|
@_ = map "\"$_\"", @_ if $^O eq "MSWin32";
|
|
$CMD = join " ", @_;
|
|
print STDERR " Starting $CMD to file ... " if $VERBOSE > 2;
|
|
# Redirect STDOUT to $FH
|
|
open STDOUT, ">&", $FH or die "$THIS_FILE: $file: $!";
|
|
# Start the process
|
|
if ($^O eq "MSWin32") {
|
|
open $PH, "| $CMD" or die "$THIS_FILE: $CMD: $!";
|
|
} else {
|
|
open $PH, "|-", @_ or die "$THIS_FILE: $CMD: $!";
|
|
}
|
|
# Restore STDOUT
|
|
open STDOUT, ">&", $STDOUT or die "$THIS_FILE: STDOUT: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
($self->{"CMD"}, $self->{"PH"}) = ([@_], $PH);
|
|
return;
|
|
}
|
|
|
|
# Open the file for appending
|
|
sub open_append : method {
|
|
local ($_, %_);
|
|
my ($self, $file, $FH, $PH, $CMD);
|
|
($self, $file, $FH) = @_;
|
|
# Open the file if it is not opened yet
|
|
if (!defined $FH) {
|
|
print STDERR " Opening file in read/write mode ... " if $VERBOSE > 2;
|
|
open $FH, "+<", $file or die "$THIS_FILE: $file: $!";
|
|
binmode $FH or die "$THIS_FILE: $file: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
} else {
|
|
flock $FH, LOCK_UN;
|
|
}
|
|
($self->{"file"}, $self->{"FH"}) = ($file, $FH);
|
|
$EXEC = where_is "xz" if !defined $EXEC;
|
|
|
|
# Save the original data if file has content so that file size is
|
|
# greater than 0. STDOUT is always of size 0.
|
|
if ((stat $FH)[7] > 0) {
|
|
my ($count, $FHT, $PHT, $CMD_T);
|
|
seek $FH, 0, SEEK_SET or die "$THIS_FILE: $file: $!";
|
|
# Copy the original content to a buffer
|
|
print STDERR " Reading compressed data to the buffer ... " if $VERBOSE > 2;
|
|
$FHT = tempfile or die "$THIS_FILE: tempfile: $!";
|
|
while (defined($_ = <$FH>)) {
|
|
print $FHT $_ or die "$THIS_FILE: tempfile: $!";
|
|
}
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
print STDERR " Restarting file ... " if $VERBOSE > 2;
|
|
seek $FHT, 0, SEEK_SET or die "$THIS_FILE: tempfile: $!";
|
|
seek $FH, 0, SEEK_SET or die "$THIS_FILE: $file: $!";
|
|
truncate $FH, 0 or die "$THIS_FILE: $file: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
|
|
# Decompress the buffer and save to our file
|
|
@_ = ($EXEC, "-cdf");
|
|
@_ = map "\"$_\"", @_ if $^O eq "MSWin32";
|
|
$CMD_T = join " ", @_;
|
|
print STDERR " Starting $CMD_T from buffer ... " if $VERBOSE > 2;
|
|
# Redirect STDIN to $FH
|
|
open STDIN, "<&", $FHT or die "$THIS_FILE: tempfile: $!";
|
|
# Start the process
|
|
if ($^O eq "MSWin32") {
|
|
open $PHT, "$CMD_T |" or die "$THIS_FILE: $CMD_T: $!";
|
|
} else {
|
|
open $PHT, "-|", @_ or die "$THIS_FILE: $CMD_T: $!";
|
|
}
|
|
# Restore STDIN
|
|
open STDIN, "<&", $STDIN or die "$THIS_FILE: STDIN: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
|
|
@_ = ($EXEC, "-9f");
|
|
@_ = map "\"$_\"", @_ if $^O eq "MSWin32";
|
|
$CMD = join " ", @_;
|
|
print STDERR " Starting $CMD to file ... " if $VERBOSE > 2;
|
|
# Redirect STDOUT to $FH
|
|
open STDOUT, ">&", $FH or die "$THIS_FILE: $file: $!";
|
|
# Start the process
|
|
if ($^O eq "MSWin32") {
|
|
open $PH, "| $CMD" or die "$THIS_FILE: $CMD: $!";
|
|
} else {
|
|
open $PH, "|-", @_ or die "$THIS_FILE: $CMD: $!";
|
|
}
|
|
# Restore STDOUT
|
|
open STDOUT, ">&", $STDOUT or die "$THIS_FILE: STDOUT: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
|
|
print STDERR " Reading old records back from the buffer ... " if $VERBOSE > 2;
|
|
$count = 0;
|
|
while (defined($_ = <$PHT>)) {
|
|
print $PH $_ or die "$THIS_FILE: $file: $!";
|
|
$count++;
|
|
}
|
|
close $PHT or die "$THIS_FILE: $CMD_T: $!";
|
|
close $FHT or die "$THIS_FILE: tempfile: $!";
|
|
print STDERR "$count records\n" if $VERBOSE > 2;
|
|
|
|
# A whole new file
|
|
} else {
|
|
@_ = ($EXEC, "-9f");
|
|
@_ = map "\"$_\"", @_ if $^O eq "MSWin32";
|
|
$CMD = join " ", @_;
|
|
print STDERR " Starting $CMD to file ... " if $VERBOSE > 2;
|
|
# Redirect STDOUT to $FH
|
|
open STDOUT, ">&", $FH or die "$THIS_FILE: $file: $!";
|
|
# Start the process
|
|
if ($^O eq "MSWin32") {
|
|
open $PH, "| $CMD" or die "$THIS_FILE: $CMD: $!";
|
|
} else {
|
|
open $PH, "|-", @_ or die "$THIS_FILE: $CMD: $!";
|
|
}
|
|
# Restore STDOUT
|
|
open STDOUT, ">&", $STDOUT or die "$THIS_FILE: STDOUT: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
}
|
|
|
|
($self->{"CMD"}, $self->{"PH"}) = ([@_], $PH);
|
|
return;
|
|
}
|
|
|
|
# Read a line from the I/O stream
|
|
sub readline : method {
|
|
local ($_, %_);
|
|
my ($self, $PH);
|
|
$self = $_[0];
|
|
$PH = $self->{"PH"};
|
|
return <$PH>;
|
|
}
|
|
|
|
# Output data to the I/O stream
|
|
sub write : method {
|
|
local ($_, %_);
|
|
my ($self, $CMD, $PH);
|
|
($self, $_) = @_;
|
|
($CMD, $PH) = (join(" ", @{$self->{"CMD"}}), $self->{"PH"});
|
|
print $PH $_ or die "$THIS_FILE: $CMD: $!";
|
|
return;
|
|
}
|
|
|
|
# Close the I/O stream
|
|
sub close : method {
|
|
local ($_, %_);
|
|
my ($self, $keep, $tmp, $file, $FH, $CMD, $PH);
|
|
($self, $keep, $tmp) = @_;
|
|
$keep = KEEP_ALL if @_ < 2;
|
|
($file, $FH) = ($self->{"file"}, $self->{"FH"});
|
|
|
|
# Restart the file
|
|
if ($keep eq KEEP_RESTART || $keep eq KEEP_THIS_MONTH) {
|
|
my ($CMD, $PH);
|
|
# Empty the source file
|
|
print STDERR " Emptying file ... " if $VERBOSE > 2;
|
|
seek $FH, 0, SEEK_SET or die "$THIS_FILE: $file: $!";
|
|
truncate $FH, 0 or die "$THIS_FILE: $file: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
|
|
# Create empty compressed content
|
|
print STDERR " Applying empty compressed content ... " if $VERBOSE > 2;
|
|
$EXEC = where_is "xz" if !defined $EXEC;
|
|
@_ = ($EXEC, "-9f");
|
|
@_ = map "\"$_\"", @_ if $^O eq "MSWin32";
|
|
$CMD = join " ", @_;
|
|
# Redirect STDOUT to $FH
|
|
open STDOUT, ">&", $FH or die "$THIS_FILE: $file: $!";
|
|
# Start the process and end it
|
|
if ($^O eq "MSWin32") {
|
|
open $PH, "| $CMD" or die "$THIS_FILE: $CMD: $!";
|
|
} else {
|
|
open $PH, "|-", @_ or die "$THIS_FILE: $CMD: $!";
|
|
}
|
|
close $PH or die "$THIS_FILE: $CMD: $!";
|
|
# Restore STDOUT
|
|
open STDOUT, ">&", $STDOUT or die "$THIS_FILE: STDOUT: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
}
|
|
|
|
($CMD, $PH) = (join(" ", @{$self->{"CMD"}}), $self->{"PH"});
|
|
CORE::close $PH or die "$THIS_FILE: $CMD: $!";
|
|
CORE::close $FH or die "$THIS_FILE: $file: $!";
|
|
delete $self->{"PH"};
|
|
delete $self->{"CMD"};
|
|
delete $self->{"FH"};
|
|
delete $self->{"file"};
|
|
|
|
# Delete the file
|
|
if ($keep eq KEEP_DELETE) {
|
|
print STDERR " Deleting file ... " if $VERBOSE > 2;
|
|
unlink $file or die "$THIS_FILE: $file: $!";
|
|
print STDERR "done\n" if $VERBOSE > 2;
|
|
}
|
|
# Delete the temporary file if needed
|
|
if (defined $tmp && -e $tmp) {
|
|
unlink $tmp or die "$THIS_FILE: $tmp: $!";
|
|
}
|
|
return;
|
|
}
|
|
|
|
|
|
# _private::Format: The abstract log file format handler interface
|
|
package _private::Format;
|
|
use 5.008;
|
|
use strict;
|
|
use warnings;
|
|
BEGIN {
|
|
import main;
|
|
}
|
|
|
|
use Date::Parse qw(str2time);
|
|
|
|
# Initialize the log record format parser
|
|
sub new : method { bless {}, $_[0]; }
|
|
|
|
# Check the record format and return an appropriate parser
|
|
sub check_format : method {
|
|
local ($_, %_);
|
|
my (@formats, $record);
|
|
$record = $_[1];
|
|
@formats = qw(_private::Format::Apache _private::Format::Syslog
|
|
_private::Format::NTP _private::Format::ApacheSSL
|
|
_private::Format::MyISO);
|
|
foreach my $format (@formats) {
|
|
$_ = $format->new;
|
|
print STDERR " Testing $_ ... " if $VERBOSE > 2;
|
|
if ($_->match($record)) {
|
|
print STDERR "match\n" if $VERBOSE > 2;
|
|
return $_;
|
|
}
|
|
print STDERR "not match\n" if $VERBOSE > 2;
|
|
}
|
|
return undef;
|
|
}
|
|
|
|
# Try matching my format and return the matching date text
|
|
# Empty. Implement it in the subclasses.
|
|
sub match : method { return undef; }
|
|
|
|
# Parse the month of the log file
|
|
sub parse_month : method {
|
|
local ($_, %_);
|
|
my $self;
|
|
($self, $_) = @_;
|
|
return undef unless defined($_ = $self->match($_));
|
|
return undef unless defined($_ = str2time $_);
|
|
return to_yyyymm $_;
|
|
}
|
|
|
|
|
|
# _private::Format::Apache: The Apache log file format handler
|
|
package _private::Format::Apache;
|
|
use 5.008;
|
|
use strict;
|
|
use warnings;
|
|
use base qw(_private::Format);
|
|
use overload ("\"\"" => sub { "Apache access_log"; });
|
|
|
|
# Try matching my format and return the matching date text
|
|
sub match : method {
|
|
return $_[1] =~ /^\S+ \S+ .*? \[(\d{2}\/[A-Z][a-z]{2}\/\d{4}:\d{2}:\d{2}:\d{2} [+\-]\d{4})\]/?
|
|
$1: undef;
|
|
}
|
|
|
|
|
|
# _private::Format::Syslog: The Syslog log file format handler
|
|
package _private::Format::Syslog;
|
|
use 5.008;
|
|
use strict;
|
|
use warnings;
|
|
use base qw(_private::Format);
|
|
use overload ("\"\"" => sub { "Syslog"; });
|
|
|
|
# Try matching my format and return the matching date text
|
|
sub match : method {
|
|
return $_[1] =~ /^([A-Z][a-z]{2} ?\d{1,2} \d{2}:\d{2}:\d{2}) /?
|
|
$1: undef;
|
|
}
|
|
|
|
|
|
# _private::Format::NTP: The NTP log file format handler
|
|
package _private::Format::NTP;
|
|
use 5.008;
|
|
use strict;
|
|
use warnings;
|
|
use base qw(_private::Format);
|
|
use overload ("\"\"" => sub { "NTP"; });
|
|
|
|
# Try matching my format and return the matching date text
|
|
sub match : method {
|
|
return $_[1] =~ /^( ?\d{1,2} [A-Z][a-z]{2} \d{2}:\d{2}:\d{2}) /?
|
|
$1: undef;
|
|
}
|
|
|
|
|
|
# _private::Format::ApacheSSL: The Apache ssl_engine_log log file format handler
|
|
package _private::Format::ApacheSSL;
|
|
use 5.008;
|
|
use strict;
|
|
use warnings;
|
|
use base qw(_private::Format);
|
|
use overload ("\"\"" => sub { "Apache SSL engine log"; });
|
|
|
|
# Try matching my format and return the matching date text
|
|
sub match : method {
|
|
return $_[1] =~ /^\[(\d{2}\/[A-Z][a-z]{2}\/\d{4} \d{2}:\d{2}:\d{2} )\d+\]/?
|
|
$1: undef;
|
|
}
|
|
|
|
|
|
# _private::Format::MyISO: The bracketed, modified ISO 8601 date/time log file format handler
|
|
# ISO 8601 should be 2007-11-14T14:23:35+0800. But it is hard to read.
|
|
# This is a similar format commonly-seen in many applications.
|
|
package _private::Format::MyISO;
|
|
use 5.008;
|
|
use strict;
|
|
use warnings;
|
|
use base qw(_private::Format);
|
|
use overload ("\"\"" => sub { "modified ISO 8601 date/time"; });
|
|
|
|
# Try matching my format and return the matching date text
|
|
sub match : method {
|
|
return $_[1] =~ /^\[(\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2} [+\-]\d{4})\]/?
|
|
$1: undef;
|
|
}
|
|
|
|
|
|
__END__
|
|
|
|
=head1 NAME
|
|
|
|
arclog - Archive the log files monthly
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
arclog [options] logfile... [output]
|
|
arclog [-h|-v]
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
F<arclog> archives the log files monthly. It strips off log entries
|
|
that belongs to previous months, and then compresses and saves them
|
|
to archived files named logfile.yyyymm.gz.
|
|
|
|
Currently, F<arclog> supports Apache access log, Syslog, NTP, Apache
|
|
1 SSL engine log, and my own bracketed, modified ISO date/time log
|
|
file formats, and gzip, bzip2, and xz compression methods. Several
|
|
software projects log (or can log) in a format compatible with the
|
|
Apache access log, like CUPS, ProFTPD, Pure-FTPd... etc., and
|
|
F<arclog> can archive their Apache-like log files, too.
|
|
|
|
Notice: I<Archival takes time>. To reduce the time occupying the
|
|
source log file, F<arclog> copies the content of the source log
|
|
file to a temporary working file and restart the source log file
|
|
first. Then F<arclog> can take its time working on the temporary
|
|
working file. However, please note:
|
|
|
|
1. If you have a huge log file (several hundreds of MBs), merely
|
|
copying still takes a lot of time. In that case, you had better stop
|
|
logging first, archive the log file and restart logging, to avoid
|
|
racing condition in writing. If you archive the log file
|
|
periodically, it shall not grow too big.
|
|
|
|
2. If F<arclog> stops in the middle of the execution, it will leave
|
|
a temporary working file. The next time F<arclog> runs, it stops
|
|
when it sees that temporary working file. You have to process that
|
|
temporary working file first. That temporary working file is merely
|
|
a copy of the original log file. You can rename and archive it like
|
|
an ordinary log file to solve this.
|
|
|
|
Do not sort unless you have a particular reason. Sorting has the
|
|
following potential problems:
|
|
|
|
1. Sorting may I<eat huge memory> on large log files. The amount of
|
|
the memory required depends on the number of records in each archived
|
|
month. Modern Linux and MSWin32 kill processes that eat too much
|
|
memory, but it still takes minutes, and your system hangs for that. I
|
|
do not know other operating systems. Try at your own risk.
|
|
|
|
2. The time unit of all recognized log formats is I<second>. Log
|
|
records happen in a same second are sorted by the log file order (if
|
|
you are archiving several log files at a time) and then the log record
|
|
order. I try to ensure that the sorted archived records are in a
|
|
correct order of the happening events, but I cannot guarantee. You
|
|
have to watch out if the order in a second is important.
|
|
|
|
Be careful on the L<Syslog(2)|syslog/2> and NTP log files:
|
|
L<Syslog(2)|syslog/2> and NTP does not record the year. F<arclog>
|
|
uses L<Date::Parse(3)|Date::Parse/3> to parse the date, which assumes
|
|
the year between this month and last next month if the year is
|
|
missing. For example, if today is 2001/6/8, it assumes the year
|
|
between 2001/6/30 back to 2000/7/1 if the year is missing. This is
|
|
fair. However, if you do have a L<Syslog(2)|syslog/2> or NTP log file
|
|
that has records older than one year, do not use F<arclog>. It will
|
|
destroy your log file.
|
|
|
|
If read from C<STDIN>, please note:
|
|
|
|
1. You I<MUST> specify the output prefix if you want to read from
|
|
C<STDIN>, since what it needs is an output pathname prefix, not an
|
|
output file.
|
|
|
|
2. C<STDIN> cannot be deleted, restarted or partially kept. If you
|
|
read from C<STDIN>, the keep mode is always keep all. if you archive
|
|
several source log files including C<STDIN>, the keep mode will be
|
|
keep all for all source log files, to prevent disaster.
|
|
|
|
3. The answers of the C<ask> mode is obtained from C<STDIN>, too.
|
|
Since you have only one C<STDIN>, you cannot specify the C<ask> mode
|
|
while reading from C<STDIN>. It falls back to the C<fail> mode
|
|
in that case.
|
|
|
|
I suggest that you install L<File::MMagic(3)|File::MMagic/3> instead
|
|
of counting on the L<file(1)|file/1> executable. The internal magic
|
|
file of L<File::MMagic(3)|File::MMagic/3> works better than the
|
|
L<file(1)|file/1> executable. F<arclog> treats everything not
|
|
L<gzip(1)|gzip/1>, L<bzip2(1)|bzip2/1>, nor L<xz(1)|xz/1> compressed
|
|
as plain text. When a compressed log file is wrongly recognized as
|
|
an image, F<arclog> treats it as plain text, reads directly from it,
|
|
and fails. This does not hurt the source log files, but is still
|
|
annoying.
|
|
|
|
=head1 OPTIONS
|
|
|
|
=over
|
|
|
|
=item logfile
|
|
|
|
The log file to be archived. Specify C<-> to read from C<STDIN>.
|
|
You can specify multiple log files. L<gzip(1)|gzip/1>,
|
|
L<bzip2(1)|bzip2/1>, or L<xz(1)|xz/1> compressed files are supported.
|
|
|
|
=item output
|
|
|
|
The prefix of the output files. The output files are named as
|
|
F<output.yyyymm>, ie: F<output.200101>, F<output.200101>. If not
|
|
specified, the default is the same as the log file. You must specify
|
|
this if you want to read from C<STDIN>. You cannot specify C<->
|
|
(C<STDOUT>), since F<arclog> needs a name prefix, not the output file.
|
|
|
|
=item -c, --compress method
|
|
|
|
Specify the compression method for the archived files. Log files
|
|
usually have large number of similar lines. Compress them saves
|
|
you lots of disk spaces. (And this is why we want to I<archive>
|
|
them.) The following compression methods are supported:
|
|
|
|
=over
|
|
|
|
=item g, gzip
|
|
|
|
Compress with L<gzip(1)|gzip/1>. This is the default. F<arclog>
|
|
can use L<IO::Compress::Gzip(3)|IO::Compress::Gzip/3> to compress
|
|
instead of calling L<gzip(1)|gzip/1>. This can be safer and faster
|
|
for not calling foreign binaries. if
|
|
L<IO::Compress::Gzip(3)|IO::Compress::Gzip/3> is not installed, it
|
|
tries L<gzip(1)|gzip/1> instead. If L<gzip(1)|gzip/1> is not
|
|
available, either, it fails.
|
|
|
|
=item b, bzip2
|
|
|
|
Compress with L<bzip2(1)|bzip2/1>. F<arclog> can use
|
|
L<IO::Compress::Bzip2(3)|IO::Compress::Bzip2/3> to compress
|
|
instead of calling L<bzip2(1)|bzip2/1>. This can be safer and faster
|
|
for not calling foreign binaries. If
|
|
L<IO::Compress::Bzip2(3)|IO::Compress::Bzip2/3> is not installed, it
|
|
will try to use L<bzip2(1)|bzip2/1> instead. If L<bzip2(1)|bzip2/1>
|
|
is not available, either, it fails.
|
|
|
|
=item x, xz
|
|
|
|
Compress with L<xz(1)|xz/1>. F<arclog> can use
|
|
L<IO::Compress::Xz(3)|IO::Compress::Xz/3> to compress instead of
|
|
calling L<xz(1)|xz/1>. This can be safer and faster for not
|
|
calling foreign binaries. If L<IO::Compress::Xz(3)|IO::Compress::Xz/3>
|
|
is not installed, it will try to use L<xz(1)|xz/1> instead. If
|
|
L<xz(1)|xz/1> is not available, either, it fails.
|
|
|
|
=item n, none
|
|
|
|
No compression at all. (Why? :p)
|
|
|
|
=back
|
|
|
|
=item --nocompress
|
|
|
|
Do not compress the archived files. This is equivalent to
|
|
C<--compress none>.
|
|
|
|
=item -s, --sort
|
|
|
|
Sort the records by time (and then the record order). Sorting eats
|
|
huge memory and CPU, so it is disabled by default. Refer to the
|
|
description above for a detailed illustration on sorting.
|
|
|
|
=item --nosort
|
|
|
|
Do not sort the records. This is the default.
|
|
|
|
=item -o, --override mode
|
|
|
|
What to do with the existing archived files. The following modes are
|
|
supported:
|
|
|
|
=over
|
|
|
|
=item o, overwrite
|
|
|
|
Overwrite existing target files. You will lose these existing
|
|
records. Use with care. This is helpful if you are sure the master
|
|
log file has the most complete records.
|
|
|
|
=item a, append
|
|
|
|
Append the records to the existing target files. You may destroy the
|
|
log file completely by putting irrelevant entries altogether
|
|
by accident. Use with care. This is helpful if you append want to
|
|
merge 2 or more log files, for example, 2 log files of different
|
|
periods.
|
|
|
|
=item i, ignore
|
|
|
|
Ignore any existing target file, and discard all the records of those
|
|
months. You will lose these log records. Use with care. This is
|
|
helpful if you are supplying log records for the missing months, or
|
|
if you are merging the log records in a complex manner.
|
|
|
|
=item f, fail
|
|
|
|
Stop whenever a target file exists, to prevent destroying existing
|
|
files by accident. This should be mostly desired when run from some
|
|
automatic mechanism, like L<crontab(1)|crontab/1>. So, this is the
|
|
default if no terminal is found at C<STDIN>.
|
|
|
|
=item ask
|
|
|
|
Ask you what to do when a target file exists. This should be most
|
|
wanted if you are running F<arclog> interactively. So, this is the
|
|
default if a terminal is found at C<STDIN>. The answers are read
|
|
from C<STDIN>. Since you have only one C<STDIN>, you cannot specify
|
|
this mode if you want read the log file from C<STDIN>. In that case,
|
|
it falls back to the C<fail> mode. Also, if F<arclog> cannot get its
|
|
answer from C<STDIN>, for example, on a closed C<STDIN> from
|
|
L<crontab(1)|crontab/1>, it falls back to C<fail> mode.
|
|
|
|
=back
|
|
|
|
=item -k, --keep mode
|
|
|
|
What to keep in the source file. The following modes are supported:
|
|
|
|
=over
|
|
|
|
=item a, all
|
|
|
|
Keep the source file after records are archived.
|
|
|
|
=item r, restart
|
|
|
|
Restart the source file after records are archived.
|
|
|
|
=item d, delete
|
|
|
|
Delete the source file after records are archived.
|
|
|
|
=item t, this-month
|
|
|
|
Archive and strip records of previous months off from the log file.
|
|
Keep the records of this month in the source log file, to be archived
|
|
next month. This is designed to be run from L<crontab(1)|crontab/1>
|
|
monthly, so this is the default.
|
|
|
|
=back
|
|
|
|
=item -d, --debug
|
|
|
|
Show the detailed debugging messages.
|
|
|
|
=item -q, --quiet
|
|
|
|
Hush! Only yell on error.
|
|
|
|
=item -h, --help
|
|
|
|
Display the help message and exit.
|
|
|
|
=item -v, --version
|
|
|
|
Output version information and exit.
|
|
|
|
=back
|
|
|
|
=head1 COPYRIGHT
|
|
|
|
Copyright (c) 2001-2021 imacat.
|
|
|
|
Licensed under the Apache License, Version 2.0 (the "License");
|
|
you may not use this file except in compliance with the License.
|
|
You may obtain a copy of the License at
|
|
|
|
http://www.apache.org/licenses/LICENSE-2.0
|
|
|
|
Unless required by applicable law or agreed to in writing, software
|
|
distributed under the License is distributed on an "AS IS" BASIS,
|
|
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
|
See the License for the specific language governing permissions and
|
|
limitations under the License.
|
|
|
|
=head1 AUTHOR
|
|
|
|
imacat <imacat@mail.imacat.idv.tw>.
|
|
|
|
=head1 BUGS
|
|
|
|
The F<arclog> project is hosted on GitHub. Address your issues on the
|
|
GitHub issue tracker https://github.com/imacat/arclog/issues.
|
|
|
|
=head1 TODO
|
|
|
|
=over
|
|
|
|
=item Multi-lingual support
|
|
|
|
Multi-lingual support, with Traditional and Simplified Chinese
|
|
messages.
|
|
|
|
=back
|
|
|
|
=head1 SEE ALSO
|
|
|
|
L<gzip(1)|gzip/1>, L<IO::Compress::Gzip(3)|IO::Compress::Gzip/3>,
|
|
L<IO::Uncompress::Gunzip(3)|IO::Uncompress::Gunzip/3>,
|
|
L<bzip2(1)|bzip2/1>, L<IO::Compress::Bzip2(3)|IO::Compress::Bzip2/3>,
|
|
L<IO::Uncompress::Bunzip2(3)|IO::Uncompress::Bunzip2/3>,
|
|
L<xz(1)|xz/1>, L<IO::Compress::Xz(3)|IO::Compress::Xz/3>,
|
|
L<IO::Uncompress::UnXz(3)|IO::Uncompress::UnXz/3>,
|
|
L<syslog(1)|syslog/1>, L<syslog(2)|syslog/2>
|
|
|
|
=cut
|