#!/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' => ( my $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 },
) 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 fr 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" }

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 $_;

    # binre Suche wegen potenziell mehrzeiligen Eintrgen 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-Eintrge von gestern 11 Uhr bis vor einer Stunde aus.

=head1 BESCHREIBUNG

Das Script gibt aus einer Liste bergebener exim-Protokolldateien alle zum
gewnschten Zeitraum gehrenden Eintrge aus.
Mit gzip gepackte Dateien werden dabei automagisch dekomprimiert.
Auerdem werden die Dateien automagisch in eine chronologisch korrekte
Reihenfolge gebracht.

Das Script ist auf Geschwindigkeit optimiert, indem es nach Mglichkeit z. B.
binre 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 gewnschten 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
verfgbaren Protokolleintrag.

Der Zeitpunkt muss in einem fr L<Time::ParseDate> verstndlichen Format
angegeben werden.

=item -to Zeitpunkt

um den Endzeitpunkt des gewnschten Protokollausschnitts festzulegen.
Dieser ist exklusiv, d. h. gibt man etwa C<2007-10-24> an, was
C<2007-10-24 00:00:00> impliziert, erhlt man alle Protokolleintrge bis
einschlielich C<2007-10-23 23:59:59>.

Wird die Option nicht verwendet, so werden alle Protokolleintrge bis zum
letzten verfgbaren ausgegeben.

Der Zeitpunkt muss in einem fr L<Time::ParseDate> verstndlichen Format
angegeben werden.

=item -blocksize [Bytes]

zur Festlegung der Gre der Blcke, mit denen gearbeitet werden soll, sofern
Dateien blockweise verarbeitet werden knnen; Default: 262144.

Tatschlich verwendet Perl intern im Zweifel trotzdem kleinere Blcke beim Lesen
und Schreiben von Dateien, was die Geschwindigkeit jedoch nicht mageblich
beeinflussen sollte, weshalb auf L<sysread()|perlfunc/sysread> verzichtet wurde.

=item -debug [Grad]

um auf der Standardfehlerausgabe zustzliche Informationen ber die Ttigkeit
des Programms zu erlangen.

Bei mehrfacher Verwendung der Option oder optionaler direkter Angabe eines
Grades >= 2 werden auch detaillierte Informationen zu etwaig durchgefhrten
binren Suchen innerhalb der ersten fr den gewnschten Zeitraum mageblichen
Protokolldatei ausgegeben.

=item -help

=item -?

um (nur) diese Dokumentation anzeigen zu lassen

=back

=head1 BEKANNTE FEHLER

=over 4

=item *

Das Script ist nicht Y10k-fhig.

=back

=head1 AUTOR

 Martin H. Sluka <fany@noris.net>
 fr die noris network AG
