#!/usr/bin/perl -w
#
# tac - concatenate and print files in reverse
#
# mail tgy@chocobo.org < bug_reports
#
# Copyright (c) 1999 Moogle Stuffy Software. All rights reserved.
# You may play with this software in accordance with the Perl Artistic License.
use Getopt::Std;
my $VERSION = '0.17';
getopts('bBrs:S:', \my %opts);
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/$_/;
}
}
$opts{files} = \@ARGV;
my $fh = new IO::Tac %opts or die "$0: can't open file: $!\n";
print while <$fh>;
END {
close STDOUT || die "$0: can't close stdout: $!\n";
$? = 1 if $? == 255; # from die
}
package
IO::Tac; # hide from PAUSE
use strict;
use Carp;
use Symbol;
use Fcntl;
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) { # Construct with name/value pairs.
%opts = @_;
%opts = map {lc, $opts{$_}} keys %opts;
@files = @{$opts{files}} if $opts{files};
} else { # Construct with one filename.
@files = @_;
}
*$self = {
%opts,
lines => [], # Lines in memory.
scrap => '', # Incomplete line.
EOF => 0, # Finished reading current file.
count => 0, # Current line number.
ends => [], # Array of ORS for 'autoline'.
};
# Set mode for opening file.
my $mode = O_RDONLY;
$mode |= O_BINARY if *$self->{binary};
# Open files for reading.
@files = map {
local *FH;
sysopen FH, $_, $mode or return;
sysseek FH, 0, 2 or return;
[$_, *FH];
} @files ? @files : @ARGV;
# Add files and filehandles to object.
*$self->{files} = @files ? \@files : [['-', *STDIN]];
# Keep track of current file.
$ARGV = *$self->{files}[0][0];
# Save $\ in case 'autoline' changes it.
*$self->{ORS} = $\;
# Process record separator.
my ($RS) = map {
! defined $_ ? '\n' : # Default to newline.
ref $_ ? $_ : # Regular expression.
! length && ++*$self->{paragraph} ? '\n\n+' : # Paragraph mode.
quotemeta # Literal string.
} defined $opts{separator} ? $opts{separator} : $/;
if (ref $RS eq 'SCALAR') { # Record mode.
*$self->{record} = 1;
*$self->{binary} = 1;
*$self->{size} = $$RS;
*$self->{RE} = {
broken => qr/\Z-\A/, # Never match.
RS => qr/^/, # Always match.
};
} else { # Line mode.
*$self->{size} ||= 8192;
*$self->{RE} = {
broken => qr/\A$RS/, # RS broken at chunk boundary.
RS => qr/$RS/, # Match RS.
capture => qr/($RS)/, # Capture RS.
line => qr/((?s:.*?)$RS|(?s:.+))/, # Match whole line.
};
}
# autoline => boolean to indicate if option was set
# autoline_ors => output record separator
# chomp => separate from rest of autoline
@{*$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;
# Start on next file.
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 '-') {
# Next chunk of data comes from STDIN.
local $/;
$_ = <$fh>;
*$self->{EOF}++;
if (*$self->{record}) {
unshift @lines, substr $_, -$size, $size, '' while length;
return \@lines;
}
} else {
# Get next chunk of data. Make sure that it contains at least
# one record separator (hence, at least one line) and that no
# record separator has been broken across two chunks.
my $file = *$self->{files}[0];
CHUNK: {
my $tell = tell $fh;
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};
}
# Append incomplete line from last chunk.
$_ .= *$self->{scrap};
# Parse chunk for records (a..c) and separators (1..3). The last
# record of a chunk may be missing its separator.
# Full chunk: a1b2c3
# Half chunk: a1b2c
if (*$self->{chomp}) {
@lines = split /$re{RS}/, $_, -1;
# Full: a b c ''
# Half: a b c
*$self->{scrap} = *$self->{EOF} ? '' : shift @lines;
length $lines[-1] or pop @lines;
# Full: b c
# Half: b c
} elsif (*$self->{autoline}) {
if (defined *$self->{autoline_ors}) {
@lines = split /$re{RS}/, $_, -1;
# Full: a b c ''
# Half: a b c
*$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;
# Full: [a] b c + ors ors
# Half: [a] b c + ors ''
} else {
my @array = split /$re{capture}/, $_, -1;
# Full: a 1 b 2 c 3 ''
# Half: a 1 b 2 c
*$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;
# Full: [a1] b c + 2 3
# Half: [a1] b c + 2 ''
}
} elsif (*$self->{before}) {
if (*$self->{paragraph}) {
@lines = split /$re{RS}/, $_, -1;
# Full: a b c ''
# Half: a b c
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;
}
# Full: [a] \n\nb \n\nc \n\n
# Half: [a] \n\nb \n\nc
} else {
my @array = split /$re{capture}/, $_, -1;
# Full: a 1 b 2 c 3 ''
# Half: a 1 b 2 c
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;
}
# Full: [a] 1b 2c 3
# Half: [a] 1b 2c
}
} else {
if (*$self->{paragraph}) {
@lines = split /$re{RS}/, $_, -1;
# Full: a b c ''
# Half: a b c
*$self->{scrap} = *$self->{EOF} ? '' : shift @lines;
my $last = pop @lines;
@lines = map "$_\n\n", @lines;
push @lines, $last if length $last;
# Full: [a] b\n\n c\n\n
# Half: [a] b\n\n c
} else {
@lines = /$re{line}/g;
*$self->{scrap} = *$self->{EOF} ? '' : shift @lines;
# Full: [a1] b2 c3
# Half: [a1] b2 c
}
}
# For autoline mode.
*$self->{ends} = \@ends;
\@lines;
}
sub CLOSE {
my $self = shift;
$. = *$self->{count} = 0;
$\ = *$self->{ORS} if *$self->{autoline};
}
sub DESTROY {
shift->CLOSE;
}
# *readline = \&READLINE;
# *close = \&CLOSE;
sub eof {
my $self = shift;
*$self->{EOF} && ! @{*$self->{lines}};
}
1;
__END__
=head1 NAME
tac - concatenate and print files in reverse
=head1 SYNOPSIS
B<tac> [-br] [-s separator] [-B] [-S bytes] [file...]
=head1 DESCRIPTION
B<tac> copies files or standard input to standard output with the order of
records reversed.
=head1 OPTIONS
=over
=item -b
Attach separator to the beginning of the record that it precedes in the file.
=item -B
Read files in binary mode.
=item -r
The separator is a regular expression.
=item -s STRING
Use STRING as record separator. Set to C<''> for paragraph mode. Defaults to
newline.
=item -S BYTES
Number of bytes to read at a time. Defaults to 8192.
=back
=head1 NOTES
=over
=item 1
B<-B> and B<-S> are peculiar to this implementation of B<tac>.
=item 2
Regular expressions are as in Perl with some caveats:
=item /foo(bar)/
Do not use capturing parenthesis. They will conflict with B<tac>'s internal use
of them.
=item /foo|bar/
Alternation may match out of sequence, because matches are made against chunks
of files rather than whole files. Set B<-S> to a suitably large number to avoid
this.
=back
=head1 AUTHOR
Tim Gim Yee | tgy@chocobo.org | I want a moogle stuffy!
=head1 COPYRIGHT
Copyright (c) 1999 Moogle Stuffy Software. All rights reserved.
You may play with this software in accordance with the Perl Artistic License.
=cut