Added support for the xz compression.
This commit is contained in:
parent
3c7030099b
commit
5b8d678b6b
3
Changes
3
Changes
@ -1,5 +1,8 @@
|
|||||||
arclog change log
|
arclog change log
|
||||||
|
|
||||||
|
2022-03-19
|
||||||
|
Added support for the xz compression.
|
||||||
|
|
||||||
2020-02-06 version 3.05
|
2020-02-06 version 3.05
|
||||||
1. Replaced the messy GNU-styled, multi-lingual documents with a
|
1. Replaced the messy GNU-styled, multi-lingual documents with a
|
||||||
single Markdown README.md.
|
single Markdown README.md.
|
||||||
|
68
README.md
68
README.md
@ -12,9 +12,9 @@ space and prevents potential attacks on log files.
|
|||||||
|
|
||||||
Currently, `arclog` supports [Apache] access log, Syslog, [NTP],
|
Currently, `arclog` supports [Apache] access log, Syslog, [NTP],
|
||||||
Apache 1 SSL engine log, and my own bracketed, modified ISO date/time
|
Apache 1 SSL engine log, and my own bracketed, modified ISO date/time
|
||||||
log file formats, and gzip and bzip2 compression methods. Several
|
log file formats, and gzip, bzip2, and xz compression methods.
|
||||||
software projects log (or can log) in a format compatible with the
|
Several software projects log (or can log) in a format compatible with
|
||||||
Apache access log, like [CUPS], [ProFTPD], [Pure-FTPd]… etc., and
|
the Apache access log, like [CUPS], [ProFTPD], [Pure-FTPd]… etc., and
|
||||||
`arclog` can archive their Apache-like log files, too.
|
`arclog` can archive their Apache-like log files, too.
|
||||||
|
|
||||||
Caution
|
Caution
|
||||||
@ -84,10 +84,10 @@ Caution
|
|||||||
* I suggest that you install [File::MMagic] instead of counting on the
|
* I suggest that you install [File::MMagic] instead of counting on the
|
||||||
`file` executable. The internal magic file of File::MMagic works
|
`file` executable. The internal magic file of File::MMagic works
|
||||||
better than the `file` executable. `arclog` treats everything not
|
better than the `file` executable. `arclog` treats everything not
|
||||||
gzip nor bzip2 compressed as plain text. When a compressed log file
|
gzip, bzip2, or xz compressed as plain text. When a compressed log
|
||||||
is wrongly recognized as an image, `arclog` treats it as plain text,
|
file is wrongly recognized as an image, `arclog` treats it as plain
|
||||||
reads directly from it, and fails. This does not hurt the source
|
text, reads directly from it, and fails. This does not hurt the
|
||||||
log files, but is still annoying.
|
source log files, but is still annoying.
|
||||||
|
|
||||||
[Date::Parse]: https://metacpan.org/release/TimeDate
|
[Date::Parse]: https://metacpan.org/release/TimeDate
|
||||||
[File::MMagic]: https://metacpan.org/release/File-MMagic
|
[File::MMagic]: https://metacpan.org/release/File-MMagic
|
||||||
@ -248,6 +248,42 @@ System Requirement
|
|||||||
[the bzip2 website]. Be sure to save it as `bzip2.exe` somewhere
|
[the bzip2 website]. Be sure to save it as `bzip2.exe` somewhere
|
||||||
in your `PATH`.
|
in your `PATH`.
|
||||||
|
|
||||||
|
* [IO::Compress::Xz] and [IO::Uncompress::UnXz]
|
||||||
|
|
||||||
|
They are used to support reading/writing the xz compressed
|
||||||
|
files. It is only needed when xz compressed files are
|
||||||
|
encountered. If it is not available, `arclog` tries the `xz`
|
||||||
|
executable instead. If that is not available, too, `arclog`
|
||||||
|
fails. They are contained in the [IO-Compress-Lzma] distribution.
|
||||||
|
You can download and install it from the CPAN archive, or install
|
||||||
|
them with the CPAN shell:
|
||||||
|
|
||||||
|
cpan IO::Compress::Xz
|
||||||
|
|
||||||
|
or with the CPANPLUS shell:
|
||||||
|
|
||||||
|
cpanp i IO::Compress::Xz
|
||||||
|
|
||||||
|
For Debian/Ubuntu:
|
||||||
|
|
||||||
|
sudo apt install libio-compress-lzma-perl
|
||||||
|
|
||||||
|
For Red Hat/Fedora/CentOS:
|
||||||
|
|
||||||
|
sudo yum install perl-IO-Compress-Lzma
|
||||||
|
|
||||||
|
For FreeBSD:
|
||||||
|
|
||||||
|
ports install p5-IO-Compress-Lzma
|
||||||
|
|
||||||
|
For ActivePerl:
|
||||||
|
|
||||||
|
ppm install IO-Compress-Lzma
|
||||||
|
|
||||||
|
The alternative `xz.exe` for MS-Windows can be obtained from
|
||||||
|
[the XZ Utils website]. Be sure to save it as `xz.exe`
|
||||||
|
somewhere in your `PATH`.
|
||||||
|
|
||||||
* [Term::ReadKey]
|
* [Term::ReadKey]
|
||||||
|
|
||||||
This is used to display the progress bar. The progress bar is a
|
This is used to display the progress bar. The progress bar is a
|
||||||
@ -286,9 +322,13 @@ System Requirement
|
|||||||
[GnuWin32]: http://gnuwin32.sourceforge.net
|
[GnuWin32]: http://gnuwin32.sourceforge.net
|
||||||
[Compress::Zlib]: https://metacpan.org/pod/Compress::Zlib
|
[Compress::Zlib]: https://metacpan.org/pod/Compress::Zlib
|
||||||
[the gzip website]: https://www.gzip.org
|
[the gzip website]: https://www.gzip.org
|
||||||
[IO-Compress]: https://metacpan.org/release/IO-Compress
|
[IO-Compress]: https://metacpan.org/dist/IO-Compress
|
||||||
[Compress::Bzip2]: https://metacpan.org/pod/Compress::Bzip2
|
[Compress::Bzip2]: https://metacpan.org/pod/Compress::Bzip2
|
||||||
[the bzip2 website]: http://www.bzip.org
|
[the bzip2 website]: http://www.bzip.org
|
||||||
|
[IO::Compress::Xz]: https://metacpan.org/pod/IO::Compress::Xz
|
||||||
|
[IO::Uncompress::UnXz]: https://metacpan.org/pod/IO::Uncompress::UnXz
|
||||||
|
[IO-Compress-Lzma]: https://metacpan.org/dist/IO-Compress-Lzma
|
||||||
|
[the XZ Utils website]: https://tukaani.org/xz/
|
||||||
[Term::ReadKey]: https://metacpan.org/pod/Term::ReadKey
|
[Term::ReadKey]: https://metacpan.org/pod/Term::ReadKey
|
||||||
|
|
||||||
|
|
||||||
@ -430,8 +470,8 @@ Options
|
|||||||
* `logfile`
|
* `logfile`
|
||||||
|
|
||||||
The log file to be archived. Specify `-` to read from `STDIN`.
|
The log file to be archived. Specify `-` to read from `STDIN`.
|
||||||
You can specify multiple log files. `gzip` or `bzip2` compressed
|
You can specify multiple log files. `gzip`, `bzip2`, or `xz`
|
||||||
files are supported.
|
compressed files are supported.
|
||||||
|
|
||||||
* `output`
|
* `output`
|
||||||
|
|
||||||
@ -465,6 +505,14 @@ Options
|
|||||||
installed, it tries `bzip2` instead. If `bzip2` is not available,
|
installed, it tries `bzip2` instead. If `bzip2` is not available,
|
||||||
either, it fails.
|
either, it fails.
|
||||||
|
|
||||||
|
* `x`, `xz`
|
||||||
|
|
||||||
|
Compress with `xz`. `arclog` can use `IO::Compress::Xz` to
|
||||||
|
compress instead of calling `xz`. This can be safer and faster
|
||||||
|
for not calling foreign binaries. If `IO::Compress::Xz` is not
|
||||||
|
installed, it tries `xz` instead. If `xz` is not available,
|
||||||
|
either, it fails.
|
||||||
|
|
||||||
* `n`, `none`
|
* `n`, `none`
|
||||||
|
|
||||||
No compression at all. (Why? :p)
|
No compression at all. (Why? :p)
|
||||||
|
551
arclog
551
arclog
@ -1,7 +1,7 @@
|
|||||||
#! /usr/bin/perl -w
|
#! /usr/bin/perl -w
|
||||||
# arclog: Archive the log files monthly
|
# arclog: Archive the log files monthly
|
||||||
|
|
||||||
# Copyright (c) 2001-2021 imacat.
|
# Copyright (c) 2001-2022 imacat.
|
||||||
#
|
#
|
||||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||||
# you may not use this file except in compliance with the License.
|
# you may not use this file except in compliance with the License.
|
||||||
@ -36,10 +36,10 @@ use base qw(Exporter);
|
|||||||
our (@EXPORT, @EXPORT_OK);
|
our (@EXPORT, @EXPORT_OK);
|
||||||
BEGIN {
|
BEGIN {
|
||||||
@EXPORT = qw(
|
@EXPORT = qw(
|
||||||
COMPRESS_GZIP COMPRESS_BZIP2 COMPRESS_NONE
|
COMPRESS_GZIP COMPRESS_BZIP2 COMPRESS_XZ COMPRESS_NONE
|
||||||
OVERRIDE_OVERWRITE OVERRIDE_APPEND OVERRIDE_IGNORE OVERRIDE_FAIL OVERRIDE_ASK
|
OVERRIDE_OVERWRITE OVERRIDE_APPEND OVERRIDE_IGNORE OVERRIDE_FAIL OVERRIDE_ASK
|
||||||
KEEP_ALL KEEP_RESTART KEEP_DELETE KEEP_THIS_MONTH
|
KEEP_ALL KEEP_RESTART KEEP_DELETE KEEP_THIS_MONTH
|
||||||
TYPE_PLAIN TYPE_GZIP TYPE_BZIP2
|
TYPE_PLAIN TYPE_GZIP TYPE_BZIP2 TYPE_XZ
|
||||||
TMP_SUFFIX where_is to_yyyymm format_number rel2abs);
|
TMP_SUFFIX where_is to_yyyymm format_number rel2abs);
|
||||||
@EXPORT_OK = @EXPORT;
|
@EXPORT_OK = @EXPORT;
|
||||||
# Prototype declaration
|
# Prototype declaration
|
||||||
@ -65,6 +65,7 @@ $THIS_MONTH = to_yyyymm $^T;
|
|||||||
# The compress mode
|
# The compress mode
|
||||||
use constant COMPRESS_GZIP => "gzip";
|
use constant COMPRESS_GZIP => "gzip";
|
||||||
use constant COMPRESS_BZIP2 => "bzip2";
|
use constant COMPRESS_BZIP2 => "bzip2";
|
||||||
|
use constant COMPRESS_XZ => "xz";
|
||||||
use constant COMPRESS_NONE => "none";
|
use constant COMPRESS_NONE => "none";
|
||||||
use constant DEFAULT_COMPRESS => COMPRESS_GZIP;
|
use constant DEFAULT_COMPRESS => COMPRESS_GZIP;
|
||||||
# The override mode
|
# The override mode
|
||||||
@ -84,6 +85,7 @@ use constant DEFAULT_KEEP => KEEP_THIS_MONTH;
|
|||||||
use constant TYPE_PLAIN => "text/plain";
|
use constant TYPE_PLAIN => "text/plain";
|
||||||
use constant TYPE_GZIP => "application/x-gzip";
|
use constant TYPE_GZIP => "application/x-gzip";
|
||||||
use constant TYPE_BZIP2 => "application/x-bzip2";
|
use constant TYPE_BZIP2 => "application/x-bzip2";
|
||||||
|
use constant TYPE_XZ => "application/x-xz";
|
||||||
# Other constants
|
# Other constants
|
||||||
use constant TMP_SUFFIX => ".tmp-arclog";
|
use constant TMP_SUFFIX => ".tmp-arclog";
|
||||||
use constant GZIP_SUFFIX => ".gz";
|
use constant GZIP_SUFFIX => ".gz";
|
||||||
@ -103,7 +105,7 @@ Archive the log files monthly.
|
|||||||
named as pre.yyyymm, ie: pre.200001, pre.200002. If not
|
named as pre.yyyymm, ie: pre.200001, pre.200002. If not
|
||||||
specified, the default prefix is the logfile pathname.
|
specified, the default prefix is the logfile pathname.
|
||||||
--compress method Compress the archived files. Available methods are:
|
--compress method Compress the archived files. Available methods are:
|
||||||
gzip, bzip2 and none. The default is gzip.
|
gzip, bzip2, xz, and none. The default is gzip.
|
||||||
--sort Sort the records in the log files by time.
|
--sort Sort the records in the log files by time.
|
||||||
--nosort Do not sort the records. (default)
|
--nosort Do not sort the records. (default)
|
||||||
--override mode The override behavior when the target archived files
|
--override mode The override behavior when the target archived files
|
||||||
@ -218,6 +220,8 @@ sub parse_args() {
|
|||||||
$CONF{"COMPRESS"} = COMPRESS_GZIP;
|
$CONF{"COMPRESS"} = COMPRESS_GZIP;
|
||||||
} elsif ($_[1] =~ /^(?:b|bzip2)$/i) {
|
} elsif ($_[1] =~ /^(?:b|bzip2)$/i) {
|
||||||
$CONF{"COMPRESS"} = COMPRESS_BZIP2;
|
$CONF{"COMPRESS"} = COMPRESS_BZIP2;
|
||||||
|
} elsif ($_[1] =~ /^(?:x|xz)$/i) {
|
||||||
|
$CONF{"COMPRESS"} = COMPRESS_XZ;
|
||||||
} elsif ($_[1] =~ /^(?:n|none)$/i) {
|
} elsif ($_[1] =~ /^(?:n|none)$/i) {
|
||||||
$CONF{"COMPRESS"} = COMPRESS_NONE;
|
$CONF{"COMPRESS"} = COMPRESS_NONE;
|
||||||
} else {
|
} else {
|
||||||
@ -364,6 +368,7 @@ sub parse_args() {
|
|||||||
if ($one_arg) {
|
if ($one_arg) {
|
||||||
$CONF{"OUTPUT"} =~ s/\.gz$// if $LOGFILES[0]->{"type"} eq TYPE_GZIP;
|
$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/\.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"
|
die "$THIS_FILE: Please specify output prefix\n$SHORT_HELP\n"
|
||||||
if !defined $CONF{"OUTPUT"};
|
if !defined $CONF{"OUTPUT"};
|
||||||
@ -616,6 +621,8 @@ sub check_temp : method {
|
|||||||
($file, $dir, $suf) = fileparse $self->{"file"}, ".gz";
|
($file, $dir, $suf) = fileparse $self->{"file"}, ".gz";
|
||||||
} elsif ($self->{"type"} eq TYPE_BZIP2) {
|
} elsif ($self->{"type"} eq TYPE_BZIP2) {
|
||||||
($file, $dir, $suf) = fileparse $self->{"file"}, ".bz2";
|
($file, $dir, $suf) = fileparse $self->{"file"}, ".bz2";
|
||||||
|
} elsif ($self->{"type"} eq TYPE_XZ) {
|
||||||
|
($file, $dir, $suf) = fileparse $self->{"file"}, ".xz";
|
||||||
} else {
|
} else {
|
||||||
($file, $dir, $suf) = fileparse $self->{"file"};
|
($file, $dir, $suf) = fileparse $self->{"file"};
|
||||||
}
|
}
|
||||||
@ -821,6 +828,7 @@ sub check_type : method {
|
|||||||
if (-z $FH || $MAGIC_METHOD eq MAGIC_SUFFIX) {
|
if (-z $FH || $MAGIC_METHOD eq MAGIC_SUFFIX) {
|
||||||
return TYPE_GZIP if $file =~ /\.gz$/;
|
return TYPE_GZIP if $file =~ /\.gz$/;
|
||||||
return TYPE_BZIP2 if $file =~ /\.bz2$/;
|
return TYPE_BZIP2 if $file =~ /\.bz2$/;
|
||||||
|
return TYPE_XZ if $file =~ /\.xz/;
|
||||||
# Otherwise we assume it to be text/plain
|
# Otherwise we assume it to be text/plain
|
||||||
return TYPE_PLAIN;
|
return TYPE_PLAIN;
|
||||||
}
|
}
|
||||||
@ -855,6 +863,7 @@ sub check_type : method {
|
|||||||
# Check the returned file type text
|
# Check the returned file type text
|
||||||
return TYPE_GZIP if /gzip/i;
|
return TYPE_GZIP if /gzip/i;
|
||||||
return TYPE_BZIP2 if /bzip2/i;
|
return TYPE_BZIP2 if /bzip2/i;
|
||||||
|
return TYPE_XZ if /xz/i;
|
||||||
# Default everything to text/plain
|
# Default everything to text/plain
|
||||||
return TYPE_PLAIN;
|
return TYPE_PLAIN;
|
||||||
}
|
}
|
||||||
@ -868,6 +877,8 @@ sub check_io : method {
|
|||||||
return _private::IO->check_gzip if $self->{"type"} eq TYPE_GZIP;
|
return _private::IO->check_gzip if $self->{"type"} eq TYPE_GZIP;
|
||||||
# We need a bzip2 compression I/O handler
|
# We need a bzip2 compression I/O handler
|
||||||
return _private::IO->check_bzip2 if $self->{"type"} eq TYPE_BZIP2;
|
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
|
# We need a plain I/O handler
|
||||||
return _private::IO::Plain->new;
|
return _private::IO::Plain->new;
|
||||||
}
|
}
|
||||||
@ -1028,6 +1039,8 @@ sub new : method {
|
|||||||
$self->{"io"} = _private::IO->check_gzip;
|
$self->{"io"} = _private::IO->check_gzip;
|
||||||
} elsif ($CONF{"COMPRESS"} eq COMPRESS_BZIP2) {
|
} elsif ($CONF{"COMPRESS"} eq COMPRESS_BZIP2) {
|
||||||
$self->{"io"} = _private::IO->check_bzip2;
|
$self->{"io"} = _private::IO->check_bzip2;
|
||||||
|
} elsif ($CONF{"COMPRESS"} eq COMPRESS_XZ) {
|
||||||
|
$self->{"io"} = _private::IO->check_xz;
|
||||||
} else {
|
} else {
|
||||||
$self->{"io"} = _private::IO::Plain->new;
|
$self->{"io"} = _private::IO::Plain->new;
|
||||||
}
|
}
|
||||||
@ -1232,10 +1245,11 @@ import main;
|
|||||||
|
|
||||||
use Fcntl qw(:seek);
|
use Fcntl qw(:seek);
|
||||||
|
|
||||||
our ($GZIP_IO, $BZIP2_IO);
|
our ($GZIP_IO, $BZIP2_IO, $XZ_IO);
|
||||||
BEGIN {
|
BEGIN {
|
||||||
undef $GZIP_IO;
|
undef $GZIP_IO;
|
||||||
undef $BZIP2_IO;
|
undef $BZIP2_IO;
|
||||||
|
undef $XZ_IO;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Initialize the I/O handler interface
|
# Initialize the I/O handler interface
|
||||||
@ -1314,6 +1328,41 @@ sub check_bzip2 : method {
|
|||||||
die "$THIS_FILE: Necessary Compress::Bzip2 or bzip2 not available.\n$SHORT_HELP\n";
|
die "$THIS_FILE: Necessary 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
|
# Prepend records to an existing file
|
||||||
# * static method *
|
# * static method *
|
||||||
# For most I/O we read records out and write back with 2 I/O accesses.
|
# For most I/O we read records out and write back with 2 I/O accesses.
|
||||||
@ -2442,6 +2491,465 @@ sub close : method {
|
|||||||
return;
|
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
|
# _private::Format: The abstract log file format handler interface
|
||||||
package _private::Format;
|
package _private::Format;
|
||||||
use 5.008;
|
use 5.008;
|
||||||
@ -2587,7 +3095,7 @@ to archived files named logfile.yyyymm.gz.
|
|||||||
|
|
||||||
Currently, F<arclog> supports Apache access log, Syslog, NTP, Apache
|
Currently, F<arclog> supports Apache access log, Syslog, NTP, Apache
|
||||||
1 SSL engine log, and my own bracketed, modified ISO date/time log
|
1 SSL engine log, and my own bracketed, modified ISO date/time log
|
||||||
file formats, and gzip and bzip2 compression methods. Several
|
file formats, and gzip, bzip2, and xz compression methods. Several
|
||||||
software projects log (or can log) in a format compatible with the
|
software projects log (or can log) in a format compatible with the
|
||||||
Apache access log, like CUPS, ProFTPD, Pure-FTPd... etc., and
|
Apache access log, like CUPS, ProFTPD, Pure-FTPd... etc., and
|
||||||
F<arclog> can archive their Apache-like log files, too.
|
F<arclog> can archive their Apache-like log files, too.
|
||||||
@ -2657,10 +3165,11 @@ 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
|
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
|
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<file(1)|file/1> executable. F<arclog> treats everything not
|
||||||
L<gzip(1)|gzip/1> nor L<bzip2(1)|bzip2/1> compressed as plain text.
|
L<gzip(1)|gzip/1>, L<bzip2(1)|bzip2/1>, nor L<xz(1)|xz/1> compressed
|
||||||
When a compressed log file is wrongly recognized as an image,
|
as plain text. When a compressed log file is wrongly recognized as
|
||||||
F<arclog> treats it as plain text, reads directly from it, and fails.
|
an image, F<arclog> treats it as plain text, reads directly from it,
|
||||||
This does not hurt the source log files, but is still annoying.
|
and fails. This does not hurt the source log files, but is still
|
||||||
|
annoying.
|
||||||
|
|
||||||
=head1 OPTIONS
|
=head1 OPTIONS
|
||||||
|
|
||||||
@ -2669,8 +3178,8 @@ F<arclog> treats it as plain text, reads directly from it, and fails.
|
|||||||
=item logfile
|
=item logfile
|
||||||
|
|
||||||
The log file to be archived. Specify C<-> to read from C<STDIN>.
|
The log file to be archived. Specify C<-> to read from C<STDIN>.
|
||||||
You can specify multiple log files. L<gzip(1)|gzip/1> or
|
You can specify multiple log files. L<gzip(1)|gzip/1>,
|
||||||
L<bzip2(1)|bzip2/1> compressed files are supported.
|
L<bzip2(1)|bzip2/1>, or L<xz(1)|xz/1> compressed files are supported.
|
||||||
|
|
||||||
=item output
|
=item output
|
||||||
|
|
||||||
@ -2707,6 +3216,15 @@ calling foreign binaries. If L<Compress::Bzip2(3)|Compress::Bzip2/3>
|
|||||||
is not installed, it will try to use L<bzip2(1)|bzip2/1> instead. If
|
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.
|
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
|
=item n, none
|
||||||
|
|
||||||
No compression at all. (Why? :p)
|
No compression at all. (Why? :p)
|
||||||
@ -2859,8 +3377,11 @@ messages.
|
|||||||
|
|
||||||
=head1 SEE ALSO
|
=head1 SEE ALSO
|
||||||
|
|
||||||
L<gzip(1)|gzip/1>, L<zlib(3)|zlib/3>,
|
L<gzip(1)|gzip/1>, L<bzip2(1)|bzip2/1>, L<xz(1)|xz/1>,
|
||||||
L<Compress::Zlib(3)|Compress::Zlib/3>, L<bzip2(1)|syslog/1>,
|
L<Compress::Zlib(3)|Compress::Zlib/3>, L<syslog(1)|syslog/1>,
|
||||||
L<Compress::Bzip2(3)|Compress::Bzip2/3>, L<syslog(2)|syslog/2>
|
L<Compress::Bzip2(3)|Compress::Bzip2/3>,
|
||||||
|
L<IO::Compress::Xz(3)|IO::Compress::Xz/3>,
|
||||||
|
L<IO::Uncompress::UnXz(3)|IO::Uncompress::UnXz/3>,
|
||||||
|
L<syslog(2)|syslog/2>
|
||||||
|
|
||||||
=cut
|
=cut
|
||||||
|
@ -1,7 +1,7 @@
|
|||||||
#! /usr/bin/perl -w
|
#! /usr/bin/perl -w
|
||||||
# Test all the possible combination of options
|
# Test all the possible combination of options
|
||||||
|
|
||||||
# Copyright (c) 2007-2021 imacat.
|
# Copyright (c) 2007-2022 imacat.
|
||||||
#
|
#
|
||||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||||
# you may not use this file except in compliance with the License.
|
# you may not use this file except in compliance with the License.
|
||||||
@ -21,7 +21,7 @@ use warnings;
|
|||||||
use diagnostics;
|
use diagnostics;
|
||||||
use Test;
|
use Test;
|
||||||
|
|
||||||
BEGIN { plan tests => 2160 }
|
BEGIN { plan tests => 3600 }
|
||||||
|
|
||||||
use File::Basename qw(basename);
|
use File::Basename qw(basename);
|
||||||
use File::Path qw(mkpath rmtree);
|
use File::Path qw(mkpath rmtree);
|
||||||
@ -35,7 +35,7 @@ $WORKDIR = catdir($FindBin::Bin, "logs");
|
|||||||
$arclog = catfile($FindBin::Bin, updir, "blib", "script", "arclog");
|
$arclog = catfile($FindBin::Bin, updir, "blib", "script", "arclog");
|
||||||
$tno = 0;
|
$tno = 0;
|
||||||
|
|
||||||
# 1-2160: All possible option combinations
|
# 1-3600: All possible option combinations
|
||||||
# Test each log file format
|
# Test each log file format
|
||||||
foreach my $fmt (@LOG_FORMATS) {
|
foreach my $fmt (@LOG_FORMATS) {
|
||||||
# Test each source log file type
|
# Test each source log file type
|
||||||
|
@ -1,7 +1,7 @@
|
|||||||
#! /usr/bin/perl -w
|
#! /usr/bin/perl -w
|
||||||
# Test archiving several log files at once
|
# Test archiving several log files at once
|
||||||
|
|
||||||
# Copyright (c) 2007-2021 imacat.
|
# Copyright (c) 2007-2022 imacat.
|
||||||
#
|
#
|
||||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||||
# you may not use this file except in compliance with the License.
|
# you may not use this file except in compliance with the License.
|
||||||
@ -21,7 +21,7 @@ use warnings;
|
|||||||
use diagnostics;
|
use diagnostics;
|
||||||
use Test;
|
use Test;
|
||||||
|
|
||||||
BEGIN { plan tests => 16 }
|
BEGIN { plan tests => 25 }
|
||||||
|
|
||||||
use File::Basename qw(basename);
|
use File::Basename qw(basename);
|
||||||
use File::Path qw(mkpath rmtree);
|
use File::Path qw(mkpath rmtree);
|
||||||
@ -35,14 +35,15 @@ $WORKDIR = catdir($FindBin::Bin, "logs");
|
|||||||
$arclog = catfile($FindBin::Bin, updir, "blib", "script", "arclog");
|
$arclog = catfile($FindBin::Bin, updir, "blib", "script", "arclog");
|
||||||
$tno = 0;
|
$tno = 0;
|
||||||
|
|
||||||
# 1-16: Archiving several log files at once
|
# 1-25: Archiving several log files at once
|
||||||
foreach my $rt (@RESULT_TYPES) {
|
foreach my $rt (@RESULT_TYPES) {
|
||||||
my $skip;
|
my $skip;
|
||||||
$skip = 0;
|
$skip = 0;
|
||||||
# 1: Source log files listed as the arguments
|
# 1: Source log files listed as the arguments
|
||||||
$_ = eval {
|
$_ = eval {
|
||||||
if ( ($$rt{"type"} eq TYPE_GZIP && has_no_gzip)
|
if ( ($$rt{"type"} eq TYPE_GZIP && has_no_gzip)
|
||||||
|| ($$rt{"type"} eq TYPE_BZIP2 && has_no_bzip2)) {
|
|| ($$rt{"type"} eq TYPE_BZIP2 && has_no_bzip2)
|
||||||
|
|| ($$rt{"type"} eq TYPE_XZ && has_no_xz)) {
|
||||||
$skip = 1;
|
$skip = 1;
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
@ -56,13 +57,15 @@ foreach my $rt (@RESULT_TYPES) {
|
|||||||
$title = join ", ", "several log files", "all listed as arguments",
|
$title = join ", ", "several log files", "all listed as arguments",
|
||||||
$$fmt{"title"}, $$rt{"title"};
|
$$fmt{"title"}, $$rt{"title"};
|
||||||
# (2-4 times available compression) log files
|
# (2-4 times available compression) log files
|
||||||
$_ = 2 + (has_no_gzip? 0: 2) + (has_no_bzip2? 0: 2);
|
$_ = 2 + (has_no_gzip? 0: 2) + (has_no_bzip2? 0: 2)
|
||||||
|
+ (has_no_xz? 0: 2);
|
||||||
$num = $_ + int rand $_;
|
$num = $_ + int rand $_;
|
||||||
my %types = qw();
|
my %types = qw();
|
||||||
# At least 2 files for each available compression
|
# At least 2 files for each available compression
|
||||||
foreach my $st (@SOURCE_TYPES) {
|
foreach my $st (@SOURCE_TYPES) {
|
||||||
next if ($$st{"type"} eq TYPE_GZIP && has_no_gzip)
|
next if ($$st{"type"} eq TYPE_GZIP && has_no_gzip)
|
||||||
|| ($$st{"type"} eq TYPE_BZIP2 && has_no_bzip2);
|
|| ($$st{"type"} eq TYPE_BZIP2 && has_no_bzip2)
|
||||||
|
|| ($$st{"type"} eq TYPE_XZ && has_no_xz);
|
||||||
@_ = grep !exists $types{$_}, (0...$num-1);
|
@_ = grep !exists $types{$_}, (0...$num-1);
|
||||||
$types{$_[int rand @_]} = $st;
|
$types{$_[int rand @_]} = $st;
|
||||||
@_ = grep !exists $types{$_}, (0...$num-1);
|
@_ = grep !exists $types{$_}, (0...$num-1);
|
||||||
@ -73,7 +76,8 @@ foreach my $rt (@RESULT_TYPES) {
|
|||||||
do {
|
do {
|
||||||
$types{$_} = $SOURCE_TYPES[int rand @SOURCE_TYPES];
|
$types{$_} = $SOURCE_TYPES[int rand @SOURCE_TYPES];
|
||||||
} until !(${$types{$_}}{"type"} eq TYPE_GZIP && has_no_gzip)
|
} until !(${$types{$_}}{"type"} eq TYPE_GZIP && has_no_gzip)
|
||||||
&& !(${$types{$_}}{"type"} eq TYPE_BZIP2 && has_no_bzip2);
|
&& !(${$types{$_}}{"type"} eq TYPE_BZIP2 && has_no_bzip2)
|
||||||
|
&& !(${$types{$_}}{"type"} eq TYPE_XZ && has_no_xz);
|
||||||
}
|
}
|
||||||
@st = map $types{$_}, (0...$num-1);
|
@st = map $types{$_}, (0...$num-1);
|
||||||
@fs = qw();
|
@fs = qw();
|
||||||
@ -146,15 +150,17 @@ foreach my $rt (@RESULT_TYPES) {
|
|||||||
skip($skip, $_, 1, $@);
|
skip($skip, $_, 1, $@);
|
||||||
clean_up $_ || $skip, $WORKDIR, ++$tno;
|
clean_up $_ || $skip, $WORKDIR, ++$tno;
|
||||||
|
|
||||||
# 2-4: One of the source log files is read from STDIN
|
# 2-5: One of the source log files is read from STDIN
|
||||||
# The file type at STDIN
|
# The file type at STDIN
|
||||||
foreach my $st_stdin (@SOURCE_TYPES) {
|
foreach my $st_stdin (@SOURCE_TYPES) {
|
||||||
$skip = 0;
|
$skip = 0;
|
||||||
$_ = eval {
|
$_ = eval {
|
||||||
if ( ($$rt{"type"} eq TYPE_GZIP && has_no_gzip)
|
if ( ($$rt{"type"} eq TYPE_GZIP && has_no_gzip)
|
||||||
|| ($$rt{"type"} eq TYPE_BZIP2 && has_no_bzip2)
|
|| ($$rt{"type"} eq TYPE_BZIP2 && has_no_bzip2)
|
||||||
|
|| ($$rt{"type"} eq TYPE_XZ && has_no_xz)
|
||||||
|| ($$st_stdin{"type"} eq TYPE_GZIP && has_no_gzip)
|
|| ($$st_stdin{"type"} eq TYPE_GZIP && has_no_gzip)
|
||||||
|| ($$st_stdin{"type"} eq TYPE_BZIP2 && has_no_bzip2)) {
|
|| ($$st_stdin{"type"} eq TYPE_BZIP2 && has_no_bzip2)
|
||||||
|
|| ($$st_stdin{"type"} eq TYPE_XZ && has_no_xz)) {
|
||||||
$skip = 1;
|
$skip = 1;
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
@ -168,13 +174,15 @@ foreach my $rt (@RESULT_TYPES) {
|
|||||||
$title = join ", ", "several log files", "one read from STDIN",
|
$title = join ", ", "several log files", "one read from STDIN",
|
||||||
"STDIN " . $$st_stdin{"title"}, $$rt{"title"};
|
"STDIN " . $$st_stdin{"title"}, $$rt{"title"};
|
||||||
# (2-4 times available compression) log files
|
# (2-4 times available compression) log files
|
||||||
$_ = 2 + (has_no_gzip? 0: 2) + (has_no_bzip2? 0: 2);
|
$_ = 2 + (has_no_gzip? 0: 2) + (has_no_bzip2? 0: 2)
|
||||||
|
+ (has_no_xz? 0: 2);
|
||||||
$num = $_ + int rand $_;
|
$num = $_ + int rand $_;
|
||||||
my %types = qw();
|
my %types = qw();
|
||||||
# At least 2 files for each available compression
|
# At least 2 files for each available compression
|
||||||
foreach my $st (@SOURCE_TYPES) {
|
foreach my $st (@SOURCE_TYPES) {
|
||||||
next if ($$st{"type"} eq TYPE_GZIP && has_no_gzip)
|
next if ($$st{"type"} eq TYPE_GZIP && has_no_gzip)
|
||||||
|| ($$st{"type"} eq TYPE_BZIP2 && has_no_bzip2);
|
|| ($$st{"type"} eq TYPE_BZIP2 && has_no_bzip2)
|
||||||
|
|| ($$st{"type"} eq TYPE_XZ && has_no_xz);
|
||||||
@_ = grep !exists $types{$_}, (0...$num-1);
|
@_ = grep !exists $types{$_}, (0...$num-1);
|
||||||
$types{$_[int rand @_]} = $st;
|
$types{$_[int rand @_]} = $st;
|
||||||
@_ = grep !exists $types{$_}, (0...$num-1);
|
@_ = grep !exists $types{$_}, (0...$num-1);
|
||||||
@ -185,7 +193,8 @@ foreach my $rt (@RESULT_TYPES) {
|
|||||||
do {
|
do {
|
||||||
$types{$_} = $SOURCE_TYPES[int rand @SOURCE_TYPES];
|
$types{$_} = $SOURCE_TYPES[int rand @SOURCE_TYPES];
|
||||||
} until !(${$types{$_}}{"type"} eq TYPE_GZIP && has_no_gzip)
|
} until !(${$types{$_}}{"type"} eq TYPE_GZIP && has_no_gzip)
|
||||||
&& !(${$types{$_}}{"type"} eq TYPE_BZIP2 && has_no_bzip2);
|
&& !(${$types{$_}}{"type"} eq TYPE_BZIP2 && has_no_bzip2)
|
||||||
|
&& !(${$types{$_}}{"type"} eq TYPE_XZ && has_no_xz);
|
||||||
}
|
}
|
||||||
# Choose the STDIN from the matching compression
|
# Choose the STDIN from the matching compression
|
||||||
@_ = grep ${$types{$_}}{"type"} eq $$st_stdin{"type"}, (0...$num-1);
|
@_ = grep ${$types{$_}}{"type"} eq $$st_stdin{"type"}, (0...$num-1);
|
||||||
|
@ -1,7 +1,7 @@
|
|||||||
#! /usr/bin/perl -w
|
#! /usr/bin/perl -w
|
||||||
# Test fallback behavior
|
# Test fallback behavior
|
||||||
|
|
||||||
# Copyright (c) 2007-2021 imacat.
|
# Copyright (c) 2007-2022 imacat.
|
||||||
#
|
#
|
||||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||||
# you may not use this file except in compliance with the License.
|
# you may not use this file except in compliance with the License.
|
||||||
@ -50,18 +50,21 @@ foreach my $kt (@KEEP_MODES) {
|
|||||||
do {
|
do {
|
||||||
$rt = $RESULT_TYPES[int rand @RESULT_TYPES];
|
$rt = $RESULT_TYPES[int rand @RESULT_TYPES];
|
||||||
} until !($$rt{"type"} eq TYPE_GZIP && has_no_gzip)
|
} until !($$rt{"type"} eq TYPE_GZIP && has_no_gzip)
|
||||||
&& !($$rt{"type"} eq TYPE_BZIP2 && has_no_bzip2);
|
&& !($$rt{"type"} eq TYPE_BZIP2 && has_no_bzip2)
|
||||||
|
&& !($$rt{"type"} eq TYPE_XZ && has_no_xz);
|
||||||
$title = join ", ", "STDIN keep fall back", $$kt{"title"},
|
$title = join ", ", "STDIN keep fall back", $$kt{"title"},
|
||||||
$$fmt{"title"}, $$rt{"title"};
|
$$fmt{"title"}, $$rt{"title"};
|
||||||
# (2-4 times available compression) log files
|
# (2-4 times available compression) log files
|
||||||
$_ = 2 + (has_no_gzip? 0: 2) + (has_no_bzip2? 0: 2);
|
$_ = 2 + (has_no_gzip? 0: 2) + (has_no_bzip2? 0: 2)
|
||||||
|
+ (has_no_xz? 0: 2);
|
||||||
$num = $_ + int rand $_;
|
$num = $_ + int rand $_;
|
||||||
$stdin = int rand $num;
|
$stdin = int rand $num;
|
||||||
my %types = qw();
|
my %types = qw();
|
||||||
# At least 2 files for each available compression
|
# At least 2 files for each available compression
|
||||||
foreach my $st (@SOURCE_TYPES) {
|
foreach my $st (@SOURCE_TYPES) {
|
||||||
next if ($$st{"type"} eq TYPE_GZIP && has_no_gzip)
|
next if ($$st{"type"} eq TYPE_GZIP && has_no_gzip)
|
||||||
|| ($$st{"type"} eq TYPE_BZIP2 && has_no_bzip2);
|
|| ($$st{"type"} eq TYPE_BZIP2 && has_no_bzip2)
|
||||||
|
|| ($$st{"type"} eq TYPE_XZ && has_no_xz);
|
||||||
@_ = grep !exists $types{$_}, (0...$num-1);
|
@_ = grep !exists $types{$_}, (0...$num-1);
|
||||||
$types{$_[int rand @_]} = $st;
|
$types{$_[int rand @_]} = $st;
|
||||||
@_ = grep !exists $types{$_}, (0...$num-1);
|
@_ = grep !exists $types{$_}, (0...$num-1);
|
||||||
@ -72,7 +75,8 @@ foreach my $kt (@KEEP_MODES) {
|
|||||||
do {
|
do {
|
||||||
$types{$_} = $SOURCE_TYPES[int rand @SOURCE_TYPES];
|
$types{$_} = $SOURCE_TYPES[int rand @SOURCE_TYPES];
|
||||||
} until !(${$types{$_}}{"type"} eq TYPE_GZIP && has_no_gzip)
|
} until !(${$types{$_}}{"type"} eq TYPE_GZIP && has_no_gzip)
|
||||||
&& !(${$types{$_}}{"type"} eq TYPE_BZIP2 && has_no_bzip2);
|
&& !(${$types{$_}}{"type"} eq TYPE_BZIP2 && has_no_bzip2)
|
||||||
|
&& !(${$types{$_}}{"type"} eq TYPE_XZ && has_no_xz);
|
||||||
}
|
}
|
||||||
@st = map $types{$_}, (0...$num-1);
|
@st = map $types{$_}, (0...$num-1);
|
||||||
@fs = qw();
|
@fs = qw();
|
||||||
@ -160,18 +164,21 @@ $_ = eval {
|
|||||||
do {
|
do {
|
||||||
$rt = $RESULT_TYPES[int rand @RESULT_TYPES];
|
$rt = $RESULT_TYPES[int rand @RESULT_TYPES];
|
||||||
} until !($$rt{"type"} eq TYPE_GZIP && has_no_gzip)
|
} until !($$rt{"type"} eq TYPE_GZIP && has_no_gzip)
|
||||||
&& !($$rt{"type"} eq TYPE_BZIP2 && has_no_bzip2);
|
&& !($$rt{"type"} eq TYPE_BZIP2 && has_no_bzip2)
|
||||||
|
&& !($$rt{"type"} eq TYPE_XZ && has_no_xz);
|
||||||
$title = join ", ", "STDIN override ask fall back",
|
$title = join ", ", "STDIN override ask fall back",
|
||||||
$$fmt{"title"}, $$rt{"title"};
|
$$fmt{"title"}, $$rt{"title"};
|
||||||
# (2-4 times available compression) log files
|
# (2-4 times available compression) log files
|
||||||
$_ = 2 + (has_no_gzip? 0: 2) + (has_no_bzip2? 0: 2);
|
$_ = 2 + (has_no_gzip? 0: 2) + (has_no_bzip2? 0: 2)
|
||||||
|
+ (has_no_xz? 0: 2);
|
||||||
$num = $_ + int rand $_;
|
$num = $_ + int rand $_;
|
||||||
$stdin = int rand $num;
|
$stdin = int rand $num;
|
||||||
my %types = qw();
|
my %types = qw();
|
||||||
# At least 2 files for each available compression
|
# At least 2 files for each available compression
|
||||||
foreach my $st (@SOURCE_TYPES) {
|
foreach my $st (@SOURCE_TYPES) {
|
||||||
next if ($$st{"type"} eq TYPE_GZIP && has_no_gzip)
|
next if ($$st{"type"} eq TYPE_GZIP && has_no_gzip)
|
||||||
|| ($$st{"type"} eq TYPE_BZIP2 && has_no_bzip2);
|
|| ($$st{"type"} eq TYPE_BZIP2 && has_no_bzip2)
|
||||||
|
|| ($$st{"type"} eq TYPE_XZ && has_no_xz);
|
||||||
@_ = grep !exists $types{$_}, (0...$num-1);
|
@_ = grep !exists $types{$_}, (0...$num-1);
|
||||||
$types{$_[int rand @_]} = $st;
|
$types{$_[int rand @_]} = $st;
|
||||||
@_ = grep !exists $types{$_}, (0...$num-1);
|
@_ = grep !exists $types{$_}, (0...$num-1);
|
||||||
@ -182,7 +189,8 @@ $_ = eval {
|
|||||||
do {
|
do {
|
||||||
$types{$_} = $SOURCE_TYPES[int rand @SOURCE_TYPES];
|
$types{$_} = $SOURCE_TYPES[int rand @SOURCE_TYPES];
|
||||||
} until !(${$types{$_}}{"type"} eq TYPE_GZIP && has_no_gzip)
|
} until !(${$types{$_}}{"type"} eq TYPE_GZIP && has_no_gzip)
|
||||||
&& !(${$types{$_}}{"type"} eq TYPE_BZIP2 && has_no_bzip2);
|
&& !(${$types{$_}}{"type"} eq TYPE_BZIP2 && has_no_bzip2)
|
||||||
|
&& !(${$types{$_}}{"type"} eq TYPE_XZ && has_no_xz);
|
||||||
}
|
}
|
||||||
@st = map $types{$_}, (0...$num-1);
|
@st = map $types{$_}, (0...$num-1);
|
||||||
@fs = qw();
|
@fs = qw();
|
||||||
|
@ -1,7 +1,7 @@
|
|||||||
#! /usr/bin/perl -w
|
#! /usr/bin/perl -w
|
||||||
# Test the errors that should be captured.
|
# Test the errors that should be captured.
|
||||||
|
|
||||||
# Copyright (c) 2007-2021 imacat.
|
# Copyright (c) 2007-2022 imacat.
|
||||||
#
|
#
|
||||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||||
# you may not use this file except in compliance with the License.
|
# you may not use this file except in compliance with the License.
|
||||||
@ -140,13 +140,15 @@ $_ = eval {
|
|||||||
$title = join ",", "A same log file is specified more than once",
|
$title = join ",", "A same log file is specified more than once",
|
||||||
$$fmt{"title"}, $$rt{"title"};
|
$$fmt{"title"}, $$rt{"title"};
|
||||||
# (2-4 times available compression) log files
|
# (2-4 times available compression) log files
|
||||||
$_ = 2 + (has_no_gzip? 0: 2) + (has_no_bzip2? 0: 2);
|
$_ = 2 + (has_no_gzip? 0: 2) + (has_no_bzip2? 0: 2)
|
||||||
|
+ (has_no_xz? 0: 2);
|
||||||
$num = $_ + int rand $_;
|
$num = $_ + int rand $_;
|
||||||
my %types = qw();
|
my %types = qw();
|
||||||
# At least 2 files for each available compression
|
# At least 2 files for each available compression
|
||||||
foreach my $st (@SOURCE_TYPES) {
|
foreach my $st (@SOURCE_TYPES) {
|
||||||
next if ($$st{"type"} eq TYPE_GZIP && has_no_gzip)
|
next if ($$st{"type"} eq TYPE_GZIP && has_no_gzip)
|
||||||
|| ($$st{"type"} eq TYPE_BZIP2 && has_no_bzip2);
|
|| ($$st{"type"} eq TYPE_BZIP2 && has_no_bzip2)
|
||||||
|
|| ($$st{"type"} eq TYPE_XZ && has_no_xz);
|
||||||
@_ = grep !exists $types{$_}, (0...$num-1);
|
@_ = grep !exists $types{$_}, (0...$num-1);
|
||||||
$types{$_[int rand @_]} = $st;
|
$types{$_[int rand @_]} = $st;
|
||||||
@_ = grep !exists $types{$_}, (0...$num-1);
|
@_ = grep !exists $types{$_}, (0...$num-1);
|
||||||
@ -157,7 +159,8 @@ $_ = eval {
|
|||||||
do {
|
do {
|
||||||
$types{$_} = $SOURCE_TYPES[int rand @SOURCE_TYPES];
|
$types{$_} = $SOURCE_TYPES[int rand @SOURCE_TYPES];
|
||||||
} until !(${$types{$_}}{"type"} eq TYPE_GZIP && has_no_gzip)
|
} until !(${$types{$_}}{"type"} eq TYPE_GZIP && has_no_gzip)
|
||||||
&& !(${$types{$_}}{"type"} eq TYPE_BZIP2 && has_no_bzip2);
|
&& !(${$types{$_}}{"type"} eq TYPE_BZIP2 && has_no_bzip2)
|
||||||
|
&& !(${$types{$_}}{"type"} eq TYPE_XZ && has_no_xz);
|
||||||
}
|
}
|
||||||
@st = map $types{$_}, (0...$num-1);
|
@st = map $types{$_}, (0...$num-1);
|
||||||
@fs = qw();
|
@fs = qw();
|
||||||
|
87
t/_helper.pm
87
t/_helper.pm
@ -1,6 +1,6 @@
|
|||||||
# _helper.pm - A simple test suite helper
|
# _helper.pm - A simple test suite helper
|
||||||
|
|
||||||
# Copyright (c) 2007-2021 imacat.
|
# Copyright (c) 2007-2022 imacat.
|
||||||
#
|
#
|
||||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||||
# you may not use this file except in compliance with the License.
|
# you may not use this file except in compliance with the License.
|
||||||
@ -24,12 +24,12 @@ $VERSION = "0.01";
|
|||||||
@EXPORT = qw(
|
@EXPORT = qw(
|
||||||
read_file read_raw_file write_file write_raw_file
|
read_file read_raw_file write_file write_raw_file
|
||||||
run_cmd where_is file_type list_files preserve_source clean_up
|
run_cmd where_is file_type list_files preserve_source clean_up
|
||||||
has_no_file has_no_gzip has_no_bzip2
|
has_no_file has_no_gzip has_no_bzip2 has_no_xz
|
||||||
make_log_file
|
make_log_file
|
||||||
make_apache_log_file make_syslog_log_file
|
make_apache_log_file make_syslog_log_file
|
||||||
make_ntp_log_file make_apache_ssl_log_file make_modified_iso_log_file
|
make_ntp_log_file make_apache_ssl_log_file make_modified_iso_log_file
|
||||||
random_word
|
random_word
|
||||||
TYPE_TEXT TYPE_GZIP TYPE_BZIP2
|
TYPE_TEXT TYPE_GZIP TYPE_BZIP2 TYPE_XZ
|
||||||
@LOG_FORMATS @SOURCE_TYPES @RESULT_TYPES @KEEP_MODES @OVERRIDE_MODES);
|
@LOG_FORMATS @SOURCE_TYPES @RESULT_TYPES @KEEP_MODES @OVERRIDE_MODES);
|
||||||
# Prototype declaration
|
# Prototype declaration
|
||||||
sub this_file();
|
sub this_file();
|
||||||
@ -46,6 +46,7 @@ sub clean_up($$$);
|
|||||||
sub has_no_file();
|
sub has_no_file();
|
||||||
sub has_no_gzip();
|
sub has_no_gzip();
|
||||||
sub has_no_bzip2();
|
sub has_no_bzip2();
|
||||||
|
sub has_no_xz();
|
||||||
sub make_log_file($$$@);
|
sub make_log_file($$$@);
|
||||||
sub make_apache_log_file($;$);
|
sub make_apache_log_file($;$);
|
||||||
sub make_syslog_log_file($;$);
|
sub make_syslog_log_file($;$);
|
||||||
@ -71,15 +72,17 @@ use File::Temp qw(tempfile);
|
|||||||
use Time::Local qw(timelocal);
|
use Time::Local qw(timelocal);
|
||||||
$Data::Dumper::Indent = 1;
|
$Data::Dumper::Indent = 1;
|
||||||
|
|
||||||
our (%WHERE_IS, $HAS_NO_FILE, $HAS_NO_GZIP, $HAS_NO_BZIP2);
|
our (%WHERE_IS, $HAS_NO_FILE, $HAS_NO_GZIP, $HAS_NO_BZIP2, $HAS_NO_XZ);
|
||||||
%WHERE_IS = qw();
|
%WHERE_IS = qw();
|
||||||
undef $HAS_NO_FILE;
|
undef $HAS_NO_FILE;
|
||||||
undef $HAS_NO_GZIP;
|
undef $HAS_NO_GZIP;
|
||||||
undef $HAS_NO_BZIP2;
|
undef $HAS_NO_BZIP2;
|
||||||
|
undef $HAS_NO_XZ;
|
||||||
|
|
||||||
use constant TYPE_TEXT => "text/plain";
|
use constant TYPE_TEXT => "text/plain";
|
||||||
use constant TYPE_GZIP => "application/x-gzip";
|
use constant TYPE_GZIP => "application/x-gzip";
|
||||||
use constant TYPE_BZIP2 => "application/x-bzip2";
|
use constant TYPE_BZIP2 => "application/x-bzip2";
|
||||||
|
use constant TYPE_XZ => "application/x-xz";
|
||||||
|
|
||||||
our (@LOG_FORMATS, @SOURCE_TYPES, @RESULT_TYPES, @KEEP_MODES, @OVERRIDE_MODES);
|
our (@LOG_FORMATS, @SOURCE_TYPES, @RESULT_TYPES, @KEEP_MODES, @OVERRIDE_MODES);
|
||||||
# All the log format information
|
# All the log format information
|
||||||
@ -107,7 +110,11 @@ our (@LOG_FORMATS, @SOURCE_TYPES, @RESULT_TYPES, @KEEP_MODES, @OVERRIDE_MODES);
|
|||||||
{ "title" => "bzip2 source",
|
{ "title" => "bzip2 source",
|
||||||
"type" => TYPE_BZIP2,
|
"type" => TYPE_BZIP2,
|
||||||
"suf" => ".bz2",
|
"suf" => ".bz2",
|
||||||
"skip" => has_no_bzip2, }, );
|
"skip" => has_no_bzip2, },
|
||||||
|
{ "title" => "xz source",
|
||||||
|
"type" => TYPE_XZ,
|
||||||
|
"suf" => ".xz",
|
||||||
|
"skip" => has_no_xz, }, );
|
||||||
# All the result type information
|
# All the result type information
|
||||||
@RESULT_TYPES = (
|
@RESULT_TYPES = (
|
||||||
{ "title" => "default compress",
|
{ "title" => "default compress",
|
||||||
@ -125,6 +132,11 @@ our (@LOG_FORMATS, @SOURCE_TYPES, @RESULT_TYPES, @KEEP_MODES, @OVERRIDE_MODES);
|
|||||||
"suf" => ".bz2",
|
"suf" => ".bz2",
|
||||||
"skip" => has_no_bzip2,
|
"skip" => has_no_bzip2,
|
||||||
"opts" => [qw(-c b)], },
|
"opts" => [qw(-c b)], },
|
||||||
|
{ "title" => "xz compress",
|
||||||
|
"type" => TYPE_XZ,
|
||||||
|
"suf" => ".xz",
|
||||||
|
"skip" => has_no_xz,
|
||||||
|
"opts" => [qw(-c x)], },
|
||||||
{ "title" => "no compress",
|
{ "title" => "no compress",
|
||||||
"type" => TYPE_TEXT,
|
"type" => TYPE_TEXT,
|
||||||
"suf" => "",
|
"suf" => "",
|
||||||
@ -275,6 +287,36 @@ sub read_file($) {
|
|||||||
return $content;
|
return $content;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
# an xz compressed file
|
||||||
|
} elsif ($file =~ /\.xz/) {
|
||||||
|
# IO::Uncompress::UnXz
|
||||||
|
if (eval { require IO::Uncompress::UnXz; 1; }) {
|
||||||
|
my ($FH, $xz);
|
||||||
|
$content = "";
|
||||||
|
open $FH, $file or die this_file . ": $file: $!";
|
||||||
|
|
||||||
|
$xz = IO::Uncompress::UnXz->new($FH)
|
||||||
|
or die this_file . ": $file: $IO::Uncompress::UnXz::UnXzError";
|
||||||
|
while (1) {
|
||||||
|
($xz->read($_, 10240) != -1)
|
||||||
|
or die this_file . ": $file: $IO::Uncompress::UnXz::UnXzError";
|
||||||
|
$content .= $_;
|
||||||
|
last if length $_ < 10240;
|
||||||
|
}
|
||||||
|
$xz->close or die this_file . ": $file: $IO::Uncompress::UnXz::UnXzError";
|
||||||
|
return $content;
|
||||||
|
|
||||||
|
# xz executable
|
||||||
|
} else {
|
||||||
|
my ($PH, $CMD);
|
||||||
|
$CMD = where_is "xz";
|
||||||
|
$CMD = "xz -cd \"$file\"";
|
||||||
|
open $PH, "$CMD |" or die this_file . ": $CMD: $!";
|
||||||
|
$content = join "", <$PH>;
|
||||||
|
close $PH or die this_file . ": $CMD: $!";
|
||||||
|
return $content;
|
||||||
|
}
|
||||||
|
|
||||||
# a plain text file
|
# a plain text file
|
||||||
} else {
|
} else {
|
||||||
my $FH;
|
my $FH;
|
||||||
@ -360,6 +402,30 @@ sub write_file($$) {
|
|||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
# an xz compressed file
|
||||||
|
} elsif ($file =~ /\.xz/) {
|
||||||
|
# IO::Compress::Xz
|
||||||
|
if (eval { require IO::Compress::Xz; 1; }) {
|
||||||
|
my ($FH, $xz);
|
||||||
|
open $FH, ">$file" or die this_file . ": $file: $!";
|
||||||
|
$xz = IO::Compress::Xz->new($FH)
|
||||||
|
or die this_file . ": $file: $IO::Compress::Xz::XzError";
|
||||||
|
($xz->write($content, length $content) == length $content)
|
||||||
|
or die this_file . ": $file: $IO::Compress::Xz::XzError";
|
||||||
|
$xz->close or die this_file . ": $file: $IO::Compress::Xz::XzError";
|
||||||
|
return;
|
||||||
|
|
||||||
|
# xz executable
|
||||||
|
} else {
|
||||||
|
my ($PH, $CMD);
|
||||||
|
$CMD = where_is "xz";
|
||||||
|
$CMD = "\"$CMD\" -9f > \"$file\"";
|
||||||
|
open $PH, "| $CMD" or die this_file . ": $CMD: $!";
|
||||||
|
print $PH $content or die this_file . ": $CMD: $!";
|
||||||
|
close $PH or die this_file . ": $CMD: $!";
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
# a plain text file
|
# a plain text file
|
||||||
} else {
|
} else {
|
||||||
my $FH;
|
my $FH;
|
||||||
@ -452,6 +518,7 @@ sub file_type($) {
|
|||||||
$_ = File::MMagic->new->checktype_filename($file);
|
$_ = File::MMagic->new->checktype_filename($file);
|
||||||
return "application/x-gzip" if /gzip/;
|
return "application/x-gzip" if /gzip/;
|
||||||
return "application/x-bzip2" if /bzip2/;
|
return "application/x-bzip2" if /bzip2/;
|
||||||
|
return "application/x-xz" if /xz/;
|
||||||
# All else are text/plain
|
# All else are text/plain
|
||||||
return "text/plain";
|
return "text/plain";
|
||||||
}
|
}
|
||||||
@ -460,6 +527,7 @@ sub file_type($) {
|
|||||||
$_ = join "", `"$_" "$file"`;
|
$_ = join "", `"$_" "$file"`;
|
||||||
return "application/x-gzip" if /gzip/;
|
return "application/x-gzip" if /gzip/;
|
||||||
return "application/x-bzip2" if /bzip2/;
|
return "application/x-bzip2" if /bzip2/;
|
||||||
|
return "application/x-xz" if /: XZ/;
|
||||||
# All else are text/plain
|
# All else are text/plain
|
||||||
return "text/plain";
|
return "text/plain";
|
||||||
}
|
}
|
||||||
@ -549,6 +617,15 @@ sub has_no_bzip2() {
|
|||||||
return $HAS_NO_BZIP2;
|
return $HAS_NO_BZIP2;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
# If we have xz support somewhere
|
||||||
|
sub has_no_xz() {
|
||||||
|
$HAS_NO_XZ = eval { require IO::Compress::Xz; require IO::Uncompress::UnXz; 1; }
|
||||||
|
|| defined where_is "xz"?
|
||||||
|
0: "IO::Compress::Xz or xz executable not available"
|
||||||
|
if !defined $HAS_NO_XZ;
|
||||||
|
return $HAS_NO_XZ;
|
||||||
|
}
|
||||||
|
|
||||||
# Create a random existing log file
|
# Create a random existing log file
|
||||||
sub make_log_file($$$@) {
|
sub make_log_file($$$@) {
|
||||||
local ($_, %_);
|
local ($_, %_);
|
||||||
|
Loading…
Reference in New Issue
Block a user