--- /dev/null
+#!/usr/bin/perl
+#
+# I have finally got sick of typing something like:
+#
+# tail -f logs/debug/2014/0623.log | grep -i mdip | grep -vi p[io]ng
+#
+# Do a tail -f of one of the current day's log files, the default is 'debug' but
+# one can follow any of the others by putting enough of the directory
+# as an argument so that it can find it eg:
+#
+# logf [perl regex] ...
+# logf sys [perl regex] ...
+# logf -100 [dir] [perl regex] ...
+#
+# NOTE: You can have many regexes and they all have to match (an implied '&&')
+# NOTE: Also you preceed any regex with the '!' character to indicate negation (like "| grep -v regex")
+#
+# logf udpr - yields all udpr messages
+# logf \!udpr - yields everything except udpr messages. Note the shell escape character
+# logf udpr ping - yields udpr ping messages
+# logf udpr \!p[io]ng - yields all udpr messages that aren't pings
+#
+# Copyright (c) 2014 Dirk Koopman, Tobit Computer Co Ltd
+#
+
+use strict;
+use IO::Handle;
+use IO::Select;
+use File::Basename;
+use Cwd;
+
+my $me = fileparse($0);
+my $cwd = fileparse(getcwd);
+
+my $base = "logs";
+my $ofn;
+
+if (@ARGV[0] =~ /^-[\?h]/) {
+ print "usage: $0 [-<count>] [<directory name fragment>] [<regex>]\n";
+ print " e.g: $0\n";
+ print " $0 deb\n";
+ print " $0 -100 cdr\n";
+ print " $0 udpr\n";
+ print " $0 sys tcp\n";
+ print "\n any regexes are caseless\n\n";
+ print "default: $0 -40 debug\n";
+
+ exit(0);
+}
+
+my $lines = shift if ($ARGV[0] =~ /\-\d+/);
+$lines ||= -40;
+
+my $sort = shift || "debug";
+my @dirs;
+my $end;
+
+opendir(my $dh, $base) or die "cannot open log directory '$base' ($!)";
+@dirs = grep {!/^\./} readdir($dh);
+closedir $dh;
+
+my @pattern;
+my ($dir) = grep {/^$sort/} @dirs;
+if ($dir) {
+ @pattern = @ARGV;
+} else {
+ @pattern = ($sort, @ARGV);
+ $dir = "debug";
+}
+
+my $s = IO::Select->new;
+$s->add(\*STDIN);
+autoflush STDIN, 0;
+autoflush STDOUT, 0;
+
+$SIG{TERM} = $SIG{INT} = sub {++$end};
+
+while (!$end) {
+ my $fn;
+ my ($dd,$mm,$yy) = (gmtime)[3,4,5];
+ ++$mm;
+ $yy += 1900;
+
+ my $fn = sprintf "$base/$dir/%04d/%02d%02d", $yy, $mm, $dd;
+ if (-e "$fn.log") {
+ $fn = "$fn.log";
+ } elsif (-e "$fn.csv") {
+ $fn = "$fn.csv";
+ } else {
+ if ($fn ne $ofn) {
+ print "Waiting for $fn to appear...\n";
+ STDOUT->flush;
+ $ofn = $fn;
+ }
+ sleep 1;
+ next;
+ }
+
+ my $state = 1;
+
+ # open the file, seek to the end, then seek backward from the end a bit and start reading
+ # but ignore the first line 'cos it will be incomplete.
+ open I, $fn or die "cannot open $fn ($!)\n";
+ seek(I, 0, 2);
+ my $pos = tell(I);
+ if ($pos <= int(abs($lines * 80))) {
+ seek(I, 0, 0);
+ } else {
+ seek(I, $pos + ($lines * 80), 0); # remember lines is (-)ve
+ }
+
+ my $buf; # input overflow buffer
+ my $count;
+ while (!$end) {
+
+ if ($state) {
+ my $l = <I>;
+ if (defined $l) {
+ if ($l =~ /\cJ$/) {
+ my $s = "$buf$l";
+ if (@pattern) {
+ unless (match($s)) {
+ $buf = '';
+ next;
+ }
+ }
+ print $s;
+ $buf = '';
+ next;
+ } else {
+ $buf .= $l;
+ }
+ }
+ $count = 0;
+ }
+
+ if (wait_for_stdin(0.1)) {
+ $state ^= 1;
+ print $state ? "\nRunning..." : "\nStopped...";
+ }
+ seek(I, 0, 1);
+ STDOUT->flush;
+
+ # runout any stored stuff if we haven't seen anything recently
+ if ($state && length $buf && ++$count > 2) {
+ if (@pattern) {
+ print $buf if match($buf);scalar @pattern == grep $buf =~ m{$_}i, @pattern;
+ } else {
+ print $buf;
+ }
+# print " *** XTRA! ***";
+ $buf = '';
+ }
+
+ # move onto the next file if we roll over midnight
+ my ($d) = (gmtime)[3];
+ last if ($d != $dd);
+ }
+ close I;
+}
+
+sub match
+{
+ my $count = 0;
+ foreach my $p (@pattern) {
+ if ($p =~ /^!/) {
+ my $r = substr $p, 1;
+ last if $_[0] =~ m{$r}i;
+ } else {
+ last unless $_[0] =~ m{$p}i;
+ }
+ ++$count;
+ }
+ return $count == @pattern;
+}
+
+sub wait_for_stdin
+{
+ my $t = shift;
+ if ($s->can_read($t)) {
+ my $l = <STDIN>;
+ if ($l =~ /^q/i) {
+ print "\n";
+ exit(0);
+ }
+ return 1;
+ }
+ return 0;
+}
+
+exit(0);
+
+