#!/usr/bin/perl -w

use strict;
use warnings;

use Date::Format qw(time2str);
use Getopt::Long qw(GetOptions);
use IO::Handle;
use Time::ParseDate qw(parsedate);

use constant {
    LENGTH_OF_TIMESTAMP => 19,
    RE_TIMESTAMP =>
      qr/^[1-9][0-9]{3,}-[012][0-9]-[0-3][0-9] [012][0-9](?::[0-5][0-9]){2} /,
};

sub my_parsedate {
    my ( $option, $date ) = @_;
    defined( my $time = parsedate( $date, PREFER_PAST => 1, WHOLE => 1 ) )
      or die qq(-$option: unrecognized date format: $date\n);
    time2str( '%Y-%m-%d %X', $time );
}

my ( $From, $To );
GetOptions(
    'blocksize=i' => ( our $Blocksize = 2**18 ),
    'debug:+' => \( my $Debug = 0 ),
    'from=s' => sub { $From = &my_parsedate },
    'help|?' =>
      sub { exec perldoc => -F => $0 or die "Cannot execute perldoc: $!\n" },
    'to=s' => sub { $To = &my_parsedate },
    'follow' => \( my $Follow = 0 ),
) or exit 1;

die "No files given!\n" unless @ARGV;
die "[ $From ; $To [ is no valid timespan.\n"
  if defined $From && defined $To && $From ge $To;

sub find_file4date(\@$) {
    my ( $arrayref, $date ) = @_;
    my $a = 0;
    my $b = @$arrayref;
    while ( $a < $b ) {
        if ( $arrayref->[ my $c = ( $a + $b ) >> 1 ][1] lt $date ) {
            $a = $c + 1;
        }
        else { $b = $c }
    }
    $a;
}

sub open_file($) {
    my ($filename) = @_;
    my ( $fh, $is_seekable );
    if ( $filename =~ /\.gz\z/ ) {
        print STDERR qq(Opening "$filename" via zcat.\n) if $Debug;
        open $fh, '-|', zcat => -f => $filename
          or die qq(Cannot zcat "$filename": $!\n);
        $is_seekable = '';
    }
    elsif ( $filename =~ /\.bz2\z/ ) {
        print STDERR qq(Opening "$filename" via bzcat.\n) if $Debug;
        open $fh, '-|', bzcat => $filename
          or die qq(Cannot bzcat "$filename": $!\n);
        $is_seekable = '';
    }
    else {
        print STDERR qq(Opening "$filename".\n) if $Debug;
        open $fh, '<', $filename
          or die qq(Cannot open "$filename" for reading: $!\n);
        $is_seekable = 1;
    }
    if (wantarray) { $fh, $is_seekable }
    else           { $fh }
}

sub output_from_filehandle($;$) {
    my ( $fh, $to ) = @_;
    if ( defined $to ) {
        print STDERR qq(Processing file line by line looking for last line.\n)
          if $Debug;
        while (<$fh>) {
            last if $to lt $_ && $_ =~ RE_TIMESTAMP;

            # Workaround f?r kaputte Logzeilen, s. RT#360835
            print;
        }
    }
    else {
        print STDERR qq(Processing file blockwise.\n) if $Debug;
        local $/ = \$Blocksize;   # actually Perl read()s and writes() 4k blocks
        local $_;
        print while <$fh>;
    }
}

sub seek_to($$) {
    my ( $fh, $pos ) = @_;
    seek $fh, $pos, SEEK_SET()
      or die qq(Cannot seek to position $pos: $!\n);
}

my @files;
for (@ARGV) {
    next if -r && !-s _;
    my $fh = open_file($_);
    $fh->read( my $timestamp, LENGTH_OF_TIMESTAMP )
      or die qq(Cannot read timestamp from "$_": $!\n);
    push @files, [ $_, $timestamp ];
}
die "No files found.\n" unless @files;

@files = sort { $a->[1] cmp $b->[1] } @files;
print STDERR 'Scanned ' 
  . @files . ' file'
  . ( @files != 1 && 's' )
  . " beginning at $files[0][1].\n"
  if $Debug;


my $index_of_1st_file;
unless ( defined $From ) { $index_of_1st_file = 0 }
elsif ( $index_of_1st_file = find_file4date( @files, $From ) ) {
    --$index_of_1st_file;
    print STDERR <<_ if $Debug;
First file will be "$files[$index_of_1st_file][0]" starting at $files[$index_of_1st_file][1].
_
}
else { warn "Oldest record is from $files[0][1].\n" }

