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