Added support for the xz compression.
This commit is contained in:
parent
fb37d091d6
commit
67dca3926a
1
Build.PL
1
Build.PL
@ -63,6 +63,7 @@ my $build = Module::Build->new(
|
||||
"File::MMagic" => 0,
|
||||
"Compress::Zlib" => 0,
|
||||
"Compress::Bzip2" => 2,
|
||||
"IO::Compress::Xz" => 0,
|
||||
"Term::ReadKey" => 0,
|
||||
},
|
||||
build_requires => {
|
||||
|
||||
3
Changes
3
Changes
@ -1,5 +1,8 @@
|
||||
reslog change log
|
||||
|
||||
2022-03-19
|
||||
1. Added support for the xz compression.
|
||||
|
||||
2020-02-06 version 3.17
|
||||
1. Replaced the messy GNU-styled, multi-lingual documents with a
|
||||
single Markdown README.md.
|
||||
|
||||
@ -54,6 +54,7 @@ our (%OPT_PREREQ);
|
||||
"File::MMagic" => 0,
|
||||
"Compress::Zlib" => 0,
|
||||
"Compress::Bzip2" => 2,
|
||||
"IO::Compress::Xz" => 0,
|
||||
"Term::ReadKey" => 0,
|
||||
);
|
||||
delete $OPT_PREREQ{$_}
|
||||
|
||||
53
README.md
53
README.md
@ -40,10 +40,10 @@ Caution
|
||||
* I suggest that you install [File::MMagic] instead of counting on the
|
||||
`file` executable. The internal magic file of File::MMagic works
|
||||
better than the `file` executable. `reslog` treats everything not
|
||||
gzip nor bzip2 compressed as plain text. When a compressed log file
|
||||
is wrongly recognized as an image, `reslog` treats it as plain text,
|
||||
reads directly from it, and fails. This does not hurt the source
|
||||
log files, but is still annoying.
|
||||
gzip, bzip2, nor xz compressed as plain text. When a compressed log
|
||||
file is wrongly recognized as an image, `reslog` treats it as plain
|
||||
text, reads directly from it, and fails. This does not hurt the
|
||||
source log files, but is still annoying.
|
||||
|
||||
[File::MMagic]: https://metacpan.org/release/File-MMagic
|
||||
|
||||
@ -171,6 +171,42 @@ System Requirement
|
||||
[the bzip2 website]. Be sure to save it as `bzip2.exe` somewhere
|
||||
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]
|
||||
|
||||
This is used to display the progress bar. The progress bar is a
|
||||
@ -211,6 +247,10 @@ System Requirement
|
||||
[IO-Compress]: https://metacpan.org/release/IO-Compress
|
||||
[Compress::Bzip2]: https://metacpan.org/pod/Compress::Bzip2
|
||||
[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
|
||||
|
||||
|
||||
@ -373,7 +413,8 @@ Options
|
||||
The log file to be resolved. You can specify multiple log files.
|
||||
If not specified, it reads from `STDIN` and outputs to `STDOUT`.
|
||||
You can also specify `-` to read from `STDIN`. Result of `STDIN`
|
||||
goes to `STDOUT`. `gzip` or `bzip2` compressed files are supported.
|
||||
goes to `STDOUT`. `gzip`, `bzip2`, or `xz` compressed files are
|
||||
supported.
|
||||
|
||||
* `-k`, `--keep mode`
|
||||
|
||||
@ -480,7 +521,7 @@ Thanks
|
||||
License
|
||||
-------
|
||||
|
||||
Copyright (C) 2000-2021 imacat.
|
||||
Copyright (C) 2000-2022 imacat.
|
||||
|
||||
Licensed under the Apache License, Version 2.0 (the "License");
|
||||
you may not use this file except in compliance with the License.
|
||||
|
||||
513
reslog
513
reslog
@ -1,7 +1,7 @@
|
||||
#! /usr/bin/perl -w
|
||||
# reslog: Reverse-resolve IP in Apache log files
|
||||
|
||||
# Copyright (c) 2000-2021 imacat.
|
||||
# Copyright (c) 2000-2022 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
@ -27,7 +27,7 @@ BEGIN {
|
||||
@EXPORT = qw();
|
||||
push @EXPORT, qw(OVERRIDE_OVERWRITE OVERRIDE_APPEND OVERRIDE_FAIL);
|
||||
push @EXPORT, qw(KEEP_ALL KEEP_RESTART KEEP_DELETE);
|
||||
push @EXPORT, qw(TYPE_TEXT TYPE_GZIP TYPE_BZIP2);
|
||||
push @EXPORT, qw(TYPE_TEXT TYPE_GZIP TYPE_BZIP2 TYPE_XZ);
|
||||
push @EXPORT, qw(TMP_SUFFIX where_is rel2abs);
|
||||
@EXPORT_OK = @EXPORT;
|
||||
# Prototype declaration
|
||||
@ -68,6 +68,7 @@ use constant DEFAULT_KEEP => KEEP_DELETE;
|
||||
use constant TYPE_TEXT => "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-reslog";
|
||||
use constant DEFAULT_SUFFIX => ".resolved";
|
||||
@ -566,6 +567,7 @@ sub check_type : method {
|
||||
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_TEXT;
|
||||
}
|
||||
@ -600,6 +602,7 @@ sub check_type : method {
|
||||
# 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_TEXT;
|
||||
}
|
||||
@ -613,6 +616,8 @@ sub check_io : method {
|
||||
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;
|
||||
}
|
||||
@ -627,6 +632,8 @@ sub check_output : method {
|
||||
($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"};
|
||||
}
|
||||
@ -823,10 +830,11 @@ BEGIN {
|
||||
import main;
|
||||
}
|
||||
|
||||
our ($GZIP_IO, $BZIP2_IO);
|
||||
our ($GZIP_IO, $BZIP2_IO, $XZ_IO);
|
||||
BEGIN {
|
||||
undef $GZIP_IO;
|
||||
undef $BZIP2_IO;
|
||||
undef $XZ_IO;
|
||||
}
|
||||
|
||||
# Initialize the I/O handler interface
|
||||
@ -902,6 +910,41 @@ sub check_bzip2 : method {
|
||||
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";
|
||||
}
|
||||
|
||||
|
||||
# _private::IO::Plain: The plain I/O handle
|
||||
package _private::IO::Plain;
|
||||
@ -1928,6 +1971,456 @@ sub close : method {
|
||||
}
|
||||
|
||||
|
||||
# _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);
|
||||
|
||||
# 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, Extreme => 1)
|
||||
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, Extreme => 1)
|
||||
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, Extreme => 1)
|
||||
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 { $_[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) {
|
||||
# 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, Extreme => 1)
|
||||
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;
|
||||
}
|
||||
|
||||
# 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, "-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 "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, "-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) {
|
||||
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, "-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::Filter: The log file filter
|
||||
# The filter can be override to implementing different log file formats.
|
||||
# Maybe GeoIP. Or MS-Extended, in the future.
|
||||
@ -2292,10 +2785,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
|
||||
file of L<File::MMagic(3)|File::MMagic/3> works better than the
|
||||
L<file(1)|file/1> executable. F<reslog> treats everything not
|
||||
L<gzip(1)|gzip/1> nor L<bzip2(1)|bzip2/1> compressed as plain text.
|
||||
When a compressed log file is wrongly recognized as an image,
|
||||
F<reslog> treats it as plain text, reads directly from it, and fails.
|
||||
This does not hurt the source log files, but is still annoying.
|
||||
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<reslog> 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
|
||||
|
||||
@ -2306,7 +2800,8 @@ This does not hurt the source log files, but is still annoying.
|
||||
The log file to be resolved. You can specify multiple log files. If
|
||||
not specified, it reads from C<STDIN> and outputs to C<STDOUT>. You
|
||||
can also specify C<-> to read from C<STDIN>. Result of C<STDIN>
|
||||
goes to C<STDOUT>. gzip or bzip2 compressed files are supported.
|
||||
goes to C<STDOUT>. gzip, bzip2, or xz compressed files are
|
||||
supported.
|
||||
|
||||
=item -k, --keep mode
|
||||
|
||||
@ -2429,6 +2924,8 @@ messages.
|
||||
|
||||
L<Compress::Zlib(3)>,
|
||||
L<Compress::Bzip2(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<perlthrtut(1)>, L<gzip(1)>, L<zlib(3)>,
|
||||
L<bzip2(1)>.
|
||||
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
#! /usr/bin/perl -w
|
||||
# Test all the possible combination of options
|
||||
|
||||
# Copyright (c) 2005-2021 imacat.
|
||||
# Copyright (c) 2005-2022 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
@ -23,7 +23,7 @@ use warnings;
|
||||
use diagnostics;
|
||||
use Test;
|
||||
|
||||
BEGIN { plan tests => 1341 }
|
||||
BEGIN { plan tests => 1788 }
|
||||
|
||||
use File::Basename qw(basename);
|
||||
use File::Path qw(mkpath rmtree);
|
||||
@ -193,7 +193,7 @@ foreach my $st (@SOURCE_TYPES) {
|
||||
die unless $_ || $$st{"skip"};
|
||||
}
|
||||
|
||||
# 85: From STDIN to STDOUT
|
||||
# 149: From STDIN to STDOUT
|
||||
$_ = eval {
|
||||
return if $$st{"skip"};
|
||||
my ($title, $cmd, $ret_no, $out, $err, $logfile, $result);
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
#! /usr/bin/perl -w
|
||||
# Test processing 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");
|
||||
# you may not use this file except in compliance with the License.
|
||||
@ -23,7 +23,7 @@ use warnings;
|
||||
use diagnostics;
|
||||
use Test;
|
||||
|
||||
BEGIN { plan tests => 4 }
|
||||
BEGIN { plan tests => 5 }
|
||||
|
||||
use File::Basename qw(basename);
|
||||
use File::Path qw(mkpath rmtree);
|
||||
@ -48,13 +48,15 @@ $_ = eval {
|
||||
$suf = "." . random_word;
|
||||
do { $trim_suf = "." . random_word; } until $trim_suf ne $suf;
|
||||
# (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 $_;
|
||||
my %types = qw();
|
||||
# At least 2 files for each available compression
|
||||
foreach my $st (@SOURCE_TYPES) {
|
||||
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);
|
||||
$types{$_[int rand @_]} = $st;
|
||||
@_ = grep !exists $types{$_}, (0...$num-1);
|
||||
@ -65,7 +67,8 @@ $_ = eval {
|
||||
do {
|
||||
$types{$_} = $SOURCE_TYPES[int rand @SOURCE_TYPES];
|
||||
} 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);
|
||||
@fs = qw();
|
||||
@ -122,14 +125,15 @@ $_ = eval {
|
||||
ok($_, 1, $@);
|
||||
clean_up $_, $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
|
||||
foreach my $st_stdin (@SOURCE_TYPES) {
|
||||
my $skip;
|
||||
$skip = 0;
|
||||
$_ = eval {
|
||||
if ( ($$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;
|
||||
return;
|
||||
}
|
||||
@ -143,13 +147,15 @@ foreach my $st_stdin (@SOURCE_TYPES) {
|
||||
$suf = "." . random_word;
|
||||
do { $trim_suf = "." . random_word; } until $trim_suf ne $suf;
|
||||
# (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 $_;
|
||||
my %types = qw();
|
||||
# At least 2 files for each available compression
|
||||
foreach my $st (@SOURCE_TYPES) {
|
||||
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);
|
||||
$types{$_[int rand @_]} = $st;
|
||||
@_ = grep !exists $types{$_}, (0...$num-1);
|
||||
@ -160,7 +166,8 @@ foreach my $st_stdin (@SOURCE_TYPES) {
|
||||
do {
|
||||
$types{$_} = $SOURCE_TYPES[int rand @SOURCE_TYPES];
|
||||
} 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
|
||||
@_ = grep ${$types{$_}}{"type"} eq $$st_stdin{"type"}, (0...$num-1);
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
#! /usr/bin/perl -w
|
||||
# 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");
|
||||
# you may not use this file except in compliance with the License.
|
||||
@ -21,7 +21,7 @@ use warnings;
|
||||
use diagnostics;
|
||||
use Test;
|
||||
|
||||
BEGIN { plan tests => 7 }
|
||||
BEGIN { plan tests => 9 }
|
||||
|
||||
use File::Basename qw(basename);
|
||||
use File::Path qw(mkpath rmtree);
|
||||
@ -35,7 +35,7 @@ $WORKDIR = catdir($FindBin::Bin, "logs");
|
||||
$reslog = catfile($FindBin::Bin, updir, "blib", "script", "reslog");
|
||||
$tno = 0;
|
||||
|
||||
# 1-6: Trim suffix is the same as suffix
|
||||
# 1-8: Trim suffix is the same as suffix
|
||||
foreach my $st (@SOURCE_TYPES) {
|
||||
# 1: Trim suffix is the same as suffix
|
||||
$_ = eval {
|
||||
@ -126,7 +126,7 @@ foreach my $st (@SOURCE_TYPES) {
|
||||
clean_up $_ || $$st{"skip"}, $WORKDIR, ++$tno;
|
||||
}
|
||||
|
||||
# 7: A same log file is specified more than once
|
||||
# 9: A same log file is specified more than once
|
||||
$_ = eval {
|
||||
my ($title, $cmd, $ret_no, $out, $err, %logfiles);
|
||||
my ($fr, $frb, @fle, $fle, $flr, %cef, %crf, %tef, %trf);
|
||||
|
||||
74
t/_helper.pm
74
t/_helper.pm
@ -1,6 +1,6 @@
|
||||
# _helper.pm - A simple test suite helper
|
||||
|
||||
# Copyright (c) 2005-2021 imacat
|
||||
# Copyright (c) 2005-2022 imacat
|
||||
#
|
||||
# This program is free software: you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
@ -25,10 +25,10 @@ $VERSION = "0.05";
|
||||
@EXPORT = qw(
|
||||
read_file read_raw_file write_file write_raw_file
|
||||
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_resolved_log_file make_empty_log_file
|
||||
random_word
|
||||
TYPE_TEXT TYPE_GZIP TYPE_BZIP2
|
||||
TYPE_TEXT TYPE_GZIP TYPE_BZIP2 TYPE_XZ
|
||||
@CONTENT_TYPES @SOURCE_TYPES @KEEP_MODES @OVERRIDE_MODES @SUFFICES @TRIM_SUFFIX);
|
||||
# Prototype declaration
|
||||
sub this_file();
|
||||
@ -45,6 +45,7 @@ sub clean_up($$$);
|
||||
sub has_no_file();
|
||||
sub has_no_gzip();
|
||||
sub has_no_bzip2();
|
||||
sub has_no_xz();
|
||||
sub make_log_file($);
|
||||
sub make_resolved_log_file($);
|
||||
sub make_empty_log_file($);
|
||||
@ -60,16 +61,18 @@ use File::Spec::Functions qw(splitdir catdir catfile path);
|
||||
use File::Temp qw(tempfile);
|
||||
use Socket;
|
||||
|
||||
our (%WHERE_IS, $HAS_NO_FILE, $HAS_NO_GZIP, $HAS_NO_BZIP2, $RANDOM_IP);
|
||||
our (%WHERE_IS, $HAS_NO_FILE, $HAS_NO_GZIP, $HAS_NO_BZIP2, $HAS_NO_XZ, $RANDOM_IP);
|
||||
%WHERE_IS = qw();
|
||||
undef $HAS_NO_FILE;
|
||||
undef $HAS_NO_GZIP;
|
||||
undef $HAS_NO_BZIP2;
|
||||
undef $HAS_NO_XZ;
|
||||
undef $RANDOM_IP;
|
||||
|
||||
use constant TYPE_TEXT => "text/plain";
|
||||
use constant TYPE_GZIP => "application/x-gzip";
|
||||
use constant TYPE_BZIP2 => "application/x-bzip2";
|
||||
use constant TYPE_XZ => "application/x-xz";
|
||||
|
||||
our (@CONTENT_TYPES, @SOURCE_TYPES, @KEEP_MODES, @OVERRIDE_MODES, @SUFFICES,
|
||||
@TRIM_SUFFIX);
|
||||
@ -94,7 +97,11 @@ our (@CONTENT_TYPES, @SOURCE_TYPES, @KEEP_MODES, @OVERRIDE_MODES, @SUFFICES,
|
||||
{ "title" => "bzip2 source",
|
||||
"type" => TYPE_BZIP2,
|
||||
"suf" => ".bz2",
|
||||
"skip" => has_no_bzip2, }, );
|
||||
"skip" => has_no_bzip2, },
|
||||
{ "title" => "xz source",
|
||||
"type" => TYPE_XZ,
|
||||
"suf" => ".xz",
|
||||
"skip" => has_no_xz, }, );
|
||||
# All the keep mode information
|
||||
@KEEP_MODES = (
|
||||
{ "title" => "keep default",
|
||||
@ -239,6 +246,29 @@ sub read_file($) {
|
||||
return $content;
|
||||
}
|
||||
|
||||
# an xz compressed file
|
||||
} elsif ($file =~ /\.xz$/) {
|
||||
# IO::Uncompress::UnXz
|
||||
if (eval { require IO::Uncompress::UnXz; 1; }) {
|
||||
my $xz;
|
||||
$content = "";
|
||||
$xz = IO::Uncompress::UnXz->new($file)
|
||||
or die this_file . ": $file: $IO::Uncompress::UnXz::UnXzError";
|
||||
$content = join "", <$xz>;
|
||||
$xz->close or die this_file . ": $file: $IO::Uncompress::UnXz::UnXzError";
|
||||
return $content;
|
||||
|
||||
# xz executable
|
||||
} else {
|
||||
my ($PH, $CMD);
|
||||
$CMD = where_is "xz";
|
||||
$CMD = "\"$CMD\" -cdf \"$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
|
||||
} else {
|
||||
my $FH;
|
||||
@ -326,6 +356,29 @@ sub write_file($$) {
|
||||
return;
|
||||
}
|
||||
|
||||
# an xz compressed file
|
||||
} elsif ($file =~ /\.xz$/) {
|
||||
# IO::Compress::Xz
|
||||
if (eval { require IO::Compress::Xz; 1; }) {
|
||||
my $xz;
|
||||
$xz = IO::Compress::Xz->new($file, Extreme => 1)
|
||||
or die this_file . ": $file: $IO::Compress::Xz::XzError";
|
||||
($xz->write($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\" -c9f > \"$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
|
||||
} else {
|
||||
my $FH;
|
||||
@ -418,6 +471,7 @@ sub file_type($) {
|
||||
$_ = File::MMagic->new->checktype_filename($file);
|
||||
return TYPE_GZIP if /gzip/;
|
||||
return TYPE_BZIP2 if /bzip2/;
|
||||
return TYPE_XZ if /xz/;
|
||||
# All else are text/plain
|
||||
return TYPE_TEXT;
|
||||
}
|
||||
@ -426,6 +480,7 @@ sub file_type($) {
|
||||
$_ = join "", `"$_" "$file"`;
|
||||
return TYPE_GZIP if /gzip/;
|
||||
return TYPE_BZIP2 if /bzip2/;
|
||||
return TYPE_XZ if /: XZ/;
|
||||
# All else are text/plain
|
||||
return TYPE_TEXT;
|
||||
}
|
||||
@ -515,6 +570,15 @@ sub 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 normal random log file
|
||||
sub make_log_file($) {
|
||||
local ($_, %_);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user