package Onis::Parser; use strict; use warnings; use Exporter; use Onis::Config qw#get_config#; use Onis::Data::Core qw#nick_rename store#; use Onis::Parser::Persistent qw/set_absolute_time get_absolute_time add_relative_time get_state/; @Onis::Parser::EXPORT_OK = qw/parse last_date/; @Onis::Parser::ISA = ('Exporter'); our $WORD_LENGTH = 5; our $mynick = 'unknown'; if (get_config ('min_word_length')) { my $tmp = get_config ('min_word_length'); $tmp =~ s/\D//g; $WORD_LENGTH = $tmp if ($tmp); } my $VERSION = '$Id: Dancer.pm,v 1.2 2003/12/16 08:39:47 octo Exp $'; print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG); return (1); sub parse { my $line = shift; my $state; # --- Log for 08.11.103 Server: irc1.us.ircnet.net Channel: #beginner if ($line =~ m/^--- Log for (\d\d)\.(\d\d)\.(\d\d+)/) { my $day = $1; my $month = $2; my $year = $3; $month--; if ($year < 1900) { $year += 1900; } set_absolute_time ($year, $month, $day, 0, 0); } # --- Nick: @vodklemon Version: Dancer V4.16p1 Started: 9 hours and 6 minutes ago elsif ($line =~ m/^--- Nick: [+@]?(\S+)/) { $mynick = $1; } elsif ($line =~ m/^(\d\d)\.(\d\d)\.\d\d /) { add_relative_time ($1, $2); } $state = get_state (); if ($state != 1) { return ($state); } # Normal line and action if ($line =~ /^(\d\d)\.(\d\d)\.\d\d # \s+/) { my $rest_of_line = $'; # $POSTMATCH my $data = { hour => $1, minute => $2, }; if ($rest_of_line = m/<([^>]+)> (.+)/) { $data->{'nick'} = $1; $data->{'text'} = $2; $data->{'type'} = 'TEXT'; } elsif ($rest_of_line = m/\* (\S+) (.+)/) { $data->{'nick'} = $1; $data->{'text'} = $2; $data->{'type'} = 'ACTION'; } if (defined ($data->{'text'})) { my @words = grep { length ($_) >= $WORD_LENGTH } (split (m/\W+/, $data->{'text'})); $data->{'words'} = \@words; store ($data); } } # 00.09.01 Join Hotstud [10] (bleh@out.of.battery.cx) # 00.18.43 Join lanitya [0] (-United_sp@202.152.240.79) elsif ($line =~ /^(\d\d)\.(\d\d)\.\d\d Join (\S+) \[\d+\] \(([^\)]+)\)/) { my $data = { hour => $1, minute => $2, nick => $3, host => $4, type => 'JOIN' }; store ($data); } # 00.19.02 Mode "#beginner +o Hotstud " by Retro (bleh@212.83.102.202) # 12.59.52 Mode "#Beginner +bb *!*pepeto@168.221.143.* *!*@203.89.159.* " by huba.irc.pl elsif ($line =~ /^(\d\d)\.(\d\d)\.\d\d Mode "([#!+&]\S+) ([-+][^"]+)" by (\S+) \(([^\)]+)\)/) { my $data = { hour => $1, minute => $2, channel => $3, mode => $4, nick => $5, host => $6, type => 'MODE' }; store ($data); } # 16.50.56 Nick pokinwan is now known as rickson (pokinwan@dial81-131-213-24.in-addr.btopenworld.com) # 16.55.52 Nick blasmoke is now known as blascoke (bleh@huma.la) elsif ($line =~ /^(\d\d)\.(\d\d)\.\d\d Nick (\S+) is now known as (\S+) \(([^\)]+)\)/) { nick_rename ($3, $4); } # 08.20.16 Topic "IRC help (NO warez/mp3/serials info). Try #casual and #chataway too! English ple" by Glucose (crumsh@go.away.thats.my.girlfri3nd.de) elsif ($line =~ /^(\d\d)\.(\d\d)\.\d\d Topic "(.+)" by (\S+) \(([^\)]+)\)/) { my $data = { hour => $1, minute => $2, text => $3, nick => $4, host => $5, type => 'TOPIC' }; store ($data); } # 12.19.49 Quit Rigpa (If it is a man made world, why can't we remake it?) # 12.20.02 Quit Z0RGLUB (Ping timeout) elsif ($line =~ /^(\d\d)\.(\d\d)\.\d\d Quit (\S+) \((.*)\)/) { my $data = { hour => $1, minute => $2, nick => $3, text => $4, type => 'QUIT' }; store ($data); } # 09.57.56 Part Gal24 (Gal24) # 09.57.59 Part Hotstud ((Cycling for Onjoins)) elsif ($line =~ /^(\d\d)\.(\d\d)\.\d\d Part (\S+) \((.*)\)/) { my $data = { hour => $1, minute => $2, nick => $3, text => $4, type => 'LEAVE' }; store ($data); } # 04.09.33 Kick (#beginner Neepu :abuse.. onjoin MESSAGES prohibited) by Hotstud!bleh@out.of.battery.cx # 04.26.19 Kick (#beginner Jamez :You are banned) by Glucose!crumsh@go.away.thats.my.girlfri3nd.de elsif ($line =~ /^(\d\d)\.(\d\d)\.\d\d Kick \(([#!+&]\S+) (\S+) :(.+)\) by ([^!]+)!(.+)/) { my $data = { hour => $1, minute => $2, channel => $3, nick_received => $4, text => $5, nick => $6, host => $7, type => 'KICK' }; store ($data); } # 16.01.45 NJoin blascoke [1337] (bloh@ipv6.registered.domain.name) # 16.01.45 NJoin Quo-fan [0] (quo@soq.status-quo.wox.org) elsif ($line =~ /^(\d\d)\.(\d\d)\.\d\d NJoin (\S+) \[\d+\] \(([^\)]+)\)/) { my $data = { hour => $1, minute => $2, nick => $3, host => $4, type => 'NETSPLIT_JOIN' }; store ($data); } else { print STDERR $/, __FILE__, ": Not parsed: ``$line''" if ($::DEBUG & 0x20); return (2); } return (1); } sub last_date { my $time = get_absolute_time (); my ($sec, $min, $hour, $day, $month, $year) = (localtime ($time))[0 .. 5]; $year += 1900; $month++; my $retval = sprintf ("--- Log for %02u.%02u.%04u\n", $day, $month, $year); return ($retval); }