Merged branches/db-store back into trunk
authorocto <octo>
Thu, 14 Apr 2005 21:50:09 +0000 (21:50 +0000)
committerocto <octo>
Thu, 14 Apr 2005 21:50:09 +0000 (21:50 +0000)
1  2 
lib/Onis/Parser/Irssi.pm

index 0928be6,0000000..eade51a
mode 100644,000000..100644
--- /dev/null
@@@ -1,223 -1,0 +1,223 @@@
-       elsif ($line =~ m/^(\d\d):(\d\d) ... (\S+) \[([^\]]+)\] has joined ([#!+&]\S+)/)
 +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: Irssi.pm,v 1.4 2003/12/16 09:22:28 octo Exp $';
 +print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);
 +
 +return (1);
 +
 +# Return values:
 +# 0 == rewind file
 +# 1 == line parsed
 +# 2 == unable to parse
 +# 3 == line old
 +# 4 == don't have date
 +sub parse
 +{
 +      my $line = shift;
 +      my $state;
 +
 +      if ($line =~ m/^(\d\d):(\d\d) /)
 +      {
 +              add_relative_time ($1, $2);
 +      }
 +      elsif ($line =~ m/^--- /)
 +      {
 +              if ($line =~ m/(\w\w\w) (\d\d) (\d\d):(\d\d):(\d\d) (\d{4})/)
 +              {
 +                      if (!defined ($MONTHNAMES{$1})) { return (4); }
 +                      set_absolute_time ($6, $MONTHNAMES{$1}, $2, $3, $4, $5);
 +              }
 +      }
 +
 +      $state = get_state ();
 +      if ($state != 1)
 +      {
 +              return ($state);
 +      }
 +
 +      # 12:45 < impy> aufstand im forum..wurde niedergeschlagen
 +      # 12:47 <@octo> mahlzeit :)
 +      if ($line =~ m/^(\d\d):(\d\d) <(.)([^>]+)> (.+)/)
 +      {
 +              my $data =
 +              {
 +                      hour    => $1,
 +                      minute  => $2,
 +                      nick    => $4,
 +                      text    => $5,
 +                      type    => 'TEXT'
 +              };
 +              
 +              my @words = grep { length ($_) >= $WORD_LENGTH } (split (m/\W+/, $5));
 +              $data->{'words'} = \@words;
 +              
 +              store ($data);
 +      }
 +
 +      # 12:48 * octo kommt grad vom einschreiben zurueck :)
 +      # 00:20 * octo bricht grad voll ab vor lachen..
 +      elsif ($line =~ m/^(\d\d):(\d\d) (\* (\S+) .+)$/)
 +      {
 +              my $data =
 +              {
 +                      hour    => $1,
 +                      minute  => $2,
 +                      nick    => $4,
 +                      text    => $3,
 +                      type    => 'ACTION'
 +              };
 +              
 +              my @words = grep { length ($_) >= $WORD_LENGTH } (split (m/\W+/, $3));
 +              $data->{'words'} = \@words;
 +              
 +              store ($data);
 +      }
 +
 +      # 07:03 *** |Kodachi| [~kodachi@pD9505323.dip.t-dialin.net] has joined #schlegl
 +      # 14:08 *** t_sunrise [t_sunrise@pD9E53413.dip.t-dialin.net] has joined #schlegl
-       elsif ($line =~ m/^(\d\d):(\d\d) ... mode\/([#!+&]\S+) \[([^\]]+)\] by (\S+)/)
++      elsif ($line =~ m/^(\d\d):(\d\d) \*\*\* (\S+) \[([^\]]+)\] has joined ([#!+&]\S+)/)
 +      {
 +              my $data =
 +              {
 +                      hour    => $1,
 +                      minute  => $2,
 +                      nick    => $3,
 +                      host    => $4,
 +                      channel => $5,
 +                      type    => 'JOIN'
 +              };
 +              store ($data);
 +      }
 +
 +      # 15:52 *** mode/#schlegl [+o martin-] by Sajdan
 +      # 11:25 *** mode/#schlegl [+ooo Impy_ kyreon Sajdan] by octo
-       elsif ($line =~ m/^(\d\d):(\d\d) ... (\S+) is now known as (\S+)/)
++      elsif ($line =~ m/^(\d\d):(\d\d) \*\*\* mode\/([#!+&]\S+) \[([^\]]+)\] by (\S+)/)
 +      {
 +              my $data =
 +              {
 +                      hour    => $1,
 +                      minute  => $2,
 +                      channel => $3,
 +                      mode    => $4,
 +                      nick    => $5,
 +                      type    => 'MODE'
 +              };
 +              store ($data);
 +      }
 +      
 +      # 15:08 *** stoffi- is now known as foobar-
 +      # 13:48 *** Lucky-17 is now known as Lucky17
-       elsif ($line =~ m/^(\d\d):(\d\d) ... (\S+) changed the topic of ([#!+&]\S+) to: (.+)/)
++      elsif ($line =~ m/^(\d\d):(\d\d) \*\*\* (\S+) is now known as (\S+)/)
 +      {
 +              nick_rename ($1, $2);
 +      }
 +
 +      # 14:00 *** kyreon changed the topic of #schlegl to: 100 Jahre Ball... kommt alle :)
 +      # 15:03 *** martin- changed the topic of #schlegl to: http://martin.ipv6.cc/austellung.txt / Hat jmd Interesse?
-       elsif ($line =~ m/^(\d\d):(\d\d) ... (\S+) \[([^\]]+)\] has quit \[([^\]]*)\]/)
++      elsif ($line =~ m/^(\d\d):(\d\d) \*\*\* (\S+) changed the topic of ([#!+&]\S+) to: (.+)/)
 +      {
 +              my $data =
 +              {
 +                      hour    => $1,
 +                      minute  => $2,
 +                      nick    => $3,
 +                      channel => $4,
 +                      text    => $5,
 +                      type    => 'TOPIC'
 +              };
 +              store ($data);
 +      }
 +
 +      # 23:31 *** |Kodachi| [~kodachi@pD9505104.dip.t-dialin.net] has quit [sleepinf]
 +      # 00:18 *** miracle- [~SandraNeu@pD9E531C9.dip.t-dialin.net] has quit [Ping timeout]
-       elsif ($line =~ m/^(\d\d):(\d\d) ... (\S+) \[([^\]]+)\] has left ([#!+&]\S+) \[([^\]]*)\]/)
++      elsif ($line =~ m/^(\d\d):(\d\d) \*\*\* (\S+) \[([^\]]+)\] has quit \[([^\]]*)\]/)
 +      {
 +              my $data =
 +              {
 +                      hour    => $1,
 +                      minute  => $2,
 +                      nick    => $3,
 +                      host    => $4,
 +                      text    => $5,
 +                      type    => 'QUIT'
 +              };
 +              store ($data);
 +      }
 +
 +      # 15:08 *** t_sunrise [t_sunrise@p508472D6.dip.t-dialin.net] has left #schlegl [t_sunrise]
 +      # 12:59 *** impy__ [impy@huhu.franken.de] has left #schlegl [impy__]
-       elsif ($line =~ m/^(\d\d):(\d\d) ... (\S+) was kicked from ([#!+&]\S+) by (\S+) \[([^\]]+)\]/)
++      elsif ($line =~ m/^(\d\d):(\d\d) \*\*\* (\S+) \[([^\]]+)\] has left ([#!+&]\S+) \[([^\]]*)\]/)
 +      {
 +              my $data =
 +              {
 +                      hour    => $1,
 +                      minute  => $2,
 +                      nick    => $3,
 +                      host    => $4,
 +                      channel => $5,
 +                      text    => $6,
 +                      type    => 'LEAVE'
 +              };
 +              store ($data);
 +      }
 +      
 +      # 21:54 *** stoffi- was kicked from #schlegl by martin- [bye]
 +      # 12:37 *** miracle- was kicked from #schlegl by kyreon [kyreon]
++      elsif ($line =~ m/^(\d\d):(\d\d) \*\*\* (\S+) was kicked from ([#!+&]\S+) by (\S+) \[([^\]]+)\]/)
 +      {
 +              my $data =
 +              {
 +                      hour    => $1,
 +                      minute  => $2,
 +                      channel => $4,
 +                      nick_received   => $3,
 +                      nick    => $5,
 +                      text    => $6,
 +                      type    => 'KICK'
 +              };
 +              store ($data);
 +      }
 +
 +      else
 +      {
 +              print STDERR $/, __FILE__, ": Not parsed: ``$line''" if ($::DEBUG & 0x20);
 +              return (2);
 +      }
 +
 +      return (1);
 +}
 +
 +sub last_date
 +{
 +      # $line =~ m/(\w\w\w) (\d\d) (\d\d):(\d\d):(\d\d) (\d{4})/
 +      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 ("%s %02u %02u:%02u:%02u %04u\n",
 +              $month_name, $day, $hour, $min, $sec, $year);
 +
 +      return ($retval);
 +}