I have a utility I use to wrap logging lines and make them easier to look
at. It has different features than you want but down in the core might be
a few clues of some use.
Without options it generates output like the below:
$ wrap /var/log/mail.log
Aug 23 10:39:52 crf3333 postfix/pickup[12668]: 1B311848F4: uid=999
from=<netdata>
Aug 23 10:39:52 crf3333 postfix/cleanup[17631]: 1B311848F4:
message-id=<20170823163952.1b31184...@crf3333.b.comcast.net>
Aug 23 10:39:52 crf3333 postfix/qmgr[1603]: 1B311848F4:
from=<netd...@crf3333.b.comcast.net>, size=8375, nrcpt=1 (queue
active)
Aug 23 10:39:52 crf3333 postfix/local[17635]: 1B311848F4:
to=<r...@crf3333.b.comcast.net>, orig_to=<root>, relay=local,
delay=0.1, delays=0.07/0/0/0.03, dsn=2.0.0, status=sent (delivered
to mailbox)
Aug 23 10:39:52 crf3333 postfix/qmgr[1603]: 1B311848F4: removed
See pasted code below the cut line:
---8<-------------8<----------
#!/usr/bin/env perl
use Modern::Perl;
use Text::Wrap 'wrap';
use Term::ANSIColor;
use Getopt::Long;
my @fg = qw(
BLACK RED GREEN YELLOW
BLUE MAGENTA CYAN WHITE
BRIGHT_BLACK BRIGHT_RED BRIGHT_GREEN BRIGHT_YELLOW
BRIGHT_BLUE BRIGHT_MAGENTA BRIGHT_CYAN BRIGHT_WHITE
);
my @bg = qw(
ON_BLACK ON_RED ON_GREEN ON_YELLOW
ON_BLUE ON_MAGENTA ON_CYAN ON_WHITE
ON_BRIGHT_BLACK ON_BRIGHT_RED ON_BRIGHT_GREEN ON_BRIGHT_YELLOW
ON_BRIGHT_BLUE ON_BRIGHT_MAGENTA ON_BRIGHT_CYAN ON_BRIGHT_WHITE
);
my @standout_color = (
'BLACK ON_YELLOW',
'BLACK ON_RED',
'BLACK ON_GREEN',
'BLACK ON_BRIGHT_RED',
'BLACK ON_BRIGHT_YELLOW',
'RED ON_BRIGHT_GREEN',
'GREEN ON_BLACK',
'RED ON_BRIGHT_CYAN',
'WHITE ON_BLACK',
'WHITE ON_RED',
'WHITE ON_MAGENTA',
'BRIGHT_WHITE ON_RED',
'BRIGHT_WHITE ON_BLUE',
'BRIGHT_WHITE ON_CYAN',
'BRIGHT_WHITE ON_MAGENTA',
'BRIGHT_WHITE ON_CYAN',
);
my %opt;
GetOptions (\%opt,
'demo+' => sub{ demo(); exit 1},
map{ sprintf('%s|%s=s', $_, lc($_))} @fg, @bg,
) or die "bad options";
sub colorize {
my $color = shift;
my $text = shift;
return $text unless $opt{$color};
my $re = qr($opt{$color});
return $text =~ s/($re)/color($color).$1.color('RESET')/egr;
}
my %seen;
while (<>) {
chomp $_;
my $t = wrap("", "\t", $_);
$t = colorize($_, $t) for (@fg, @bg);
say $t;
}
sub demo {
for my $f (@fg) {
for my $b (@bg) {
say color($f).color($b).$f.' '.$b.color('RESET');
}
}
}
On Tue, Aug 22, 2017 at 5:11 PM, Harry Putnam <rea...@newsguy.com> wrote:
> rea...@newsguy.com (Harry Putnam) writes:
>
> > So trying to simplify things I'm running the script against 3 log
> > lines produced by sendmail. The 3 lines below are in a file named
> > `mail-loglines'.
>
> Instead of simplifying I made a mess of things... I left this line at
> the bottom of the script:
>
> __DATA__
>
> I meant to comment it out, and even had some log lines at the
> bottom.. couldn't have botched it any worse. But wait, oh yes I could.
>
>
> Now in the course of pawing thru this tiny script enough times, I
> finally discovered the main problem:
>
> This line:
> print wrap('','', $line);
>
> Should contain Two single quotes on each side of the first comma.
>
> Instead I managed to put a single double quote in each spot.
>
> print wrap(",", $line); wrong
>
> print wrap('','', $line); right
>
> With that correction the script acts like it should:
>
> ------- ------- ---=--- ------- -------
>
> linewrp 'Aug' ./mail-loglines
>
> Aug 13 19:59:10 u0 postfix/smtp[7922]: 1993C180CB9:
> to=<hp...@fastmail.fm>, relay=smtp.fastmail.com[66.111.4.139]:587,
> delay=0.7, delays=0.15/0.08/0.35/0.11, dsn=2.0.0, status=sent (250
> 2.0.0 Ok: queued as 7240B7F986)
>
> Aug 13 19:59:10 u0 postfix/cleanup[7920]: B5619180CBB:
>
> Aug 13 19:59:11 u0 spamd[831]: spamd: result: . 0 -
> DKIM_ADSP_NXDOMAIN,NO_RELAYS
> scantime=0.3,size=2008,user=reader,uid=1000,required_score=5.0,rhos
> t=localhost,raddr=::1,rport=56648,mid=<20170813235910.B5619180CBB@u
> 1>,autolearn=no autolearn_force=no
>
> ------- ------- ---=--- ------- -------
>
> It is embarassing, but also a waste of your time, and for that I do
> apologize.
>
> --
> To unsubscribe, e-mail: beginners-unsubscr...@perl.org
> For additional commands, e-mail: beginners-h...@perl.org
> http://learn.perl.org/
>
>
>
