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                         next if ($name eq 'ignore');
 404
 405                         $this_total += $num;
 406
 407                         if ($name)
 408                         {
 409                                 if (($num >= $this_max) or !$this_name)
 410                                 {
 411                                         $this_max = $num;
 412                                         $this_ident = $ident;
 413                                         $this_name = $name;
 414                                 }
 415                         }
 416                         else
 417                         {
 418                                 if (($num >= $this_max) and !$this_name)
 419                                 {
 420                                         $this_max = $num;
 421                                         $this_ident = $ident;
 422                                 }
 423                         }
 424                 }
 425
 426                 print $/, __FILE__, ": max_ident ($this_nick) = $this_ident" if ($::DEBUG & 0x100);
 427
 428                 if ($this_ident ne 'unidentified')
 429                 {
 430                         if ($this_name)
 431                         {
 432                                 $name2nick->{$this_name}{$this_nick} = 0 unless (defined ($name2nick->{$this_name}{$this_nick}));
 433                                 $name2nick->{$this_name}{$this_nick} += $this_total;
 434
 435                                 $name2ident->{$this_name}{$this_ident} = 0 unless (defined ($name2nick->{$this_name}{$this_ident}));
 436                                 $name2ident->{$this_name}{$this_ident} += $this_total;
 437                         }
 438                         else
 439                         {
 440                                 $idents->{$this_ident}{$this_nick} = 0 unless (defined ($idents->{$this_ident}{$this_nick}));
 441                                 $idents->{$this_ident}{$this_nick} += $this_total;
 442                         }
 443                 }
 444                 elsif ($::DEBUG & 0x100)
 445                 {
 446                         print STDERR $/, __FILE__, ": Ignoring unidentified nick ``$this_nick''";
 447                 }
 448         }
 449
 450         for (keys %$idents)
 451         {
 452                 my $this_ident = $_;
 453                 my $this_nick = '';
 454                 my $this_max = 0;
 455                 my @other_nicks = ();
 456
 457                 my @nicks = keys (%{$idents->{$this_ident}});
 458
 459                 for (@nicks)
 460                 {
 461                         my $nick = $_;
 462                         my $num = $idents->{$this_ident}{$nick};
 463
 464                         if ($num > $this_max)
 465                         {
 466                                 if ($this_nick) { push (@other_nicks, $this_nick); }
 467                                 $this_nick = $nick;
 468                                 $this_max = $num;
 469                         }
 470                         else
 471                         {
 472                                 push (@other_nicks, $nick);
 473                         }
 474                 }
 475
 476                 print STDERR $/, __FILE__, ": max_nick ($this_ident) = $this_nick" if ($::DEBUG & 0x100);
 477
 478                 for (@other_nicks, $this_nick)
 479                 {
 480                         push (@AllNicks, $_);
 481                         $NickToNick{$_} = $this_nick;
 482                         $NickToIdent{$_} = $this_ident;
 483                 }
 484
 485                 $IdentToNick{$this_ident} = $this_nick;
 486         }
 487
 488         for (keys %$name2nick)
 489         {
 490                 my $name = $_;
 491                 my $max_num = 0;
 492                 my $max_nick = '';
 493                 my $max_ident = '';
 494
 495                 my @other_nicks = ();
 496                 my @other_idents = ();
 497
 498                 for (keys %{$name2nick->{$name}})
 499                 {
 500                         my $nick = $_;
 501                         my $num = $name2nick->{$name}{$nick};
 502
 503                         if ($num > $max_num)
 504                         {
 505                                 push (@other_nicks, $max_nick) if ($max_nick);
 506                                 $max_nick = $nick;
 507                                 $max_num  = $num;
 508                         }
 509                         else
 510                         {
 511                                 push (@other_nicks, $nick);
 512                         }
 513                 }
 514
 515                 $max_num = 0;
 516                 for (keys %{$name2ident->{$name}})
 517                 {
 518                         my $ident = $_;
 519                         my $num = $name2ident->{$name}{$ident};
 520
 521                         if ($num > $max_num)
 522                         {
 523                                 push (@other_idents, $max_ident) if ($max_ident);
 524                                 $max_ident = $ident;
 525                                 $max_num  = $num;
 526                         }
 527                         else
 528                         {
 529                                 push (@other_idents, $ident);
 530                         }
 531                 }
 532
 533                 for (@other_nicks, $max_nick)
 534                 {
 535                         push (@AllNicks, $_);
 536                         $NickToNick{$_} = $max_nick;
 537                         $NickToIdent{$_} = $max_ident;
 538                 }
 539
 540                 for (@other_idents, $max_ident)
 541                 {
 542                         $IdentToNick{$_} = $max_nick;
 543                 }
 544         }
 545 }
 546
 547 =item I<@nicks> = B<get_all_nicks> ()
 548
 549 Returns an array of all seen nicks.
 550
 551 =cut
 552
 553 sub get_all_nicks
 554 {
 555         return (@AllNicks);
 556 }
 557
 558 =item I<$channel> = B<get_channel> ()
 559
 560 Returns the name of the channel we're generating stats for.
 561
 562 =cut
 563
 564 sub get_channel
 565 {
 566         my $chan = '#unknown';
 567         if (get_config ('channel'))
 568         {
 569                 $chan = get_config ('channel');
 570         }
 571         else
 572         {
 573                 my $max = 0;
 574                 for ($ChannelNames->keys ())
 575                 {
 576                         my $c = $_;
 577                         my ($num) = $ChannelNames->get ($c);
 578                         if (defined ($num) and ($num > $max))
 579                         {
 580                                 $max = $num;
 581                                 $chan = $c;
 582                         }
 583                 }
 584         }
 585
 586         # Fix network-safe channel named (RFC 2811)
 587         if ($chan =~ m/^![A-Z0-9]{5}(.+)/)
 588         {
 589                 $chan = '!' . $1;
 590         }
 591
 592         return ($chan);
 593 }
 594
 595 =item I<$main> = B<get_main_nick> (I<$nick>)
 596
 597 Returns the main nick for I<$nick> or an empty string if the nick is unknown..
 598
 599 =cut
 600
 601 sub get_main_nick
 602 {
 603         my $nick = shift;
 604         if (defined ($NickToNick{$nick}))
 605         {
 606                 return ($NickToNick{$nick});
 607         }
 608         else
 609         {
 610                 return ('');
 611         }
 612 }
 613
 614 =item I<$ident> = B<nick_to_ident> (I<$nick>)
 615
 616 Returns the ident for this nick or an empty string if unknown. Before
 617 B<calculate_nicks> is run it will use the database to find the most recent
 618 mapping. After B<calculate_nicks> is run the calculated mapping will be used.
 619
 620 =cut
 621
 622 sub nick_to_ident
 623 {
 624         my $nick = shift;
 625         my $ident = '';
 626
 627         if (%NickToIdent)
 628         {
 629                 if (defined ($NickToIdent{$nick}))
 630                 {
 631                         $ident = $NickToIdent{$nick};
 632                 }
 633         }
 634         else
 635         {
 636                 ($ident) = $NickToIdentCache->get ($nick);
 637                 $ident ||= '';
 638         }
 639
 640         return ($ident);
 641 }
 642
 643 =item I<$nick> = B<ident_to_nick> (I<$ident>)
 644
 645 Returns the nick for the given ident or an empty string if unknown.
 646
 647 =cut
 648
 649 sub ident_to_nick
 650 {
 651         my $ident = shift;
 652
 653         if (defined ($IdentToNick{$ident}))
 654         {
 655                 return ($IdentToNick{$ident});
 656         }
 657         else
 658         {
 659                 return ('');
 660         }
 661 }
 662
 663 =item I<$name> = B<nick_to_name> (I<$nick>)
 664
 665 Return the name associated with I<$nick>.
 666
 667 =cut
 668
 669 sub nick_to_name
 670 {
 671         my $nick = shift;
 672         my $ident = nick_to_ident ($nick);
 673
 674         if ($ident)
 675         {
 676                 return (chatter_to_name ("$nick!$ident"));
 677         }
 678         else
 679         {
 680                 return ('');
 681         }
 682 }
 683
 684 =item I<$name> = B<ident_to_name> (I<$ident>)
 685
 686 Returns the name associated with I<$ident>.
 687
 688 =cut
 689
 690 sub ident_to_name
 691 {
 692         my $ident = shift;
 693         my $nick = ident_to_nick ($ident);
 694
 695         if ($nick)
 696         {
 697                 return (chatter_to_name ("$nick!$ident"));
 698         }
 699         else
 700         {
 701                 return ('');
 702         }
 703 }
 704
 705 =item I<$lines> = B<get_total_lines> ()
 706
 707 Returns the total number of lines parsed so far.
 708
 709 =cut
 710
 711 sub get_total_lines
 712 {
 713         my ($total) = $GeneralCounters->get ('lines_total');
 714
 715         return (qw()) unless ($total);
 716
 717         return ($total, $LinesThisRun);
 718 }
 719
 720 =item I<$epoch> = B<get_most_recent_time> ()
 721
 722 Returns the epoch of the most recent line received from the parser.
 723
 724 =cut
 725
 726 sub get_most_recent_time
 727 {
 728         my ($time) = $GeneralCounters->get ('most_recent_time');
 729         $time ||= 0;
 730
 731         return ($time);
 732 }
 733
 734 =item B<nick_rename> (I<$old_nick>, I<$new_nick>)
 735
 736 Keeps track of a nick's hostname if the nick changes.
 737
 738 =cut
 739
 740 sub nick_rename
 741 {
 742         my $old_nick = shift;
 743         my $new_nick = shift;
 744         my $ident;
 745
 746         ($ident) = $NickToIdentCache->get ($old_nick);
 747
 748         if (defined ($ident) and ($ident))
 749         {
 750                 $NickToIdentCache->put ($new_nick, $ident);
 751         }
 752 }
 753
 754 =item B<print_output> ()
 755
 756 Print the output. Should be called only once..
 757
 758 =cut
 759
 760 sub print_output
 761 {
 762         my ($total, $this) = get_total_lines ();
 763
 764         if (!$total)
 765         {
 766                 print STDERR <<'MESSAGE';
 767
 768 ERROR: No data found
 769
 770 The most common reasons for this are:
 771 - The logfile used was empty.
 772 - The ``logtype'' setting did not match the logfile.
 773 - The logfile did not include a date.
 774
 775 MESSAGE
 776                 return;
 777         }
 778
 779         calculate_nicks ();
 780
 781         for (@$OutputCallbacks)
 782         {
 783                 &$_ ();
 784         }
 785 }
 786
 787 =item I<$data> = B<register_plugin> (I<$type>, I<$sub_ref>)
 788
 789 Register a subroutine for the given type. Returns a reference to the internal
 790 data object. This will change soon, don't use it anymore if possible.
 791
 792 =cut
 793
 794 sub register_plugin
 795 {
 796         my $type = shift;
 797         my $sub_ref = shift;
 798
 799         $type = uc ($type);
 800         if (ref ($sub_ref) ne "CODE")
 801         {
 802                 print STDERR $/, __FILE__, ": Plugin tried to register a non-code reference. Ignoring it.";
 803                 return (undef);
 804         }
 805
 806         if ($type eq 'OUTPUT')
 807         {
 808                 push (@$OutputCallbacks, $sub_ref);
 809         }
 810         else
 811         {
 812                 if (!defined ($PluginCallbacks->{$type}))
 813                 {
 814                         $PluginCallbacks->{$type} = [];
 815                 }
 816         }
 817
 818         push (@{$PluginCallbacks->{$type}}, $sub_ref);
 819
 820         print STDERR $/, __FILE__, ': ', scalar (caller ()), " registered for ``$type''." if ($::DEBUG & 0x800);
 821 }
 822
 823 =back
 824
 825 =head1 AUTHOR
 826
 827 Florian octo Forster E<lt>octo at verplant.orgE<gt>
 828
 829 =cut