1 package Onis::Data::Core;
5 Onis::Data::Core - User management
9 Store data to the internal structure, care about users, nicks and idents and
10 dispatch to plugins. The core of the data even..
18 use Onis::Config qw(get_config);
19 use Onis::Users qw(ident_to_name);
20 use Onis::Data::Persistent;
21 use Onis::Parser::Persistent qw(get_absolute_time);
23 =head1 NAMING CONVENTION
25 Each and every person in the IRC can be identified by a three-tupel: B<nick>,
26 B<user> and B<host>, most often seen as I<nick!user@host>.
28 The combination of B<user> and B<host> is called an B<ident> here and written
29 I<user@host>. The combination of all three parts is called a B<chatter> here,
30 though it's rarely used.
32 A B<name> is the name of the "user" as defined in the F<users.conf>. Therefore,
33 the F<users.conf> defines a mapping of B<chatter> -E<gt> B<name>.
37 our $Nick2Ident = Onis::Data::Persistent->new ('Nick2Ident', 'nick', 'ident');
38 our $ChatterList = Onis::Data::Persistent->new ('ChatterList', 'chatter', 'counter');
39 our $ChannelNames = Onis::Data::Persistent->new ('ChannelNames', 'channel', 'counter');
41 @Onis::Data::Core::EXPORT_OK =
43 store unsharp calculate_nicks
45 get_all_nicks get_channel get_main_nick nick_to_ident ident_to_nick nick_to_name
46 get_total_lines nick_rename print_output register_plugin
48 @Onis::Data::Core::ISA = ('Exporter');
50 our $PluginCallbacks = {};
56 our %NickToIdent = ();
57 our %IdentToNick = ();
59 our $LASTRUN_DAYS = 0;
63 our $UNSHARP = 'MEDIUM';
64 if (get_config ('unsharp'))
66 my $tmp = get_config ('unsharp');
70 if ($tmp eq 'NONE' or $tmp eq 'LIGHT'
78 print STDERR $/, __FILE__, ": ``$tmp'' is not a valid value for config option ``unsharp''.",
79 $/, __FILE__, ": Using standard value ``MEDIUM''.";
87 my $VERSION = '$Id: Core.pm,v 1.14 2004/10/31 15:00:32 octo Exp $';
88 print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);
92 =head1 EXPORTED FUNCTIONS
96 =item B<store> (I<$type>, I<$data>)
98 Passes I<$data> (a hashref) to all plugins which registered for I<$type>. This
99 is the actual workhorse when parsing the file since it will be called once for
102 It will fill I<$data> with I<host>, I<user> and I<ident> if these fields are
103 missing but have been seen for this nick before.
110 my $type = $data->{'type'};
111 my ($nick, $user, $host);
114 if (!defined ($type))
116 print STDERR $/, __FILE__, ": Plugin data did not include a type. This line will be skipped." if ($::DEBUG & 0x20);
120 if (!defined ($data->{'nick'}))
122 print STDERR $/, __FILE__, ": Plugin data did not include a nick. This line will be skipped." if ($::DEBUG & 0x20);
126 $nick = $data->{'nick'};
128 if (defined ($data->{'host'}))
133 ($user, $host) = unsharp ($data->{'host'});
134 $ident = "$user\@$host";
136 $data->{'host'} = $host;
137 $data->{'user'} = $user;
138 $data->{'ident'} = $ident;
140 $Nick2Ident->put ($nick, $ident);
142 $chatter = "$nick!$ident";
143 ($counter) = $ChatterList->get ($chatter);
144 $counter ||= 0; $counter++;
145 $ChatterList->put ($chatter, $counter);
147 elsif (($ident) = $Nick2Ident->get ($nick))
149 my $chatter = "$nick!$ident";
151 ($user, $host) = split (m/@/, $ident);
153 $data->{'host'} = $host;
154 $data->{'user'} = $user;
155 $data->{'ident'} = $ident;
157 ($counter) = $ChatterList->get ($chatter);
158 $counter ||= 0; $counter++;
159 $ChatterList->put ($chatter, $counter);
163 $data->{'host'} = $host = '';
164 $data->{'user'} = $user = '';
165 $data->{'ident'} = $ident = '';
168 if ($::DEBUG & 0x0100)
170 print STDERR $/, __FILE__, ": id ($nick) = ", $ident;
173 if (defined ($data->{'channel'}))
175 my $chan = lc ($data->{'channel'});
176 my ($count) = $ChannelNames->get ($chan);
177 $count ||= 0; $count++;
178 $ChannelNames->put ($chan, $count);
181 if (!defined ($data->{'epoch'}))
183 $data->{'epoch'} = get_absolute_time ();
186 if ($::DEBUG & 0x400)
188 my @keys = keys (%$data);
192 my $val = $data->{$key};
193 print STDERR $/, __FILE__, ': ';
194 printf STDERR ("%10s: %s", $key, $val);
199 #$DATA->{'total_lines'}++;
201 if (defined ($PluginCallbacks->{$type}))
203 for (@{$PluginCallbacks->{$type}})
212 =item (I<$user>, I<$host>) = B<unsharp> (I<$ident>)
214 Takes an ident (i.e. a user-host-pair, e.g. I<user@host.domain.com> or
215 I<login@123.123.123.123>) and "unsharps it". The unsharp version is then
218 What unsharp exactly does is described in the F<README>.
232 print STDERR $/, __FILE__, ": Unsharp ``$ident''" if ($::DEBUG & 0x100);
234 ($user, $host) = split (m/@/, $ident, 2);
236 @parts = split (m/\./, $host);
237 $num_parts = scalar (@parts);
239 if (($UNSHARP ne 'NONE')
240 and ($user =~ m/^[\~\^\-\+\=](.+)$/))
245 if ($UNSHARP eq 'NONE')
247 return ($user, $host);
249 elsif ($host =~ m/^[\d\.]{7,15}$/)
251 if ($UNSHARP ne 'LIGHT')
258 for ($i = 0; $i < ($num_parts - 2); $i++)
260 if ($UNSHARP eq 'LIGHT')
262 if ($parts[$i] !~ s/\d+/*/g)
267 elsif ($UNSHARP eq 'MEDIUM')
269 if ($parts[$i] =~ m/\d/)
278 else # ($UNSHARP eq 'HARD')
285 $host = lc (join ('.', @parts));
286 $host =~ s/\*(?:\.\*)+/*/;
288 print STDERR " -> ``$user\@$host''" if ($::DEBUG & 0x100);
289 return ($user, $host);
292 =item B<calculate_nicks> ()
294 Iterates over all chatters found so far, trying to figure out which belong to
295 the same person. This function has to be called before any calls to
296 B<get_all_nicks>, B<get_main_nick>, B<get_print_name> and B<nick_to_ident>.
298 This is normally the step after having parsed all files and before doing any
299 output. After this function has been run all the other informative functions
300 return actually usefull information..
302 It does the following: First, it iterates over all chatters and splits them up
303 into nicks and idents. If a (user)name is found for the ident it (the ident) is
304 replaced with it (the name).
306 In the second step we iterate over all nicks that have been found and
307 determines the most active ident for each nick. After this has been done each
308 nick is associated with exactly one ident, but B<not> vice versa.
310 The final step is to iterate over all idents and determine the most active nick
311 for each ident. After some thought you will agree that now each ident exists
312 only once and so does every nick.
323 for ($ChatterList->keys ())
326 my ($nick, $ident) = split (m/!/, $chatter);
327 my $name = ident_to_name ($ident);
328 my ($counter) = $ChatterList->get ($chatter);
330 $nicks->{$nick}{$ident} = 0 unless (defined ($nicks->{$nick}{$ident}));
331 $nicks->{$nick}{$ident} += $counter;
337 my $this_ident = 'unidentified';
342 for (keys %{$nicks->{$this_nick}})
345 my $name = ident_to_name ($ident);
346 my $num = $nicks->{$this_nick}{$ident};
352 if (($num >= $this_max) or !$this_name)
355 $this_ident = $ident;
361 if (($num >= $this_max) and !$this_name)
364 $this_ident = $ident;
369 print $/, __FILE__, ": max_ident ($this_nick) = $this_ident" if ($::DEBUG & 0x100);
371 if ($this_ident ne 'unidentified')
375 $name2nick->{$this_name}{$this_nick} = 0 unless (defined ($name2nick->{$this_name}{$this_nick}));
376 $name2nick->{$this_name}{$this_nick} += $this_total;
378 $name2ident->{$this_name}{$this_ident} = 0 unless (defined ($name2nick->{$this_name}{$this_ident}));
379 $name2ident->{$this_name}{$this_ident} += $this_total;
383 $idents->{$this_ident}{$this_nick} = 0 unless (defined ($idents->{$this_ident}{$this_nick}));
384 $idents->{$this_ident}{$this_nick} += $this_total;
387 elsif ($::DEBUG & 0x100)
389 print STDERR $/, __FILE__, ": Ignoring unidentified nick ``$this_nick''";
398 my @other_nicks = ();
400 my @nicks = keys (%{$idents->{$this_ident}});
405 my $num = $idents->{$this_ident}{$nick};
407 if ($num > $this_max)
409 if ($this_nick) { push (@other_nicks, $this_nick); }
415 push (@other_nicks, $nick);
419 print STDERR $/, __FILE__, ": max_nick ($this_ident) = $this_nick" if ($::DEBUG & 0x100);
421 for (@other_nicks, $this_nick)
423 push (@AllNicks, $_);
424 $NickToNick{$_} = $this_nick;
425 $NickToIdent{$_} = $this_ident;
428 $IdentToNick{$this_ident} = $this_nick;
431 for (keys %$name2nick)
438 my @other_nicks = ();
439 my @other_idents = ();
441 for (keys %{$name2nick->{$name}})
444 my $num = $name2nick->{$name}{$nick};
448 push (@other_nicks, $max_nick) if ($max_nick);
454 push (@other_nicks, $nick);
459 for (keys %{$name2ident->{$name}})
462 my $num = $name2ident->{$name}{$ident};
466 push (@other_idents, $max_ident) if ($max_ident);
472 push (@other_idents, $ident);
476 for (@other_nicks, $max_nick)
478 push (@AllNicks, $_);
479 $NickToNick{$_} = $max_nick;
480 $NickToIdent{$_} = $max_ident;
483 for (@other_idents, $max_ident)
485 $IdentToNick{$_} = $max_nick;
490 =item I<@nicks> = B<get_all_nicks> ()
492 Returns an array of all seen nicks.
501 =item I<$channel> = B<get_channel> ()
503 Returns the name of the channel we're generating stats for.
509 my $chan = '#unknown'
511 if (get_config ('channel'))
513 $chan = get_config ('channel');
518 for ($ChannelNames->keys ())
521 my ($num) = $ChannelNames->get ($c);
522 if (defined ($num) and ($num > $max))
530 # Fix network-safe channel named (RFC 2811)
531 if ($chan =~ m/^![A-Z0-9]{5}.+/)
533 $chan =~ s/[A-Z0-9]{5}//;
539 =item I<$main> = B<get_main_nick> (I<$nick>)
541 Returns the main nick for I<$nick> or an empty string if the nick is unknown..
548 if (defined ($NickToNick{$nick}))
550 return ($NickToNick{$nick});
558 =item I<$ident> = B<nick_to_ident> (I<$nick>)
560 Returns the ident for this nick or an empty string if unknown. Before
561 B<calculate_nicks> is run it will use the database to find the most recent
562 mapping. After B<calculate_nicks> is run the calculated mapping will be used.
573 if (defined ($NickToIdent{$nick}))
575 $ident = $NickToIdent{$nick};
580 ($ident) = $Nick2Ident->get ($nick);
587 =item I<$nick> = B<ident_to_nick> (I<$ident>)
589 Returns the nick for the given ident or an empty string if unknown.
597 if (defined ($IdentToNick{$ident}))
599 return ($IdentToNick{$ident});
607 =item I<$name> = B<nick_to_name> (I<$nick>)
609 Return the name associated with I<$nick>. This function uses B<ident_to_name>
610 (see L<Onis::Users>).
617 my $ident = nick_to_ident ($nick);
621 return (ident_to_name ($ident));
629 =item I<$lines> = B<get_total_lines> ()
631 Returns the total number of lines parsed so far.
638 #return ($DATA->{'total_lines'});
641 =item B<nick_rename> (I<$old_nick>, I<$new_nick>)
643 Keeps track of a nick's hostname if the nick changes.
649 my $old_nick = shift;
650 my $new_nick = shift;
653 ($ident) = $Nick2Ident->get ($old_nick);
655 if (defined ($ident) and ($ident))
657 $Nick2Ident->put ($new_nick, $ident);
661 =item B<print_output> ()
663 Print the output. Should be called only once..
670 if (!get_total_lines () and 0)
672 print STDERR <<'MESSAGE';
676 The most common reasons for this are:
677 - The logfile used was empty.
678 - The ``logtype'' setting did not match the logfile.
679 - The logfile did not include a date.
693 =item I<$data> = B<register_plugin> (I<$type>, I<$sub_ref>)
695 Register a subroutine for the given type. Returns a reference to the internal
696 data object. This will change soon, don't use it anymore if possible.
706 if (ref ($sub_ref) ne "CODE")
708 print STDERR $/, __FILE__, ": Plugin tried to register a non-code reference. Ignoring it.";
712 if ($type eq 'OUTPUT')
714 push (@$OUTPUT, $sub_ref);
718 if (!defined ($PluginCallbacks->{$type}))
720 $PluginCallbacks->{$type} = [];
724 push (@{$PluginCallbacks->{$type}}, $sub_ref);
726 print STDERR $/, __FILE__, ': ', scalar (caller ()), " registered for ``$type''." if ($::DEBUG & 0x800);
733 Florian octo Forster E<lt>octo at verplant.orgE<gt>