Преглед изворни кода

Add support for mIRC6.x's retarded logging format

sbingner пре 24 година
родитељ
комит
b284ccfa07
3 измењених фајлова са 129 додато и 0 уклоњено
  1. 1 0
      docs/Changelog
  2. 10 0
      docs/FORMATS
  3. 118 0
      modules/Pisg/Parser/Format/mIRC6.pm

+ 1 - 0
docs/Changelog

@@ -3,6 +3,7 @@ pisg (x.xx)
    * Changed behavior of most active nicks to print an action line if no
      normal line is available for that nick
    * Added support for formatting of "for example" lines to standard format
+   * Added retarded support for retarded logformat used for mIRC6.x
 
 pisg (0.41) - Sun Aug, 11th 2002
    * Fix a bug in the winbot logfile format where lines containing the channel

+ 10 - 0
docs/FORMATS

@@ -11,6 +11,16 @@ modules/Pisg/Parser/Format/Template.pm. If you don't have any Perl
 knowledge, then mail a sample logfile to the mailinglist (preferred as a
 link to the logfile)
 
+* mIRC6:
+  - Version 6.x of mIRC
+
+  - Same as mIRC except it uses a retarded logging format that makes modes
+    indeciperable from actions
+
+  - Don't use it if you can avoid it, it dosnt do very well at understanding modes
+
+  - In order to use this, format must be set to 'mIRC6'.
+
 * mIRC:
   - A client for Windows (www.mirc.com)
   

+ 118 - 0
modules/Pisg/Parser/Format/mIRC6.pm

@@ -0,0 +1,118 @@
+package Pisg::Parser::Format::mIRC6;
+
+# Documentation for the Pisg::Parser::Format modules is found in Template.pm
+
+use strict;
+$^W = 1;
+
+sub new
+{
+    my ($type, %args) = @_;
+    my $self = {
+        cfg => $args{cfg},
+        normalline => '^\[(\d+):\d+\] <([^>]+)> (.*)',
+        thirdline  => '^\[(\d+):(\d+)\] \* (.+)'
+    };
+
+    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;
+
+    return $self->thirdline($line, $lines, 1);
+}
+
+sub thirdline
+{
+    my ($self, $line, $lines, $action) = @_;
+    my %hash;
+
+    if ($line =~ /$self->{thirdline}/o) {
+
+        my @line = split(/\s/, $3);
+
+        $hash{hour} = $1;
+        $hash{min}  = $2;
+        $hash{saying}  = $3;
+        $hash{nick} = remove_prefix($line[0]);
+
+        if ($#line >= 4 && ($line[1].$line[2]) eq 'waskicked' && ($line[$#line] =~ /\)$/)) {
+                $hash{kicker} = $line[4];
+
+        } elsif ($#line >= 4 && ($line[1].$line[2]) eq 'werekicked' && ($line[$#line] =~ /\)$/)) {
+                $hash{kicker} = $line[4];
+                $hash{nick} = $self->{cfg}{botnick};
+
+        } elsif ($#line >= 4 && ($line[1] eq 'changes') && ($line[$#line] =~ /\'$/)) {
+                $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[1].$line[2]) eq 'hasjoined') {
+            $hash{newjoin} = $line[0];
+
+        } elsif ($#line == 5 && ($line[2].$line[3]) eq 'nowknown') {
+            $hash{newnick} = $line[5];
+
+        } elsif ($action) {
+            if (
+                ($hash{saying} =~ /^Set by \S+ on \S+ \S+ \d+ \d+:\d+:\d+/) ||
+                ($hash{saying} =~ /^Now talking in #\S+/) ||  
+                ($hash{saying} =~ /^Topic is \'.*\'/) ||  
+                ($hash{saying} =~ /^Disconnected/) ||  
+                ($hash{saying} =~ /^\S+ has quit IRC \(.+\)/) ||  
+                ($hash{saying} =~ /^Retrieving #\S+ info\.\.\./)
+              ) {
+                return 0;
+            } else {
+                $hash{saying} =~ s/^$hash{nick} //;
+                return \%hash;
+            }
+
+        } else {
+            return;
+        }
+
+        return \%hash
+            unless ($action);
+
+    }
+    return;
+}
+
+sub remove_prefix
+{
+    my $str = shift;
+
+    $str =~ s/^@//;
+    $str =~ s/^\+//;
+    $str =~ s/^%//;
+
+    return $str;
+}
+
+1;