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 %MONTHNAMES @MONTHNUMS/;
@Onis::Parser::EXPORT_OK = qw/parse last_date/;
@Onis::Parser::ISA = ('Exporter');
our $WORD_LENGTH = 5;
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: Xchat.pm,v 1.2 2003/12/16 09:22:28 octo Exp $';
print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);
return (1);
sub parse
{
my $line = shift;
my $state;
my $hour;
my $min;
my $line_type;
my $parsed = 0;
if ($line =~ m/^\*\*\*\* (?:BEGIN|ENDING) LOGGING AT \w\w\w (\w\w\w) ?(\d\d?) (\d\d):(\d\d):(\d\d) (\d{4})/)
{
if (!defined ($MONTHNAMES{$1})) { return (4); }
$hour = $3;
$min = $4;
set_absolute_time ($6, $MONTHNAMES{$1}, $2, $3, $4, $5);
}
elsif ($line =~ m/^(\w\w\w) ?(\d\d?) (\d\d):(\d\d):(\d\d) /)
{
$hour = $3;
$min = $4;
add_relative_time ($hour, $min);
}
else
{
return (2);
}
$state = get_state ();
if ($state != 1)
{
return ($state);
}
{
my ($pre, $post) = split (m/\t/, $line, 2);
$line_type = substr ($pre, 16);
$line = $post;
}
if ($line_type eq '-->')
{
if ($line =~ m/^(\S+) \(([^\)]+)\) has joined ([#!+&]\S+)/)
{
my $data =
{
hour => $hour,
minute => $min,
nick => $1,
host => $2,
channel => $3,
type => 'JOIN'
};
store ($data);
$parsed = 1;
}
}
elsif ($line_type eq '<--')
{
if ($line =~ m/^(\S+) has quit \((.*)\)/)
{
my $data =
{
hour => $hour,
minute => $min,
nick => $1,
text => $2,
type => 'JOIN'
};
store ($data);
$parsed = 1;
}
elsif ($line =~ m/^(\S+) \(([^\)]+)\) has left ([#!+&]\S+) \((.*)\)/)
{
my $data =
{
hour => $hour,
minute => $min,
nick => $1,
host => $2,
channel => $3,
text => $4,
type => 'LEAVE'
};
store ($data);
$parsed = 1;
}
elsif ($line =~ m/^(\S+) has kicked (\S+) from ([#!+&]\S+) \((.*)\)/)
{
my $data =
{
hour => $hour,
minute => $min,
nick => $1,
nick_received => $2,
channel => $3,
text => $4,
type => 'KICK'
};
store ($data);
$parsed = 1;
}
}
elsif ($line_type eq '---')
{
if ($line =~ m/^(\S+) is now known as (\S+)/)
{
nick_rename ($1, $2);
$parsed = 1;
}
elsif ($line =~ m/^(\S+) (gives|removes) channel operator status to (\S+)/)
{
my $mode = ($2 eq 'gives' ? '+' : '-') . "o $3";
my $data =
{
hour => $hour,
minute => $min,
nick => $1,
mode => $mode,
type => 'MODE'
};
store ($data);
$parsed = 1;
}
elsif ($line =~ m/^(\S+) has changed the topic to: (.+)/)
{
my $data =
{
hour => $hour,
minute => $min,
nick => $1,
text => $2,
type => 'TOPIC'
};
store ($data);
$parsed = 1;
}
}
elsif ($line_type eq '*')
{
if ($line =~ m/^(\S+) (.+)/)
{
my @words = grep { length ($_) >= $WORD_LENGTH } (split (m/\W+/, $2));
my $data =
{
hour => $hour,
minute => $min,
nick => $1,
text => "* $1 $2",
words => \@words,
type => 'ACTION'
};
store ($data);
$parsed = 1;
}
}
elsif ($line_type =~ m/^<([^>]+)>$/)
{
my @words = grep { length ($_) >= $WORD_LENGTH } (split (m/\W+/, $line));
my $data =
{
hour => $hour,
minute => $min,
nick => $1,
text => $line,
words => \@words,
type => 'TEXT'
};
store ($data);
$parsed = 1;
}
if (!$parsed and ($::DEBUG & 0x20))
{
print STDERR $/, __FILE__, ": Not parsed: ``$line''";
return (2);
}
return (1);
}
sub last_date
{
my $time = get_absolute_time ();
my ($sec, $min, $hour, $day, $month_num, $year) = (localtime ($time))[0 .. 5];
my $month_name = $MONTHNUMS[$month_num];
$year += 1900;
my $retval = sprintf ("**** BEGIN LOGGING AT xxx %s %02u %02u:%02u:%02u %04u\n",
$month_name, $day, $hour, $min, $sec, $year);
return ($retval);
}
syntax highlighted by Code2HTML, v. 0.9.1