lib/Onis/Parser/Irssi.pm

   1 package Onis::Parser;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Exporter;
   7 use Onis::Config qw#get_config#;
   8 use Onis::Data::Core qw#nick_rename store#;
   9 use Onis::Parser::Persistent qw/set_absolute_time get_absolute_time add_relative_time get_state %MONTHNAMES @MONTHNUMS/;
  10
  11 @Onis::Parser::EXPORT_OK = qw/parse last_date/;
  12 @Onis::Parser::ISA = ('Exporter');
  13
  14 our $WORD_LENGTH = 5;
  15
  16 if (get_config ('min_word_length'))
  17 {
  18         my $tmp = get_config ('min_word_length');
  19         $tmp =~ s/\D//g;
  20         $WORD_LENGTH = $tmp if ($tmp);
  21 }
  22
  23 my $VERSION = '$Id: Irssi.pm,v 1.4 2003/12/16 09:22:28 octo Exp $';
  24 print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);
  25
  26 return (1);
  27
  28 # Return values:
  29 # 0 == rewind file
  30 # 1 == line parsed
  31 # 2 == unable to parse
  32 # 3 == line old
  33 # 4 == don't have date
  34 sub parse
  35 {
  36         my $line = shift;
  37         my $state;
  38
  39         if ($line =~ m/^(\d\d):(\d\d) /)
  40         {
  41                 add_relative_time ($1, $2);
  42         }
  43         elsif ($line =~ m/^--- /)
  44         {
  45                 if ($line =~ m/(\w\w\w) (\d\d) (\d\d):(\d\d):(\d\d) (\d{4})/)
  46                 {
  47                         if (!defined ($MONTHNAMES{$1})) { return (4); }
  48                         set_absolute_time ($6, $MONTHNAMES{$1}, $2, $3, $4, $5);
  49                 }
  50         }
  51
  52         $state = get_state ();
  53         if ($state != 1)
  54         {
  55                 return ($state);
  56         }
  57
  58         # 12:45 < impy> aufstand im forum..wurde niedergeschlagen
  59         # 12:47 <@octo> mahlzeit :)
  60         if ($line =~ m/^(\d\d):(\d\d) <(.)([^>]+)> (.+)/)
  61         {
  62                 my $data =
  63                 {
  64                         hour    => $1,
  65                         minute  => $2,
  66                         nick    => $4,
  67                         text    => $5,
  68                         type    => 'TEXT'
  69                 };
  70
  71                 my @words = grep { length ($_) >= $WORD_LENGTH } (split (m/\W+/, $5));
  72                 $data->{'words'} = \@words;
  73
  74                 store ($data);
  75         }
  76
  77         # 12:48 * octo kommt grad vom einschreiben zurueck :)
  78         # 00:20 * octo bricht grad voll ab vor lachen..
  79         elsif ($line =~ m/^(\d\d):(\d\d) (\* (\S+) .+)$/)
  80         {
  81                 my $data =
  82                 {
  83                         hour    => $1,
  84                         minute  => $2,
  85                         nick    => $4,
  86                         text    => $3,
  87                         type    => 'ACTION'
  88                 };
  89
  90                 my @words = grep { length ($_) >= $WORD_LENGTH } (split (m/\W+/, $3));
  91                 $data->{'words'} = \@words;
  92
  93                 store ($data);
  94         }
  95
  96         # 07:03 *** |Kodachi| [~kodachi@pD9505323.dip.t-dialin.net] has joined #schlegl
  97         # 14:08 *** t_sunrise [t_sunrise@pD9E53413.dip.t-dialin.net] has joined #schlegl
  98         elsif ($line =~ m/^(\d\d):(\d\d) ... (\S+) \[([^\]]+)\] has joined ([#!+&]\S+)/)
  99         {
 100                 my $data =
 101                 {
 102                         hour    => $1,
 103                         minute  => $2,
 104                         nick    => $3,
 105                         host    => $4,
 106                         channel => $5,
 107                         type    => 'JOIN'
 108                 };
 109                 store ($data);
 110         }
 111
 112         # 15:52 *** mode/#schlegl [+o martin-] by Sajdan
 113         # 11:25 *** mode/#schlegl [+ooo Impy_ kyreon Sajdan] by octo
 114         elsif ($line =~ m/^(\d\d):(\d\d) ... mode\/([#!+&]\S+) \[([^\]]+)\] by (\S+)/)
 115         {
 116                 my $data =
 117                 {
 118                         hour    => $1,
 119                         minute  => $2,
 120                         channel => $3,
 121                         mode    => $4,
 122                         nick    => $5,
 123                         type    => 'MODE'
 124                 };
 125                 store ($data);
 126         }
 127
 128         # 15:08 *** stoffi- is now known as foobar-
 129         # 13:48 *** Lucky-17 is now known as Lucky17
 130         elsif ($line =~ m/^(\d\d):(\d\d) ... (\S+) is now known as (\S+)/)
 131         {
 132                 nick_rename ($1, $2);
 133         }
 134
 135         # 14:00 *** kyreon changed the topic of #schlegl to: 100 Jahre Ball... kommt alle :)
 136         # 15:03 *** martin- changed the topic of #schlegl to: http://martin.ipv6.cc/austellung.txt / Hat jmd Interesse?
 137         elsif ($line =~ m/^(\d\d):(\d\d) ... (\S+) changed the topic of ([#!+&]\S+) to: (.+)/)
 138         {
 139                 my $data =
 140                 {
 141                         hour    => $1,
 142                         minute  => $2,
 143                         nick    => $3,
 144                         channel => $4,
 145                         text    => $5,
 146                         type    => 'TOPIC'
 147                 };
 148                 store ($data);
 149         }
 150
 151         # 23:31 *** |Kodachi| [~kodachi@pD9505104.dip.t-dialin.net] has quit [sleepinf]
 152         # 00:18 *** miracle- [~SandraNeu@pD9E531C9.dip.t-dialin.net] has quit [Ping timeout]
 153         elsif ($line =~ m/^(\d\d):(\d\d) ... (\S+) \[([^\]]+)\] has quit \[([^\]]*)\]/)
 154         {
 155                 my $data =
 156                 {
 157                         hour    => $1,
 158                         minute  => $2,
 159                         nick    => $3,
 160                         host    => $4,
 161                         text    => $5,
 162                         type    => 'QUIT'
 163                 };
 164                 store ($data);
 165         }
 166
 167         # 15:08 *** t_sunrise [t_sunrise@p508472D6.dip.t-dialin.net] has left #schlegl [t_sunrise]
 168         # 12:59 *** impy__ [impy@huhu.franken.de] has left #schlegl [impy__]
 169         elsif ($line =~ m/^(\d\d):(\d\d) ... (\S+) \[([^\]]+)\] has left ([#!+&]\S+) \[([^\]]*)\]/)
 170         {
 171                 my $data =
 172                 {
 173                         hour    => $1,
 174                         minute  => $2,
 175                         nick    => $3,
 176                         host    => $4,
 177                         channel => $5,
 178                         text    => $6,
 179                         type    => 'LEAVE'
 180                 };
 181                 store ($data);
 182         }
 183
 184         # 21:54 *** stoffi- was kicked from #schlegl by martin- [bye]
 185         # 12:37 *** miracle- was kicked from #schlegl by kyreon [kyreon]
 186         elsif ($line =~ m/^(\d\d):(\d\d) ... (\S+) was kicked from ([#!+&]\S+) by (\S+) \[([^\]]+)\]/)
 187         {
 188                 my $data =
 189                 {
 190                         hour    => $1,
 191                         minute  => $2,
 192                         channel => $4,
 193                         nick_received   => $3,
 194                         nick    => $5,
 195                         text    => $6,
 196                         type    => 'KICK'
 197                 };
 198                 store ($data);
 199         }
 200
 201         else
 202         {
 203                 print STDERR $/, __FILE__, ": Not parsed: ``$line''" if ($::DEBUG & 0x20);
 204                 return (2);
 205         }
 206
 207         return (1);
 208 }
 209
 210 sub last_date
 211 {
 212         # $line =~ m/(\w\w\w) (\d\d) (\d\d):(\d\d):(\d\d) (\d{4})/
 213         my $time = get_absolute_time ();
 214         my ($sec, $min, $hour, $day, $month_num, $year) = (localtime ($time))[0 .. 5];
 215         my $month_name = $MONTHNUMS[$month_num];
 216
 217         $year += 1900;
 218
 219         my $retval = sprintf ("%s %02u %02u:%02u:%02u %04u\n",
 220                 $month_name, $day, $hour, $min, $sec, $year);
 221
 222         return ($retval);
 223 }