#!/usr/bin/perl
my
$Program
= basename($0);
my
$VERSION
=
'0.18'
;
my
%opts
;
getopts(
'bBrs:S:'
, \
%opts
) or usage();
my
%long
=
qw/
b before
B binary
r regex
s separator
S size
/
;
%opts
=
map
{
$long
{
$_
},
$opts
{
$_
}}
keys
%opts
;
if
(
defined
$opts
{separator} &&
$opts
{regex}) {
for
(
$opts
{separator}) {
s!^/(.*)/\z!$1!s;
$_
=
qr/$_/
;
}
}
if
(
defined
$opts
{
'size'
}) {
if
(
$opts
{
'size'
} !~ m/\A[0-9]+\Z/ ||
$opts
{
'size'
} == 0) {
warn
"$Program: option -S expects a number >= 1\n"
;
usage();
}
}
$opts
{files} = \
@ARGV
;
my
$fh
= IO::Tac->new(
%opts
);
unless
(
$fh
) {
exit
EX_FAILURE;
}
print
while
<
$fh
>;
exit
EX_SUCCESS;
sub
usage {
warn
"$Program version $VERSION\n"
;
warn
"usage: $Program [-br] [-s separator] [-B] [-S bytes] [file...]\n"
;
exit
EX_FAILURE;
}
END {
close
STDOUT ||
die
"$Program: can't close stdout: $!\n"
;
$? = 1
if
$? == 255;
}
package
IO::Tac;
sub
new {
my
$class
=
shift
;
my
$fh
= gensym;
tie
*$fh
,
$class
,
$fh
,
@_
;
}
sub
TIEHANDLE {
my
$class
=
shift
;
my
$self
=
shift
;
my
(
%opts
,
@files
);
if
(
@_
> 1) {
%opts
=
@_
;
%opts
=
map
{
lc
,
$opts
{
$_
}}
keys
%opts
;
@files
= @{
$opts
{files}}
if
$opts
{files};
}
else
{
@files
=
@_
;
}
*$self
= {
%opts
,
lines
=> [],
scrap
=>
''
,
EOF
=> 0,
count
=> 0,
ends
=> [],
};
my
$mode
= O_RDONLY;
$mode
|= O_BINARY
if
*$self
->{binary};
if
(
scalar
(
@files
) == 0 &&
scalar
(
@ARGV
) == 0) {
*$self
->{
'files'
} = [[
'-'
,
*STDIN
]];
}
else
{
if
(
scalar
(
@files
) == 0) {
@files
=
@ARGV
;
}
*$self
->{
'files'
} = [];
foreach
my
$file
(
@files
) {
if
(-d
$file
) {
warn
"$Program: '$file' is a directory\n"
;
next
;
}
my
$fh
;
unless
(
sysopen
$fh
,
$file
,
$mode
) {
warn
"$Program: failed to open '$file': $!\n"
;
next
;
}
unless
(
sysseek
$fh
, 0, 2) {
warn
"$Program: seek failed for '$file': $!\n"
;
next
;
}
push
@{
*$self
->{
'files'
} }, [
$file
,
$fh
];
}
}
return
if
(
scalar
@{
*$self
->{
'files'
} } == 0);
$ARGV
=
*$self
->{files}[0][0];
*$self
->{ORS} = $\;
my
(
$RS
) =
map
{
!
defined
$_
?
'\n'
:
ref
$_
?
$_
:
!
length
&& ++
*$self
->{paragraph} ?
'\n\n+'
:
quotemeta
}
defined
$opts
{separator} ?
$opts
{separator} : $/;
if
(
ref
$RS
eq
'SCALAR'
) {
*$self
->{record} = 1;
*$self
->{binary} = 1;
*$self
->{size} =
$$RS
;
*$self
->{RE} = {
broken
=>
qr/\Z-\A/
,
RS
=>
qr/^/
,
};
}
else
{
*$self
->{size} ||= 8192;
*$self
->{RE} = {
broken
=>
qr/\A$RS/
,
RS
=>
qr/$RS/
,
capture
=>
qr/($RS)/
,
line
=>
qr/((?s:.*?)$RS|(?s:.+))/
,
};
}
@{
*$self
}{
qw/autoline_ors autoline/
} = (
*$self
->{autoline}, 1)
if
exists
*$self
->{autoline};
*$self
->{
chomp
} =
*$self
->{autoline} &&
defined
$_
&& !
length
$_
for
*$self
->{autoline_ors};
*$self
->{
chomp
} and
undef
*$self
->{autoline};
*$self
->{autoline_ors} =
"\n\n"
if
*$self
->{paragraph} && !
defined
*$self
->{autoline};
bless
$self
,
$class
;
}
sub
READLINE {
my
$self
=
shift
;
@{
*$self
->{lines}} or
*$self
->{lines} =
$self
->get_lines or
return
;
$. = ++
*$self
->{count}
if
*$self
->{autocount};
$\ =
pop
@{
*$self
->{ends}}
if
*$self
->{autoline};
pop
@{
*$self
->{lines}};
}
sub
get_lines {
my
$self
=
shift
;
if
(
*$self
->{EOF}) {
shift
@{
*$self
->{files}};
unless
(@{
*$self
->{files}}) {
$\ =
*$self
->{ORS}
if
*$self
->{autoline};
*$self
->{autoline} = 0;
return
;
}
$ARGV
=
*$self
->{files}[0][0];
*$self
->{EOF} = 0;
}
local
$_
=
''
;
my
%re
= %{
*$self
->{RE}};
my
$size
=
*$self
->{size};
my
$fh
=
*$self
->{files}[0][1];
my
(
@lines
,
@ends
);
if
(
*$self
->{files}[0][0] eq
'-'
) {
local
$/;
$_
= <
$fh
>;
*$self
->{EOF}++;
if
(
*$self
->{record}) {
unshift
@lines
,
substr
$_
, -
$size
,
$size
,
''
while
length
;
return
\
@lines
;
}
}
else
{
my
$file
=
*$self
->{files}[0];
CHUNK: {
my
$tell
=
sysseek
$fh
, 0, 1;
unless
(
$tell
>
$size
) {
sysseek
$fh
, 0, 0 or confess
"Bad seek on [$file]: $!"
;
sysread
$fh
,
$_
,
$tell
or confess
"Bad read on [$file]: $!"
;
*$self
->{EOF}++,
last
CHUNK;
}
sysseek
$fh
, -
$size
, 1 or confess
"Bad seek on [$file]: $!"
;
sysread
$fh
,
$_
,
$size
or confess
"Bad read on [$file]: $!"
;
/
$re
{broken}/ and
$size
+= 10,
redo
CHUNK;
not /
$re
{RS}/ and
$size
+=
*$self
->{size},
redo
CHUNK;
}
unless
(
*$self
->{EOF}) {
sysseek
$fh
, -
$size
, 1 or confess
"Bad seek on [$file]: $!"
;
}
return
[
$_
]
if
*$self
->{record};
}
$_
.=
*$self
->{scrap};
if
(
*$self
->{
chomp
}) {
@lines
=
split
/
$re
{RS}/,
$_
, -1;
*$self
->{scrap} =
*$self
->{EOF} ?
''
:
shift
@lines
;
length
$lines
[-1] or
pop
@lines
;
}
elsif
(
*$self
->{autoline}) {
if
(
defined
*$self
->{autoline_ors}) {
@lines
=
split
/
$re
{RS}/,
$_
, -1;
*$self
->{scrap} =
*$self
->{EOF} ?
''
:
shift
@lines
;
my
$last
=
pop
@lines
;
@ends
= (
*$self
->{autoline_ors}) x
@lines
;
push
@lines
,
$last
and
push
@ends
,
''
if
length
$last
;
}
else
{
my
@array
=
split
/
$re
{capture}/,
$_
, -1;
*$self
->{scrap} =
*$self
->{EOF} ?
''
:
join
''
,
splice
@array
, 0, 2;
length
$array
[-1] ?
push
@array
,
''
:
pop
@array
;
push
@lines
,
shift
@array
and
push
@ends
,
shift
@array
while
@array
;
}
}
elsif
(
*$self
->{
before
}) {
if
(
*$self
->{paragraph}) {
@lines
=
split
/
$re
{RS}/,
$_
, -1;
if
(
*$self
->{EOF}) {
*$self
->{scrap} =
''
;
my
$first
=
shift
@lines
;
@lines
=
map
"\n\n$_"
,
@lines
;
unshift
@lines
,
$first
;
}
else
{
*$self
->{scrap} =
shift
@lines
;
@lines
=
map
"\n\n$_"
,
@lines
;
}
}
else
{
my
@array
=
split
/
$re
{capture}/,
$_
, -1;
if
(
*$self
->{EOF}) {
*$self
->{scrap} =
''
;
my
$first
=
shift
@array
;
push
@lines
,
join
''
,
splice
@array
, 0, 2
while
@array
;
unshift
@lines
,
$first
;
}
else
{
*$self
->{scrap} =
shift
@array
;
push
@lines
,
join
''
,
splice
@array
, 0, 2
while
@array
;
}
}
}
else
{
if
(
*$self
->{paragraph}) {
@lines
=
split
/
$re
{RS}/,
$_
, -1;
*$self
->{scrap} =
*$self
->{EOF} ?
''
:
shift
@lines
;
my
$last
=
pop
@lines
;
@lines
=
map
"$_\n\n"
,
@lines
;
push
@lines
,
$last
if
length
$last
;
}
else
{
@lines
= /
$re
{line}/g;
*$self
->{scrap} =
*$self
->{EOF} ?
''
:
shift
@lines
;
}
}
*$self
->{ends} = \
@ends
;
\
@lines
;
}
sub
CLOSE {
my
$self
=
shift
;
$. =
*$self
->{count} = 0;
$\ =
*$self
->{ORS}
if
*$self
->{autoline};
}
sub
DESTROY {
shift
->CLOSE;
}
sub
eof
{
my
$self
=
shift
;
*$self
->{EOF} && ! @{
*$self
->{lines}};
}
1;