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 $GeneralCounters = Onis::Data::Persistent->new ('GeneralCounters', 'key', 'value');
38 our $NickToIdentCache = Onis::Data::Persistent->new ('NickToIdentCache', 'nick', 'ident');
39 our $ChatterList = Onis::Data::Persistent->new ('ChatterList', 'chatter', 'counter');
40 our $ChannelNames = Onis::Data::Persistent->new ('ChannelNames', 'channel', 'counter');
42 @Onis::Data::Core::EXPORT_OK =
44 store unsharp calculate_nicks
46 get_all_nicks get_channel get_main_nick nick_to_ident ident_to_nick nick_to_name
47 get_total_lines nick_rename print_output register_plugin
49 @Onis::Data::Core::ISA = ('Exporter');
51 our $LinesThisRun = 0;
53 our $PluginCallbacks = {};
54 our $OutputCallbacks = [];
58 our %NickToIdent = ();
59 our %IdentToNick = ();
61 our $UNSHARP = 'MEDIUM';
62 if (get_config ('unsharp'))
64 my $tmp = get_config ('unsharp');
68 if ($tmp eq 'NONE' or $tmp eq 'LIGHT'
76 print STDERR $/, __FILE__, ": ``$tmp'' is not a valid value for config option ``unsharp''.",
77 $/, __FILE__, ": Using standard value ``MEDIUM''.";
85 my $VERSION = '$Id: Core.pm,v 1.14 2004/10/31 15:00:32 octo Exp $';
86 print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);
90 =head1 EXPORTED FUNCTIONS
94 =item B<store> (I<$type>, I<$data>)
96 Passes I<$data> (a hashref) to all plugins which registered for I<$type>. This
97 is the actual workhorse when parsing the file since it will be called once for
100 It will fill I<$data> with I<host>, I<user> and I<ident> if these fields are
101 missing but have been seen for this nick before.
108 my $type = $data->{'type'};
109 my ($nick, $user, $host);
112 if (!defined ($type))
114 print STDERR $/, __FILE__, ": Plugin data did not include a type. This line will be skipped." if ($::DEBUG & 0x20);
118 if (!defined ($data->{'nick'}))
120 print STDERR $/, __FILE__, ": Plugin data did not include a nick. This line will be skipped." if ($::DEBUG & 0x20);
124 $nick = $data->{'nick'};
126 if (defined ($data->{'host'}))
131 ($user, $host) = unsharp ($data->{'host'});
132 $ident = "$user\@$host";
134 $data->{'host'} = $host;
135 $data->{'user'} = $user;
136 $data->{'ident'} = $ident;
138 $NickToIdentCache->put ($nick, $ident);
140 $chatter = "$nick!$ident";
141 ($counter) = $ChatterList->get ($chatter);
142 $counter ||= 0; $counter++;
143 $ChatterList->put ($chatter, $counter);
145 elsif (($ident) = $NickToIdentCache->get ($nick))
147 my $chatter = "$nick!$ident";
149 ($user, $host) = split (m/@/, $ident);
151 $data->{'host'} = $host;
152 $data->{'user'} = $user;
153 $data->{'ident'} = $ident;
155 ($counter) = $ChatterList->get ($chatter);
156 $counter ||= 0; $counter++;
157 $ChatterList->put ($chatter, $counter);
161 $data->{'host'} = $host = '';
162 $data->{'user'} = $user = '';
163 $data->{'ident'} = $ident = '';
166 if ($::DEBUG & 0x0100)
168 print STDERR $/, __FILE__, ": id ($nick) = ", $ident;
171 if (defined ($data->{'channel'}))
173 my $chan = lc ($data->{'channel'});
174 my ($count) = $ChannelNames->get ($chan);
175 $count ||= 0; $count++;
176 $ChannelNames->put ($chan, $count);
179 if (!defined ($data->{'epoch'}))
181 $data->{'epoch'} = get_absolute_time ();
184 if ($::DEBUG & 0x400)
186 my @keys = keys (%$data);
190 my $val = $data->{$key};
191 print STDERR $/, __FILE__, ': ';
192 printf STDERR ("%10s: %s", $key, $val);
197 my ($counter) = $GeneralCounters->get ('lines_total');
200 $GeneralCounters->put ('lines_total', $counter);
205 if (defined ($PluginCallbacks->{$type}))
207 for (@{$PluginCallbacks->{$type}})
216 =item (I<$user>, I<$host>) = B<unsharp> (I<$ident>)
218 Takes an ident (i.e. a user-host-pair, e.g. I<user@host.domain.com> or
219 I<login@123.123.123.123>) and "unsharps it". The unsharp version is then
222 What unsharp exactly does is described in the F<README>.
236 print STDERR $/, __FILE__, ": Unsharp ``$ident''" if ($::DEBUG & 0x100);
238 ($user, $host) = split (m/@/, $ident, 2);
240 @parts = split (m/\./, $host);
241 $num_parts = scalar (@parts);
243 if (($UNSHARP ne 'NONE')
244 and ($user =~ m/^[\~\^\-\+\=](.+)$/))
249 if ($UNSHARP eq 'NONE')
251 return ($user, $host);
253 elsif ($host =~ m/^[\d\.]{7,15}$/)
255 if ($UNSHARP ne 'LIGHT')
262 for ($i = 0; $i < ($num_parts - 2); $i++)
264 if ($UNSHARP eq 'LIGHT')
266 if ($parts[$i] !~ s/\d+/*/g)
271 elsif ($UNSHARP eq 'MEDIUM')
273 if ($parts[$i] =~ m/\d/)
282 else # ($UNSHARP eq 'HARD')
289 $host = lc (join ('.', @parts));
290 $host =~ s/\*(?:\.\*)+/*/;
292 print STDERR " -> ``$user\@$host''" if ($::DEBUG & 0x100);
293 return ($user, $host);
296 =item B<calculate_nicks> ()
298 Iterates over all chatters found so far, trying to figure out which belong to
299 the same person. This function has to be called before any calls to
300 B<get_all_nicks>, B<get_main_nick>, B<get_print_name> and B<nick_to_ident>.
302 This is normally the step after having parsed all files and before doing any
303 output. After this function has been run all the other informative functions
304 return actually usefull information..
306 It does the following: First, it iterates over all chatters and splits them up
307 into nicks and idents. If a (user)name is found for the ident it (the ident) is
308 replaced with it (the name).
310 In the second step we iterate over all nicks that have been found and
311 determines the most active ident for each nick. After this has been done each
312 nick is associated with exactly one ident, but B<not> vice versa.
314 The final step is to iterate over all idents and determine the most active nick
315 for each ident. After some thought you will agree that now each ident exists
316 only once and so does every nick.
327 for ($ChatterList->keys ())
330 my ($nick, $ident) = split (m/!/, $chatter);
331 my $name = ident_to_name ($ident);
332 my ($counter) = $ChatterList->get ($chatter);
334 $nicks->{$nick}{$ident} = 0 unless (defined ($nicks->{$nick}{$ident}));
335 $nicks->{$nick}{$ident} += $counter;
341 my $this_ident = 'unidentified';
346 for (keys %{$nicks->{$this_nick}})
349 my $name = ident_to_name ($ident);
350 my $num = $nicks->{$this_nick}{$ident};
356 if (($num >= $this_max) or !$this_name)
359 $this_ident = $ident;
365 if (($num >= $this_max) and !$this_name)
368 $this_ident = $ident;
373 print $/, __FILE__, ": max_ident ($this_nick) = $this_ident" if ($::DEBUG & 0x100);
375 if ($this_ident ne 'unidentified')
379 $name2nick->{$this_name}{$this_nick} = 0 unless (defined ($name2nick->{$this_name}{$this_nick}));
380 $name2nick->{$this_name}{$this_nick} += $this_total;
382 $name2ident->{$this_name}{$this_ident} = 0 unless (defined ($name2nick->{$this_name}{$this_ident}));
383 $name2ident->{$this_name}{$this_ident} += $this_total;
387 $idents->{$this_ident}{$this_nick} = 0 unless (defined ($idents->{$this_ident}{$this_nick}));
388 $idents->{$this_ident}{$this_nick} += $this_total;
391 elsif ($::DEBUG & 0x100)
393 print STDERR $/, __FILE__, ": Ignoring unidentified nick ``$this_nick''";
402 my @other_nicks = ();
404 my @nicks = keys (%{$idents->{$this_ident}});
409 my $num = $idents->{$this_ident}{$nick};
411 if ($num > $this_max)
413 if ($this_nick) { push (@other_nicks, $this_nick); }
419 push (@other_nicks, $nick);
423 print STDERR $/, __FILE__, ": max_nick ($this_ident) = $this_nick" if ($::DEBUG & 0x100);
425 for (@other_nicks, $this_nick)
427 push (@AllNicks, $_);
428 $NickToNick{$_} = $this_nick;
429 $NickToIdent{$_} = $this_ident;
432 $IdentToNick{$this_ident} = $this_nick;
435 for (keys %$name2nick)
442 my @other_nicks = ();
443 my @other_idents = ();
445 for (keys %{$name2nick->{$name}})
448 my $num = $name2nick->{$name}{$nick};
452 push (@other_nicks, $max_nick) if ($max_nick);
458 push (@other_nicks, $nick);
463 for (keys %{$name2ident->{$name}})
466 my $num = $name2ident->{$name}{$ident};
470 push (@other_idents, $max_ident) if ($max_ident);
476 push (@other_idents, $ident);
480 for (@other_nicks, $max_nick)
482 push (@AllNicks, $_);
483 $NickToNick{$_} = $max_nick;
484 $NickToIdent{$_} = $max_ident;
487 for (@other_idents, $max_ident)
489 $IdentToNick{$_} = $max_nick;
494 =item I<@nicks> = B<get_all_nicks> ()
496 Returns an array of all seen nicks.
505 =item I<$channel> = B<get_channel> ()
507 Returns the name of the channel we're generating stats for.
513 my $chan = '#unknown'
515 if (get_config ('channel'))
517 $chan = get_config ('channel');
522 for ($ChannelNames->keys ())
525 my ($num) = $ChannelNames->get ($c);
526 if (defined ($num) and ($num > $max))
534 # Fix network-safe channel named (RFC 2811)
535 if ($chan =~ m/^![A-Z0-9]{5}.+/)
537 $chan =~ s/[A-Z0-9]{5}//;
543 =item I<$main> = B<get_main_nick> (I<$nick>)
545 Returns the main nick for I<$nick> or an empty string if the nick is unknown..
552 if (defined ($NickToNick{$nick}))
554 return ($NickToNick{$nick});
562 =item I<$ident> = B<nick_to_ident> (I<$nick>)
564 Returns the ident for this nick or an empty string if unknown. Before
565 B<calculate_nicks> is run it will use the database to find the most recent
566 mapping. After B<calculate_nicks> is run the calculated mapping will be used.
577 if (defined ($NickToIdent{$nick}))
579 $ident = $NickToIdent{$nick};
584 ($ident) = $NickToIdentCache->get ($nick);
591 =item I<$nick> = B<ident_to_nick> (I<$ident>)
593 Returns the nick for the given ident or an empty string if unknown.
601 if (defined ($IdentToNick{$ident}))
603 return ($IdentToNick{$ident});
611 =item I<$name> = B<nick_to_name> (I<$nick>)
613 Return the name associated with I<$nick>. This function uses B<ident_to_name>
614 (see L<Onis::Users>).
621 my $ident = nick_to_ident ($nick);
625 return (ident_to_name ($ident));
633 =item I<$lines> = B<get_total_lines> ()
635 Returns the total number of lines parsed so far.
641 my ($total) = $GeneralCounters->get ('lines_total');
643 return (qw()) unless ($total);
645 return ($total, $LinesThisRun);
648 =item B<nick_rename> (I<$old_nick>, I<$new_nick>)
650 Keeps track of a nick's hostname if the nick changes.
656 my $old_nick = shift;
657 my $new_nick = shift;
660 ($ident) = $NickToIdentCache->get ($old_nick);
662 if (defined ($ident) and ($ident))
664 $NickToIdentCache->put ($new_nick, $ident);
668 =item B<print_output> ()
670 Print the output. Should be called only once..
677 if (!get_total_lines ())
679 print STDERR <<'MESSAGE';
683 The most common reasons for this are:
684 - The logfile used was empty.
685 - The ``logtype'' setting did not match the logfile.
686 - The logfile did not include a date.
694 for (@$OutputCallbacks)
700 =item I<$data> = B<register_plugin> (I<$type>, I<$sub_ref>)
702 Register a subroutine for the given type. Returns a reference to the internal
703 data object. This will change soon, don't use it anymore if possible.
713 if (ref ($sub_ref) ne "CODE")
715 print STDERR $/, __FILE__, ": Plugin tried to register a non-code reference. Ignoring it.";
719 if ($type eq 'OUTPUT')
721 push (@$OutputCallbacks, $sub_ref);
725 if (!defined ($PluginCallbacks->{$type}))
727 $PluginCallbacks->{$type} = [];
731 push (@{$PluginCallbacks->{$type}}, $sub_ref);
733 print STDERR $/, __FILE__, ': ', scalar (caller ()), " registered for ``$type''." if ($::DEBUG & 0x800);
740 Florian octo Forster E<lt>octo at verplant.orgE<gt>