1package Onis::Parser; 2 3use strict; 4use warnings; 5 6use Exporter; 7use Onis::Config qw#get_config#; 8use Onis::Data::Core qw#nick_rename store#; 9use 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 14our $WORD_LENGTH = 5; 15 16if (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 23my $VERSION = '$Id: Irssi.pm,v 1.4 2003/12/16 09:22:28 octo Exp $'; 24print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG); 25 26return (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 34sub 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 210sub 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} 224