in reply to Re^3: adaptive syslog message parsing
in thread adaptive syslog message parsing

I've performed a little data cleansing before adding lines - omitting empty lines seems to be the main fix! I also changed from using undef to '' in the diff code (Algorithm::Diff seemed unhappy with undefs) and tidied up the output a little.

use strict; use warnings; use Algorithm::Diff; my $digest = bless {root => {}, maxLevel => 3}; while (<DATA>) { chomp; next unless length; $digest->add ($_); } $digest->mergeTails (); $digest->print (); sub add { my ($self, $line, $level, $context) = @_; $level ||= 1; $context ||= $self->{root}; if ($level == $self->{maxLevel} or $line !~ s/(\S*?)\s*\W\s+//) { push @{$context->{tails}}, [$line =~ /(\S+)/g]; return; } my $prefix = $1; $context->{$prefix} ||= {}; $context = $context->{$prefix}; $self->add ($line, 1 + $level, $context); } sub mergeTails { my ($self, $context) = @_; $context ||= $self->{root}; unless (exists $context->{tails}) { $self->mergeTails ($context->{$_}) for keys %$context; return; } my @tails = sort {length $a <=> length $b} @{$context->{tails}}; my @groups; push @{$groups[@$_]}, $_ for @tails; @groups = grep {defined $_} @groups; for my $group (@groups) { my @ref = grep {length} @{$group->[-1]}; my @org = @ref; my $count = 1; pop @$group; while (@$group) { my @new = @{pop @$group}; my @diffs = Algorithm::Diff::diff (\@ref, \@new); for my $change (@diffs) { next unless $change->[0][0] eq '-'; $ref[$change->[0][1]] = ''; } ++$count; } for (0 .. $#ref) { next if length $ref[$_]; $org[$_] = '*****'; } push @{$context->{digest}}, [join (' ', @org), $count]; } } sub print { my ($self, $context, $indent) = @_; $context ||= $self->{root}; $indent ||= ''; if (exists $context->{digest}) { print "$indent($_->[1]) \t$_->[0]\n" for sort {$a->[0] cmp $b->[0]} @{$context->{digest}}; return; } for (sort keys %$context) { print "$indent$_\n"; $self->print ($context->{$_}, $indent . ' '); } } __DATA__

Given the large data set prints in part:

... mail1-out.nyc.domain.com ntpd (169) ***** Bad file descriptor postfix/smtp (2) warning: malformed domain name in resource data of MX +record for ***** (32) warning: no MX host for ***** has a valid address rec +ord (18) warning: numeric domain name in resource data of MX r +ecord for ***** 127.0.1.50 (2) warning: valid_hostname: empty hostname postfix/smtpd (7) warning: Illegal address syntax from ***** in RCPT com +mand: <jane@lulu.co $> sm-mta (2) ***** SYSERR(root): ***** config error: mail loops bac +k to me (MX problem?) syslog-ng (1) Changing permissions on special file /dev/console ... mail2-out.nyc.domain.com ntpd (168) ***** Bad file descriptor postfix/smtp (2) warning: malformed domain name in resource data of MX +record for ***** (25) warning: numeric domain name in resource data of MX r +ecord for ***** 10.0.0.2 (2) warning: valid_hostname: empty hostname sm-mta (1) l55DmFcQ022740: SYSERR(root): localhost.fabulous.com. +config error: mail loops back to me (MX problem?) syslog-ng (1) Changing permissions on special file /dev/console mail2-out.sfc.domain.com postfix/smtp (61) warning: malformed domain name in resource data of MX + record for ***** (1) warning: no MX host for epm.net has a valid address re +cord (61) warning: valid_hostname: empty hostname

DWIM is Perl's answer to Gödel