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);
}
syntax highlighted by Code2HTML, v. 0.9.1