if ( $Follow ) {
    if ( defined $To ) {
        die "You cannot combine the --follow and --to options\n";
    }
    for (@files[$index_of_1st_file..$#files-1]) {
        output_from_filehandle(open_file($_->[0]));
    }
    my $last_fn = $files[-1][0];
    my $pipe_name = "tail -n +0 -f $last_fn";
    open my $LAST_FH, '-|', 'tail', '-n', '+0', '-f', $last_fn
        or die "Cannot open pipe to '$pipe_name': $!";
    # this sucks in terms of efficiency, but we cannot do a tail following
    # with a large Blocksize, and neither with unflushed STDOUT
    local $Blocksize = 1;
    $| = 1;
    output_from_filehandle($LAST_FH);
    close $LAST_FH or die "Error while closing pipe to '$pipe_name': ";
    exit;
}

my $index_of_last_file;
unless ( defined $To ) { $index_of_last_file = $#files }
elsif ( $index_of_last_file = find_file4date( @files, $To ) ) {
    --$index_of_last_file;
    print STDERR <<_ if $Debug;
Last file will be "$files[$index_of_last_file][0]" starting at $files[$index_of_last_file][1].
_
}
else {
    warn "No apropriate data.\n";
    exit;
}

if ( defined $From ) {
    my ( $fh, $is_seekable ) =
      open_file( my $filename = $files[$index_of_1st_file][0] );
    local $_;

    # bin?re Suche wegen potenziell mehrzeiligen Eintr?gen erstmal deaktiviert,
    # vgl. RT#360835:
    if ( undef && $is_seekable ) {

        print STDERR
          qq(Performing binary search for first line within "$filename".\n)
          if $Debug;

        require File::Spec;
        require FindBin;
        {
            no warnings 'once';
            push @INC, File::Spec->catfile( $FindBin::Bin, '.perllib' );
        }
        require File::SortedSeek and File::SortedSeek->import('alphabetic');
        my $save_stdout;
        if ( $Debug > 1 ) {
            $save_stdout = select STDERR or die "Cannot select STDERR: $!\n";
            File::SortedSeek::set_debug();
        }
        defined( alphabetic( $fh, $From ) )
          or die qq(Binary search within "$filename" failed: )
          . File::SortedSeek::error() . "\n";
        select $save_stdout
          or die "Cannot re-select STDOUT: $!\n"
          if $save_stdout;
    }
    else {
        print STDERR "Processing file line by line looking for first line.\n"
          if $Debug;
        while (<$fh>) {
            if ( $_ ge $From && $_ =~ RE_TIMESTAMP ) {
                print STDERR "First line found.\n" if $Debug;
                print;
                last;
            }
        }
    }
    output_from_filehandle( $fh,
        defined $To && $index_of_1st_file == $index_of_last_file ? $To : () );
}

output_from_filehandle( open_file( $files[$_][0] ) )
  for $index_of_1st_file + defined $From .. $index_of_last_file - defined $To;

output_from_filehandle( open_file( $files[$index_of_last_file][0] ), $To )
  if defined $To && $index_of_1st_file < $index_of_last_file;

__END__

=head1 NAME

feed_eximlogs - sucht die passende Zeitspanne aus exim-Protokolldateien

=head1 SYNOPSE

 feed_eximlog -from '11:00 yesterday' -to 'now -1 hour' /var/log/exim4/mainlog*

... gibt die exim-mainlog-Eintraege von gestern 11 Uhr bis vor einer Stunde aus.

=head1 BESCHREIBUNG

Das Script gibt aus einer Liste ?bergebener exim-Protokolldateien alle zum
gew?nschten Zeitraum geh?renden Eintr?ge aus.
Mit gzip gepackte Dateien werden dabei automagisch dekomprimiert.
Au?erdem werden die Dateien automagisch in eine chronologisch korrekte
Reihenfolge gebracht.

Das Script ist auf Geschwindigkeit optimiert, indem es nach M?glichkeit z. B.
bin?re Suche nutzt.
Da davon ausgegangen wird, dass es auf Mehrprozessorsystemen zum Einsatz kommt,
nutzt es zum Entpacken komprimierter Dateien ein externes zcat.

=head1 OPTIONEN

=over 4

=item -from Zeitpunkt

um den Startzeitpunkt der gew?nschten Protokollausschnitts festzulegen.
Liegt dieser vor Beginn des ?ltesten Protokolleintrags, so wird eine Warnung
ausgegeben.

Wird die Option nicht verwendet, so beginnt die Ausgabe mit dem ?ltesten
verf?gbaren Protokolleintrag.

Der Zeitpunkt muss in einem f?r L<Time::ParseDate> verst?ndlichen Format
angegeben werden.

=item -to Zeitpunkt

um den Endzeitpunkt des gew?nschten Protokollausschnitts festzulegen.
Dieser ist exklusiv, d. h. gibt man etwa C<2007-10-24> an, was
C<2007-10-24 00:00:00> impliziert, erh?lt man alle Protokolleintr?ge bis
einschlie?lich C<2007-10-23 23:59:59>.

Wird die Option nicht verwendet, so werden alle Protokolleintr?ge bis zum
letzten verf?gbaren ausgegeben.

Der Zeitpunkt muss in einem f?r L<Time::ParseDate> verst?ndlichen Format
angegeben werden.

=item -blocksize [Bytes]

zur Festlegung der Gr??e der Bl?cke, mit denen gearbeitet werden soll, sofern
Dateien blockweise verarbeitet werden k?nnen; Default: 262144.

Tats?chlich verwendet Perl intern im Zweifel trotzdem kleinere Bl?cke beim Lesen
und Schreiben von Dateien, was die Geschwindigkeit jedoch nicht ma?geblich
beeinflussen sollte, weshalb auf L<sysread()|perlfunc/sysread> verzichtet wurde.

=item -debug [Grad]

um auf der Standardfehlerausgabe zus?tzliche Informationen ?ber die T?tigkeit
des Programms zu erlangen.

Bei mehrfacher Verwendung der Option oder optionaler direkter Angabe eines
Grades >= 2 werden auch detaillierte Informationen zu etwaig durchgef?hrten
bin?ren Suchen innerhalb der ersten f?r den gew?nschten Zeitraum ma?geblichen
Protokolldatei ausgegeben.

=item -help

=item -?

um (nur) diese Dokumentation anzeigen zu lassen

=back

=head1 BEKANNTE FEHLER

=over 4

=item *

Das Script ist nicht Y10k-f?hig.

=back

=head1 AUTOR

 Martin H. Sluka <fany@noris.net>
 f?r die noris network AG
