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); }