package Pisg::Parser::Logfile; use strict; $^W = 1; my ($conf, $debug, $parser); sub new { # The sole argument is the config hash my $self = shift; $conf = shift; $debug = shift; # Load the Common module from wherever it's configured to be. push(@INC, $conf->{modules_dir}); require Pisg::Common; Pisg::Common->import(); # Pick our parser. $parser = choose_log_format($conf->{format}); return bless {}; } # The function to choose which module to use. sub choose_log_format { my $format = shift; my $parser = undef; $debug->("Loading module for log format $format"); eval <<_END; use lib '$conf->{modules_dir}'; use Pisg::Parser::Format::$format; \$parser = new Pisg::Parser::Format::$format(\$debug); _END if ($@) { print STDERR "Could not load parser for '$format': $@\n"; return undef; } return $parser; } sub analyze { my (%stats, %lines); if (defined $parser) { my $starttime = time(); if ($conf->{logdir}) { # Run through all files in dir parse_dir(\%stats, \%lines); } else { # Run through the whole logfile my %state = ( linecount => 0, lastnick => "", monocount => 0, lastnormal => "", oldtime => 24 ); parse_file(\%stats, \%lines, $conf->{logfile}, \%state); } pick_random_lines(\%stats, \%lines); my ($sec,$min,$hour) = gmtime(time() - $starttime); $stats{processtime} = sprintf("%02d hours, %02d minutes and %02d seconds", $hour, $min, $sec); print "Channel analyzed succesfully in $stats{processtime} on ", scalar localtime(time()), "\n";; return \%stats; } else { print STDERR "Skipping channel '$conf->{channel}' due to lack of parser.\n"; return undef } # Shouldn't get here. return undef; } sub parse_dir { my ($stats, $lines) = @_; # Add trailing slash when it's not there.. $conf->{logdir} =~ s/([^\/])$/$1\//; print "Going into $conf->{logdir} and parsing all files there...\n\n"; my @filesarray; opendir(LOGDIR, $conf->{logdir}) or die("Can't opendir $conf->{logdir}: $!"); @filesarray = grep { /^[^\.]/ && /^$conf->{prefix}/ && -f "$conf->{logdir}/$_" } readdir(LOGDIR) or die("No files in \"$conf->{logdir}\" matched prefix \"$conf->{prefix}\""); closedir(LOGDIR); my %state = ( lastnick => "", monocount => 0, oldtime => 24 ); foreach my $file (sort @filesarray) { $file = $conf->{logdir} . $file; parse_file($stats, $lines, $file, \%state); } } # This parses the file... sub parse_file { my ($stats, $lines, $file, $state) = @_; print "Analyzing log($file) in '$conf->{format}' format...\n"; if ($file =~ /.bz2?$/ && -f $file) { open (LOGFILE, "bunzip2 -c $file |") or die("$0: Unable to open logfile($file): $!\n"); } elsif ($file =~ /.gz$/ && -f $file) { open (LOGFILE, "gunzip -c $file |") or die("$0: Unable to open logfile($file): $!\n"); } else { open (LOGFILE, $file) or die("$0: Unable to open logfile($file): $!\n"); } my $linecount = 0; my $lastnormal = ""; my $repeated; $stats->{days} = 0; $stats->{totallines} = 0; while(my $line = ) { $line = strip_mirccodes($line); $linecount++; my $hashref; # Match normal lines. if ($hashref = $parser->normalline($line, $linecount)) { if (defined $hashref->{repeated}) { $repeated = $hashref->{repeated}; } else { $repeated = 0; } my ($hour, $nick, $saying, $i); for ($i = 0; $i <= $repeated; $i++) { if ($i > 0) { $hashref = $parser->normalline($lastnormal, $linecount); #Increment number of lines for repeated lines $linecount++; } $hour = $hashref->{hour}; $nick = find_alias($hashref->{nick}); $saying = $hashref->{saying}; if ($hour < $state->{oldtime}) { $stats->{days}++ } $state->{oldtime} = $hour; unless (is_ignored($nick)) { $stats->{totallines}++; # Timestamp collecting $stats->{times}{$hour}++; $stats->{lines}{$nick}++; $stats->{line_times}{$nick}[int($hour/6)]++; # Count up monologues if ($state->{lastnick} eq $nick) { $state->{monocount}++; if ($state->{monocount} == 5) { $stats->{monologues}{$nick}++; } } else { $state->{monocount} = 0; } $state->{lastnick} = $nick; my $len = length($saying); if ($len > $conf->{minquote} && $len < $conf->{maxquote}) { push @{ $lines->{sayings}{$nick} }, $saying; } $stats->{lengths}{$nick} += $len; $stats->{questions}{$nick}++ if ($saying =~ /\?/); $stats->{shouts}{$nick}++ if ($saying =~ /!/); if ($saying !~ /[a-z]/ && $saying =~ /[A-Z]/) { $stats->{allcaps}{$nick}++; push @{ $lines->{allcaplines}{$nick} }, $line; } $stats->{foul}{$nick}++ if ($saying =~ /$conf->{foul}/i); # Who smiles the most? # A regex matching al lot of smilies $stats->{smiles}{$nick}++ if ($saying =~ /[8;:=][ ^-o]?[)pPD}\]>]/); if ($saying =~ /[8;:=][ ^-]?[\(\[\\\/{]/ and $saying !~ /\w+:\/\//) { $stats->{frowns}{$nick}++; } if (my $url = match_url($saying)) { $stats->{urlcounts}{$url}++; $stats->{urlnicks}{$url} = $nick; } parse_words($stats, $saying, $nick); } } $lastnormal = $line; $repeated = 0; } # Match action lines. elsif ($hashref = $parser->actionline($line, $linecount)) { $stats->{totallines}++; my ($hour, $nick, $saying); $hour = $hashref->{hour}; $nick = find_alias($hashref->{nick}); $saying = $hashref->{saying}; if ($hour < $state->{oldtime}) { $stats->{days}++ } $state->{oldtime} = $hour; unless (is_ignored($nick)) { # Timestamp collecting $stats->{times}{$hour}++; $stats->{actions}{$nick}++; push @{ $lines->{actionlines}{$nick} }, $line; $stats->{lines}{$nick}++; $stats->{line_times}{$nick}[int($hour/6)]++; if ($saying =~ /^($conf->{violent}) (\S+)/) { my $victim = find_alias($2); $stats->{violence}{$nick}++; $stats->{attacked}{$victim}++; push @{ $lines->{violencelines}{$nick} }, $line; push @{ $lines->{attackedlines}{$victim} }, $line; } my $len = length($saying); $stats->{lengths}{$nick} += $len; parse_words($stats, $saying, $nick); } } # Match *** lines. elsif (($hashref = $parser->thirdline($line, $linecount)) and $hashref->{nick}) { $stats->{totallines}++; my ($hour, $min, $nick, $kicker, $newtopic, $newmode, $newjoin); my ($newnick); $hour = $hashref->{hour}; $min = $hashref->{min}; $nick = find_alias($hashref->{nick}); $kicker = find_alias($hashref->{kicker}) if ($hashref->{kicker}); $newtopic = $hashref->{newtopic}; $newmode = $hashref->{newmode}; $newjoin = $hashref->{newjoin}; $newnick = $hashref->{newnick}; if ($hour < $state->{oldtime}) { $stats->{days}++ } $state->{oldtime} = $hour; unless (is_ignored($nick)) { # Timestamp collecting $stats->{times}{$hour}++; if (defined($kicker)) { $stats->{kicked}{$kicker}++; $stats->{gotkicked}{$nick}++; push @{ $lines->{kicklines}{$nick} }, $line; } elsif (defined($newtopic)) { unless ($newtopic eq '') { my $tcount; if (defined $stats->{topics}) { $tcount = @{ $stats->{topics} }; } else { $tcount = 0; } $stats->{topics}[$tcount]{topic} = $newtopic; $stats->{topics}[$tcount]{nick} = $nick; $stats->{topics}[$tcount]{hour} = $hour; $stats->{topics}[$tcount]{min} = $min; } } elsif (defined($newmode)) { my @opchange = opchanges($newmode); $stats->{gaveops}{$nick} += $opchange[0] if $opchange[0]; $stats->{tookops}{$nick} += $opchange[1] if $opchange[1]; } elsif (defined($newjoin)) { $stats->{joins}{$nick}++; } elsif (defined($newnick) and ($conf->{nicktracking} == 1)) { add_alias($nick, $newnick); } } } } close(LOGFILE); print "Finished analyzing log, $stats->{days} days total.\n"; } sub opchanges { my (@ops, $plus); foreach (split(//, $_[0])) { if ($_ eq "o") { $ops[$plus]++; } elsif ($_ eq "+") { $plus = 0; } elsif ($_ eq "-") { $plus = 1; } } return @ops; } sub parse_words { my ($stats, $saying, $nick) = @_; foreach my $word (split(/[\s,!?.:;)(\"]+/, $saying)) { $stats->{words}{$nick}++; # remove uninteresting words next unless (length($word) >= $conf->{wordlength}); next if ($conf->{ignoreword}{$word}); # ignore contractions next if ($word =~ m/'..?$/);#' # Also ignore stuff from URLs. next if ($word =~ m{https?|^//}); $stats->{wordcounts}{$word}++; $stats->{wordnicks}{$word} = $nick; } } sub pick_random_lines { my ($stats, $lines) = @_; foreach my $key (keys %{ $lines }) { foreach my $nick (keys %{ $lines->{$key} }) { $stats->{$key}{$nick} = @{ $lines->{$key}{$nick} }[rand@{ $lines->{$key}{$nick} }]; } } } sub strip_mirccodes { my $line = shift; # boldcode = chr(2) = oct 001 # colorcode = chr(3) = oct 003 # plaincode = chr(15) = oct 017 # reversecode = chr(22) = oct 026 # underlinecode = chr(31) = oct 037 # Strip mIRC color codes $line =~ s/\003\d{1,2},\d{1,2}//go; $line =~ s/\003\d{0,2}//go; # Strip mIRC bold, plain, reverse and underline codes $line =~ s/[\002\017\026\037]//go; return $line; } 1;