lib/Onis/Data/Core.pm

   1 package Onis::Data::Core;
   2
   3 =head1 NAME
   4
   5 Onis::Data::Core - User management
   6
   7 =head1 DESCRIPTION
   8
   9 Store data to the internal structure, care about users, nicks and idents and
  10 dispatch to plugins. The core of the data even..
  11
  12 =cut
  13
  14 use strict;
  15 use warnings;
  16
  17 use Exporter;
  18 use Onis::Config qw(get_config);
  19 use Onis::Users qw(chatter_to_name);
  20 use Onis::Data::Persistent;
  21 use Onis::Parser::Persistent qw(get_absolute_time);
  22
  23 =head1 NAMING CONVENTION
  24
  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>.
  27
  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.
  31
  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>.
  34
  35 =cut
  36
  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');
  41
  42 @Onis::Data::Core::EXPORT_OK =
  43 qw(
  44         store unsharp calculate_nicks
  45
  46         get_all_nicks get_channel get_main_nick
  47         nick_to_ident ident_to_nick
  48         nick_to_name ident_to_name
  49         get_total_lines get_most_recent_time nick_rename print_output register_plugin
  50 );
  51 @Onis::Data::Core::ISA = ('Exporter');
  52
  53 our $LinesThisRun = 0;
  54
  55 our $PluginCallbacks = {};
  56 our $OutputCallbacks = [];
  57 our @AllNicks = ();
  58
  59 our %NickToNick = ();
  60 our %NickToIdent = ();
  61 our %IdentToNick = ();
  62
  63 =head1 CONFIGURATION OPTIONS
  64
  65 =over 4
  66
  67 =item B<unsharp>: I<medium>;
  68
  69 Sets the amount of unsharping onis should do. Valid options are I<none>,
  70 I<light>, I<medium> and I<hard>.
  71
  72 =over 4
  73
  74 =item I<none>
  75
  76 does not do any unsharping.
  77
  78 =item I<light>
  79
  80 Leaves IP-addresses as they are. The deepest subdomains containing numbers have
  81 those numbers removed. So C<dsl-084-056-107-131.arcor-ip.net> becomes
  82 C<dsl-*-*-*-*.arcor-ip.net>.
  83
  84 =item I<medium>
  85
  86 Removes the last byte from IP-adresses. So C<84.56.107.131> becomes
  87 C<84.56.107.*>. Hostnames have the deepest subdomains removed if they contain
  88 numers, so C<dsl-084-056-107-131.arcor-ip.net> becomes C<*.arcor-ip.net> while
  89 C<shell.franken.de> is not modified. This is the default and recommended
  90 behavior.
  91
  92 =item I<hard>
  93
  94 Handles IP-addresses as I<medium>. Hostnames have all subdomains removed, so
  95 C<p5493EC60.dip.t-dialin.net> becomes C<*.t-dialin.net> and C<shell.franken.de>
  96 becomes C<*.franken.de>.
  97
  98 =back
  99
 100 =cut
 101
 102 our $UNSHARP = 'MEDIUM';
 103 if (get_config ('unsharp'))
 104 {
 105         my $tmp = get_config ('unsharp');
 106         $tmp = uc ($tmp);
 107         $tmp =~ s/\W//g;
 108
 109         if ($tmp eq 'NONE' or $tmp eq 'LIGHT'
 110                         or $tmp eq 'MEDIUM'
 111                         or $tmp eq 'HARD')
 112         {
 113                 $UNSHARP = $tmp;
 114         }
 115         else
 116         {
 117                 print STDERR $/, __FILE__, ": ``$tmp'' is not a valid value for config option ``unsharp''.",
 118                 $/, __FILE__, ": Using standard value ``MEDIUM''.";
 119         }
 120 }
 121
 122 =item B<channel>: I<name>;
 123
 124 Sets the name of the channel. This is mostly automatically figured out, use
 125 this if onis doesn't get it right or you want another name..
 126
 127 =back
 128
 129 =cut
 130
 131 # TODO
 132 # - lastrun
 133
 134 my $VERSION = '$Id$';
 135 print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);
 136
 137 return (1);
 138
 139 =head1 EXPORTED FUNCTIONS
 140
 141 =over 4
 142
 143 =item B<store> (I<$type>, I<$data>)
 144
 145 Passes I<$data> (a hashref) to all plugins which registered for I<$type>. This
 146 is the actual workhorse when parsing the file since it will be called once for
 147 every line found.
 148
 149 It will fill I<$data> with I<host>, I<user> and I<ident> if these fields are
 150 missing but have been seen for this nick before.
 151
 152 =cut
 153
 154 sub store
 155 {
 156         my $data = shift;
 157         my $type = $data->{'type'};
 158         my ($nick, $user, $host);
 159         my $ident;
 160
 161         if (!defined ($type))
 162         {
 163                 print STDERR $/, __FILE__, ": Plugin data did not include a type. This line will be skipped." if ($::DEBUG & 0x20);
 164                 return (undef);
 165         }
 166
 167         if (!defined ($data->{'nick'}))
 168         {
 169                 print STDERR $/, __FILE__, ": Plugin data did not include a nick. This line will be skipped." if ($::DEBUG & 0x20);
 170                 return (undef);
 171         }
 172
 173         $nick = $data->{'nick'};
 174
 175         if (defined ($data->{'host'}))
 176         {
 177                 my $chatter;
 178                 my $counter;
 179
 180                 ($user, $host) = unsharp ($data->{'host'});
 181                 $ident = "$user\@$host";
 182
 183                 $data->{'host'} = $host;
 184                 $data->{'user'} = $user;
 185                 $data->{'ident'} = $ident;
 186
 187                 $NickToIdentCache->put ($nick, $ident);
 188
 189                 $chatter = "$nick!$ident";
 190                 ($counter) = $ChatterList->get ($chatter);
 191                 $counter ||= 0; $counter++;
 192                 $ChatterList->put ($chatter, $counter);
 193         }
 194         elsif (($ident) = $NickToIdentCache->get ($nick))
 195         {
 196                 my $chatter = "$nick!$ident";
 197                 my $counter;
 198                 ($user, $host) = split (m/@/, $ident);
 199
 200                 $data->{'host'} = $host;
 201                 $data->{'user'} = $user;
 202                 $data->{'ident'} = $ident;
 203
 204                 ($counter) = $ChatterList->get ($chatter);
 205                 $counter ||= 0; $counter++;
 206                 $ChatterList->put ($chatter, $counter);
 207         }
 208         else
 209         {
 210                 $data->{'host'}  = $host  = '';
 211                 $data->{'user'}  = $user  = '';
 212                 $data->{'ident'} = $ident = '';
 213         }
 214
 215         if ($::DEBUG & 0x0100)
 216         {
 217                 print STDERR $/, __FILE__, ": id ($nick) = ", $ident;
 218         }
 219
 220         if (defined ($data->{'channel'}))
 221         {
 222                 my $chan = lc ($data->{'channel'});
 223                 my ($count) = $ChannelNames->get ($chan);
 224                 $count ||= 0; $count++;
 225                 $ChannelNames->put ($chan, $count);
 226         }
 227
 228         if (!defined ($data->{'epoch'}))
 229         {
 230                 $data->{'epoch'} = get_absolute_time ();
 231         }
 232
 233         if ($::DEBUG & 0x400)
 234         {
 235                 my @keys = keys (%$data);
 236                 for (sort (@keys))
 237                 {
 238                         my $key = $_;
 239                         my $val = $data->{$key};
 240                         print STDERR $/, __FILE__, ': ';
 241                         printf STDERR ("%10s: %s", $key, $val);
 242                 }
 243         }
 244
 245         {
 246                 my ($counter) = $GeneralCounters->get ('lines_total');
 247                 $counter ||= 0;
 248                 $counter++;
 249                 $GeneralCounters->put ('lines_total', $counter);
 250
 251                 my ($time) = $GeneralCounters->get ('most_recent_time');
 252                 $time ||= 0;
 253                 $time = $data->{'epoch'} if ($time < $data->{'epoch'});
 254                 $GeneralCounters->put ('most_recent_time', $time);
 255
 256                 $LinesThisRun++;
 257         }
 258
 259         if (defined ($PluginCallbacks->{$type}))
 260         {
 261                 for (@{$PluginCallbacks->{$type}})
 262                 {
 263                         $_->($data);
 264                 }
 265         }
 266
 267         return (1);
 268 }
 269
 270 =item (I<$user>, I<$host>) = B<unsharp> (I<$ident>)
 271
 272 Takes an ident (i.e. a user-host-pair, e.g. I<user@host.domain.com> or
 273 I<login@123.123.123.123>) and "unsharps it". The unsharp version is then
 274 returned.
 275
 276 =cut
 277
 278 sub unsharp
 279 {
 280         my $ident = shift;
 281
 282         my $user;
 283         my $host;
 284         my @parts;
 285         my $num_parts;
 286         my $i;
 287
 288         print STDERR $/, __FILE__, ": Unsharp ``$ident''" if ($::DEBUG & 0x100);
 289
 290         ($user, $host) = split (m/@/, $ident, 2);
 291
 292         @parts = split (m/\./, $host);
 293         $num_parts = scalar (@parts);
 294
 295         if (($UNSHARP ne 'NONE')
 296                         and ($user =~ m/^[\~\^\-\+\=](.+)$/))
 297         {
 298                 $user = $1;
 299         }
 300
 301         if ($UNSHARP eq 'NONE')
 302         {
 303                 return ($user, $host);
 304         }
 305         elsif ($host =~ m/^[\d\.]{7,15}$/)
 306         {
 307                 if ($UNSHARP ne 'LIGHT')
 308                 {
 309                         $parts[-1] = '*';
 310                 }
 311         }
 312         else
 313         {
 314                 for ($i = 0; $i < ($num_parts - 2); $i++)
 315                 {
 316                         if ($UNSHARP eq 'LIGHT')
 317                         {
 318                                 if ($parts[$i] !~ s/\d+/*/g)
 319                                 {
 320                                         last;
 321                                 }
 322                         }
 323                         elsif ($UNSHARP eq 'MEDIUM')
 324                         {
 325                                 if ($parts[$i] =~ m/\d/)
 326                                 {
 327                                         $parts[$i] = '*';
 328                                 }
 329                                 else
 330                                 {
 331                                         last;
 332                                 }
 333                         }
 334                         else # ($UNSHARP eq 'HARD')
 335                         {
 336                                 $parts[$i] = '*';
 337                         }
 338                 }
 339         }
 340
 341         $host = lc (join ('.', @parts));
 342         $host =~ s/\*(?:\.\*)+/*/;
 343
 344         print STDERR " -> ``$user\@$host''" if ($::DEBUG & 0x100);
 345         return ($user, $host);
 346 }
 347
 348 =item B<calculate_nicks> ()
 349
 350 Iterates over all chatters found so far, trying to figure out which belong to
 351 the same person. This function has to be called before any calls to
 352 B<get_all_nicks>, B<get_main_nick>, B<get_print_name> and B<nick_to_ident>.
 353
 354 This is normally the step after having parsed all files and before doing any
 355 output. After this function has been run all the other informative functions
 356 return actually usefull information..
 357
 358 It does the following: First, it iterates over all chatters and splits them up
 359 into nicks and idents. If a (user)name is found for the ident it (the ident) is
 360 replaced with it (the name).
 361
 362 In the second step we iterate over all nicks that have been found and
 363 determines the most active ident for each nick. After this has been done each
 364 nick is associated with exactly one ident, but B<not> vice versa.
 365
 366 The final step is to iterate over all idents and determine the most active nick
 367 for each ident. After some thought you will agree that now each ident exists
 368 only once and so does every nick.
 369
 370 =cut
 371
 372 sub calculate_nicks
 373 {
 374         my $nicks      = {};
 375         my $idents     = {};
 376         my $name2nick  = {};
 377         my $name2ident = {};
 378
 379         for ($ChatterList->keys ())
 380         {
 381                 my $chatter = $_;
 382                 my ($nick, $ident) = split (m/!/, $chatter);
 383                 my ($counter) = $ChatterList->get ($chatter);
 384
 385                 $nicks->{$nick}{$ident} = 0 unless (defined ($nicks->{$nick}{$ident}));
 386                 $nicks->{$nick}{$ident} += $counter;
 387         }
 388
 389         for (keys %$nicks)
 390         {
 391                 my $this_nick = $_;
 392                 my $this_ident = 'unidentified';
 393                 my $this_name = '';
 394                 my $this_total = 0;
 395                 my $this_max = 0;
 396
 397                 for (keys %{$nicks->{$this_nick}})
 398                 {
 399                         my $ident = $_;
 400                         my $name = chatter_to_name ("$this_nick!$ident");
 401                         my $num = $nicks->{$this_nick}{$ident};
 402
 403                         $this_total += $num;
 404
 405                         if ($name)
 406                         {
 407                                 if (($num >= $this_max) or !$this_name)
 408                                 {
 409                                         $this_max = $num;
 410                                         $this_ident = $ident;
 411                                         $this_name = $name;
 412                                 }
 413                         }
 414                         else
 415                         {
 416                                 if (($num >= $this_max) and !$this_name)
 417                                 {
 418                                         $this_max = $num;
 419                                         $this_ident = $ident;
 420                                 }
 421                         }
 422                 }
 423
 424                 print $/, __FILE__, ": max_ident ($this_nick) = $this_ident" if ($::DEBUG & 0x100);
 425
 426                 if ($this_ident ne 'unidentified')
 427                 {
 428                         if ($this_name)
 429                         {
 430                                 $name2nick->{$this_name}{$this_nick} = 0 unless (defined ($name2nick->{$this_name}{$this_nick}));
 431                                 $name2nick->{$this_name}{$this_nick} += $this_total;
 432
 433                                 $name2ident->{$this_name}{$this_ident} = 0 unless (defined ($name2nick->{$this_name}{$this_ident}));
 434                                 $name2ident->{$this_name}{$this_ident} += $this_total;
 435                         }
 436                         else
 437                         {
 438                                 $idents->{$this_ident}{$this_nick} = 0 unless (defined ($idents->{$this_ident}{$this_nick}));
 439                                 $idents->{$this_ident}{$this_nick} += $this_total;
 440                         }
 441                 }
 442                 elsif ($::DEBUG & 0x100)
 443                 {
 444                         print STDERR $/, __FILE__, ": Ignoring unidentified nick ``$this_nick''";
 445                 }
 446         }
 447
 448         for (keys %$idents)
 449         {
 450                 my $this_ident = $_;
 451                 my $this_nick = '';
 452                 my $this_max = 0;
 453                 my @other_nicks = ();
 454
 455                 my @nicks = keys (%{$idents->{$this_ident}});
 456
 457                 for (@nicks)
 458                 {
 459                         my $nick = $_;
 460                         my $num = $idents->{$this_ident}{$nick};
 461
 462                         if ($num > $this_max)
 463                         {
 464                                 if ($this_nick) { push (@other_nicks, $this_nick); }
 465                                 $this_nick = $nick;
 466                                 $this_max = $num;
 467                         }
 468                         else
 469                         {
 470                                 push (@other_nicks, $nick);
 471                         }
 472                 }
 473
 474                 print STDERR $/, __FILE__, ": max_nick ($this_ident) = $this_nick" if ($::DEBUG & 0x100);
 475
 476                 for (@other_nicks, $this_nick)
 477                 {
 478                         push (@AllNicks, $_);
 479                         $NickToNick{$_} = $this_nick;
 480                         $NickToIdent{$_} = $this_ident;
 481                 }
 482
 483                 $IdentToNick{$this_ident} = $this_nick;
 484         }
 485
 486         for (keys %$name2nick)
 487         {
 488                 my $name = $_;
 489                 my $max_num = 0;
 490                 my $max_nick = '';
 491                 my $max_ident = '';
 492
 493                 my @other_nicks = ();
 494                 my @other_idents = ();
 495
 496                 for (keys %{$name2nick->{$name}})
 497                 {
 498                         my $nick = $_;
 499                         my $num = $name2nick->{$name}{$nick};
 500
 501                         if ($num > $max_num)
 502                         {
 503                                 push (@other_nicks, $max_nick) if ($max_nick);
 504                                 $max_nick = $nick;
 505                                 $max_num  = $num;
 506                         }
 507                         else
 508                         {
 509                                 push (@other_nicks, $nick);
 510                         }
 511                 }
 512
 513                 $max_num = 0;
 514                 for (keys %{$name2ident->{$name}})
 515                 {
 516                         my $ident = $_;
 517                         my $num = $name2ident->{$name}{$ident};
 518
 519                         if ($num > $max_num)
 520                         {
 521                                 push (@other_idents, $max_ident) if ($max_ident);
 522                                 $max_ident = $ident;
 523                                 $max_num  = $num;
 524                         }
 525                         else
 526                         {
 527                                 push (@other_idents, $ident);
 528                         }
 529                 }
 530
 531                 for (@other_nicks, $max_nick)
 532                 {
 533                         push (@AllNicks, $_);
 534                         $NickToNick{$_} = $max_nick;
 535                         $NickToIdent{$_} = $max_ident;
 536                 }
 537
 538                 for (@other_idents, $max_ident)
 539                 {
 540                         $IdentToNick{$_} = $max_nick;
 541                 }
 542         }
 543 }
 544
 545 =item I<@nicks> = B<get_all_nicks> ()
 546
 547 Returns an array of all seen nicks.
 548
 549 =cut
 550
 551 sub get_all_nicks
 552 {
 553         return (@AllNicks);
 554 }
 555
 556 =item I<$channel> = B<get_channel> ()
 557
 558 Returns the name of the channel we're generating stats for.
 559
 560 =cut
 561
 562 sub get_channel
 563 {
 564         my $chan = '#unknown';
 565         if (get_config ('channel'))
 566         {
 567                 $chan = get_config ('channel');
 568         }
 569         else
 570         {
 571                 my $max = 0;
 572                 for ($ChannelNames->keys ())
 573                 {
 574                         my $c = $_;
 575                         my ($num) = $ChannelNames->get ($c);
 576                         if (defined ($num) and ($num > $max))
 577                         {
 578                                 $max = $num;
 579                                 $chan = $c;
 580                         }
 581                 }
 582         }
 583
 584         # Fix network-safe channel named (RFC 2811)
 585         if ($chan =~ m/^![A-Z0-9]{5}(.+)/)
 586         {
 587                 $chan = '!' . $1;
 588         }
 589
 590         return ($chan);
 591 }
 592
 593 =item I<$main> = B<get_main_nick> (I<$nick>)
 594
 595 Returns the main nick for I<$nick> or an empty string if the nick is unknown..
 596
 597 =cut
 598
 599 sub get_main_nick
 600 {
 601         my $nick = shift;
 602         if (defined ($NickToNick{$nick}))
 603         {
 604                 return ($NickToNick{$nick});
 605         }
 606         else
 607         {
 608                 return ('');
 609         }
 610 }
 611
 612 =item I<$ident> = B<nick_to_ident> (I<$nick>)
 613
 614 Returns the ident for this nick or an empty string if unknown. Before
 615 B<calculate_nicks> is run it will use the database to find the most recent
 616 mapping. After B<calculate_nicks> is run the calculated mapping will be used.
 617
 618 =cut
 619
 620 sub nick_to_ident
 621 {
 622         my $nick = shift;
 623         my $ident = '';
 624
 625         if (%NickToIdent)
 626         {
 627                 if (defined ($NickToIdent{$nick}))
 628                 {
 629                         $ident = $NickToIdent{$nick};
 630                 }
 631         }
 632         else
 633         {
 634                 ($ident) = $NickToIdentCache->get ($nick);
 635                 $ident ||= '';
 636         }
 637
 638         return ($ident);
 639 }
 640
 641 =item I<$nick> = B<ident_to_nick> (I<$ident>)
 642
 643 Returns the nick for the given ident or an empty string if unknown.
 644
 645 =cut
 646
 647 sub ident_to_nick
 648 {
 649         my $ident = shift;
 650
 651         if (defined ($IdentToNick{$ident}))
 652         {
 653                 return ($IdentToNick{$ident});
 654         }
 655         else
 656         {
 657                 return ('');
 658         }
 659 }
 660
 661 =item I<$name> = B<nick_to_name> (I<$nick>)
 662
 663 Return the name associated with I<$nick>.
 664
 665 =cut
 666
 667 sub nick_to_name
 668 {
 669         my $nick = shift;
 670         my $ident = nick_to_ident ($nick);
 671
 672         if ($ident)
 673         {
 674                 return (chatter_to_name ("$nick!$ident"));
 675         }
 676         else
 677         {
 678                 return ('');
 679         }
 680 }
 681
 682 =item I<$name> = B<ident_to_name> (I<$ident>)
 683
 684 Returns the name associated with I<$ident>.
 685
 686 =cut
 687
 688 sub ident_to_name
 689 {
 690         my $ident = shift;
 691         my $nick = ident_to_nick ($ident);
 692
 693         if ($nick)
 694         {
 695                 return (chatter_to_name ("$nick!$ident"));
 696         }
 697         else
 698         {
 699                 return ('');
 700         }
 701 }
 702
 703 =item I<$lines> = B<get_total_lines> ()
 704
 705 Returns the total number of lines parsed so far.
 706
 707 =cut
 708
 709 sub get_total_lines
 710 {
 711         my ($total) = $GeneralCounters->get ('lines_total');
 712
 713         return (qw()) unless ($total);
 714
 715         return ($total, $LinesThisRun);
 716 }
 717
 718 =item I<$epoch> = B<get_most_recent_time> ()
 719
 720 Returns the epoch of the most recent line received from the parser.
 721
 722 =cut
 723
 724 sub get_most_recent_time
 725 {
 726         my ($time) = $GeneralCounters->get ('most_recent_time');
 727         $time ||= 0;
 728
 729         return ($time);
 730 }
 731
 732 =item B<nick_rename> (I<$old_nick>, I<$new_nick>)
 733
 734 Keeps track of a nick's hostname if the nick changes.
 735
 736 =cut
 737
 738 sub nick_rename
 739 {
 740         my $old_nick = shift;
 741         my $new_nick = shift;
 742         my $ident;
 743
 744         ($ident) = $NickToIdentCache->get ($old_nick);
 745
 746         if (defined ($ident) and ($ident))
 747         {
 748                 $NickToIdentCache->put ($new_nick, $ident);
 749         }
 750 }
 751
 752 =item B<print_output> ()
 753
 754 Print the output. Should be called only once..
 755
 756 =cut
 757
 758 sub print_output
 759 {
 760         my ($total, $this) = get_total_lines ();
 761
 762         if (!$total)
 763         {
 764                 print STDERR <<'MESSAGE';
 765
 766 ERROR: No data found
 767
 768 The most common reasons for this are:
 769 - The logfile used was empty.
 770 - The ``logtype'' setting did not match the logfile.
 771 - The logfile did not include a date.
 772
 773 MESSAGE
 774                 return;
 775         }
 776
 777         calculate_nicks ();
 778
 779         for (@$OutputCallbacks)
 780         {
 781                 &$_ ();
 782         }
 783 }
 784
 785 =item I<$data> = B<register_plugin> (I<$type>, I<$sub_ref>)
 786
 787 Register a subroutine for the given type. Returns a reference to the internal
 788 data object. This will change soon, don't use it anymore if possible.
 789
 790 =cut
 791
 792 sub register_plugin
 793 {
 794         my $type = shift;
 795         my $sub_ref = shift;
 796
 797         $type = uc ($type);
 798         if (ref ($sub_ref) ne "CODE")
 799         {
 800                 print STDERR $/, __FILE__, ": Plugin tried to register a non-code reference. Ignoring it.";
 801                 return (undef);
 802         }
 803
 804         if ($type eq 'OUTPUT')
 805         {
 806                 push (@$OutputCallbacks, $sub_ref);
 807         }
 808         else
 809         {
 810                 if (!defined ($PluginCallbacks->{$type}))
 811                 {
 812                         $PluginCallbacks->{$type} = [];
 813                 }
 814         }
 815
 816         push (@{$PluginCallbacks->{$type}}, $sub_ref);
 817
 818         print STDERR $/, __FILE__, ': ', scalar (caller ()), " registered for ``$type''." if ($::DEBUG & 0x800);
 819 }
 820
 821 =back
 822
 823 =head1 AUTHOR
 824
 825 Florian octo Forster E<lt>octo at verplant.orgE<gt>
 826
 827 =cut