| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110 |
- package Pisg::Parser::Format::muh2;
- # Documentation for the Pisg::Parser::Format modules is found in Template.pm
- # This Parser works with muh version muh-2.1 and above.
- # muh got a new log-format, so this is version 2
- # contact: boitl @ IRC, sebastian@mquant.de, 09/2003
- # note:
- # muh-2.1 is buggy in action-loggin.
- # apply http://www.mquant.de/downloads/muh-actionpatch.diff
- use strict;
- $^W = 1;
- sub new
- {
- my ($type, %args) = @_;
- my $self = {
- cfg => $args{cfg},
- normalline => '^\[(\d+):\d+\S+ <([^>]+)> (.*)$',
- actionline => '^\[(\d+):\d+\S+ \* (\S+) (.*)$',
- thirdline => '^\[(\d+):(\d+)\S+ \*{3} (.+)$'
- };
- bless($self, $type);
- return $self;
- }
- sub normalline
- {
- my ($self, $line, $lines) = @_;
- my %hash;
- if ($line =~ /$self->{normalline}/o) {
- $hash{hour} = $1;
- $hash{nick} = remove_prefix($2);
- $hash{saying} = $3;
- return \%hash;
- } else {
- return;
- }
- }
- sub actionline
- {
- my ($self, $line, $lines) = @_;
- my %hash;
- if ($line =~ /$self->{actionline}/o) {
- $hash{hour} = $1;
- $hash{nick} = remove_prefix($2);
- $hash{saying} = $3;
- return \%hash;
- } else {
- return;
- }
- }
- sub thirdline
- {
- my ($self, $line, $lines) = @_;
- my %hash;
- if ($line =~ /$self->{thirdline}/o) {
- my @line = split(/\s/, $3);
- $hash{hour} = $1;
- $hash{min} = $2;
- $hash{nick} = remove_prefix($line[0]);
- if ($#line >= 4 && ($line[1].$line[2]) eq 'waskicked') {
- $hash{kicker} = $line[4];
- } elsif ($#line >= 4 && ($line[1] eq 'changes')) {
- $hash{newtopic} = join(' ', @line[4..$#line]);
- $hash{newtopic} =~ s/^'//;
- $hash{newtopic} =~ s/'$//;
- } elsif ($#line >= 3 && ($line[1].$line[2]) eq 'setsmode') {
- $hash{newmode} = $line[3];
- } elsif ($#line >= 3 && ($line[2].$line[3]) eq 'hasjoined') {
- $hash{newjoin} = $line[0];
- } elsif ($#line >= 5 && ($line[2].$line[3]) eq 'nowknown') {
- $hash{newnick} = $line[5];
- }
- return \%hash;
- } else {
- return;
- }
- }
- sub remove_prefix
- {
- my ($str) = @_;
- $str =~ s/^[@%\+]//o;
- return $str;
- }
- 1;
|