[23:40] <@_charly__> octo: naja, auf alle faelle hast du in debian/rules im clean...
[onis.git] / lib / Onis / Data / Core.pm
index 6e33224..c47af2f 100644 (file)
@@ -16,7 +16,7 @@ use warnings;
 
 use Exporter;
 use Onis::Config qw(get_config);
-use Onis::Users qw(ident_to_name);
+use Onis::Users qw(chatter_to_name);
 use Onis::Data::Persistent;
 use Onis::Parser::Persistent qw(get_absolute_time);
 
@@ -34,7 +34,8 @@ the F<users.conf> defines a mapping of B<chatter> -E<gt> B<name>.
 
 =cut
 
-our $Nick2Ident   = Onis::Data::Persistent->new ('Nick2Ident', 'nick', 'ident');
+our $GeneralCounters  = Onis::Data::Persistent->new ('GeneralCounters', 'key', 'value');
+our $NickToIdentCache = Onis::Data::Persistent->new ('NickToIdentCache', 'nick', 'ident');
 our $ChatterList  = Onis::Data::Persistent->new ('ChatterList', 'chatter', 'counter');
 our $ChannelNames = Onis::Data::Persistent->new ('ChannelNames', 'channel', 'counter');
 
@@ -42,25 +43,61 @@ our $ChannelNames = Onis::Data::Persistent->new ('ChannelNames', 'channel', 'cou
 qw(
        store unsharp calculate_nicks 
 
-       get_all_nicks get_channel get_main_nick nick_to_ident ident_to_nick
-       get_total_lines nick_rename print_output register_plugin merge_idents
+       get_all_nicks get_channel get_main_nick
+       nick_to_ident ident_to_nick
+       nick_to_name ident_to_name
+       get_total_lines get_most_recent_time nick_rename print_output register_plugin
 );
 @Onis::Data::Core::ISA = ('Exporter');
 
-our $DATA = init ('$DATA', 'hash');
+our $LinesThisRun = 0;
 
 our $PluginCallbacks = {};
-our $OUTPUT   = [];
+our $OutputCallbacks = [];
 our @AllNicks = ();
-our @ALLNAMES = ();
 
 our %NickToNick = ();
 our %NickToIdent = ();
 our %IdentToNick = ();
 
-our $LASTRUN_DAYS = 0;
+=head1 CONFIGURATION OPTIONS
 
+=over 4
+
+=item B<unsharp>: I<medium>;
+
+Sets the amount of unsharping onis should do. Valid options are I<none>,
+I<light>, I<medium> and I<hard>.
+
+=over 4
+
+=item I<none>
+
+does not do any unsharping.
+
+=item I<light>
 
+Leaves IP-addresses as they are. The deepest subdomains containing numbers have
+those numbers removed. So C<dsl-084-056-107-131.arcor-ip.net> becomes
+C<dsl-*-*-*-*.arcor-ip.net>.
+
+=item I<medium>
+
+Removes the last byte from IP-adresses. So C<84.56.107.131> becomes
+C<84.56.107.*>. Hostnames have the deepest subdomains removed if they contain
+numers, so C<dsl-084-056-107-131.arcor-ip.net> becomes C<*.arcor-ip.net> while
+C<shell.franken.de> is not modified. This is the default and recommended
+behavior.
+
+=item I<hard>
+
+Handles IP-addresses as I<medium>. Hostnames have all subdomains removed, so
+C<p5493EC60.dip.t-dialin.net> becomes C<*.t-dialin.net> and C<shell.franken.de>
+becomes C<*.franken.de>.
+
+=back
+
+=cut
 
 our $UNSHARP = 'MEDIUM';
 if (get_config ('unsharp'))
@@ -82,32 +119,19 @@ if (get_config ('unsharp'))
        }
 }
 
-if (!%$DATA)
-{
-               $DATA->{'idents_of_nick'} = {};
-               $DATA->{'channel'} = {};
-               $DATA->{'total_lines'} = 0;
-}
+=item B<channel>: I<name>;
 
-if (defined ($DATA->{'lastrun'}))
-{
-       my $last = $DATA->{'lastrun'};
-       my $now  = time;
+Sets the name of the channel. This is mostly automatically figured out, use
+this if onis doesn't get it right or you want another name..
 
-       my $diff = ($now - $last) % 86400;
+=back
 
-       if ($diff > 0)
-       {
-               $DATA->{'lastrun'} = $now;
-               $LASTRUN_DAYS = $diff;
-       }
-}
-else
-{
-       $DATA->{'lastrun'} = time;
-}
+=cut
 
-my $VERSION = '$Id: Core.pm,v 1.14 2004/10/31 15:00:32 octo Exp $';
+# TODO
+# - lastrun
+
+my $VERSION = '$Id$';
 print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);
 
 return (1);
@@ -160,16 +184,17 @@ sub store
                $data->{'user'} = $user;
                $data->{'ident'} = $ident;
                
-               $Nick2Ident->put ($nick, $ident);
+               $NickToIdentCache->put ($nick, $ident);
 
                $chatter = "$nick!$ident";
                ($counter) = $ChatterList->get ($chatter);
                $counter ||= 0; $counter++;
                $ChatterList->put ($chatter, $counter);
        }
-       elsif (($ident) = $Nick2Ident->get ($nick))
+       elsif (($ident) = $NickToIdentCache->get ($nick))
        {
                my $chatter = "$nick!$ident";
+               my $counter;
                ($user, $host) = split (m/@/, $ident);
 
                $data->{'host'} = $host;
@@ -217,8 +242,19 @@ sub store
                }
        }
 
-       # FIXME
-       #$DATA->{'total_lines'}++;
+       {
+               my ($counter) = $GeneralCounters->get ('lines_total');
+               $counter ||= 0;
+               $counter++;
+               $GeneralCounters->put ('lines_total', $counter);
+
+               my ($time) = $GeneralCounters->get ('most_recent_time');
+               $time ||= 0;
+               $time = $data->{'epoch'} if ($time < $data->{'epoch'});
+               $GeneralCounters->put ('most_recent_time', $time);
+
+               $LinesThisRun++;
+       }
 
        if (defined ($PluginCallbacks->{$type}))
        {
@@ -237,8 +273,6 @@ Takes an ident (i.e. a user-host-pair, e.g. I<user@host.domain.com> or
 I<login@123.123.123.123>) and "unsharps it". The unsharp version is then
 returned.
 
-What unsharp exactly does is described in the F<README>.
-
 =cut
 
 sub unsharp
@@ -344,13 +378,12 @@ sub calculate_nicks
        
        for ($ChatterList->keys ())
        {
-               my $chatter = shift;
+               my $chatter = $_;
                my ($nick, $ident) = split (m/!/, $chatter);
-               my $name = ident_to_name ($ident);
                my ($counter) = $ChatterList->get ($chatter);
 
-               $nicks->{$nick}{$temp} = 0 unless (defined ($nicks->{$nick}{$temp}));
-               $nicks->{$nick}{$temp} += $counter;
+               $nicks->{$nick}{$ident} = 0 unless (defined ($nicks->{$nick}{$ident}));
+               $nicks->{$nick}{$ident} += $counter;
        }
 
        for (keys %$nicks)
@@ -364,7 +397,7 @@ sub calculate_nicks
                for (keys %{$nicks->{$this_nick}})
                {
                        my $ident = $_;
-                       my $name = ident_to_name ($ident);
+                       my $name = chatter_to_name ("$this_nick!$ident");
                        my $num = $nicks->{$this_nick}{$ident};
                        
                        $this_total += $num;
@@ -392,12 +425,12 @@ sub calculate_nicks
 
                if ($this_ident ne 'unidentified')
                {
-                       if ($name)
+                       if ($this_name)
                        {
-                               $name2nick->{$this_name}{$this_nick} = 0 unless (defined ($names->{$this_name}{$this_nick}));
+                               $name2nick->{$this_name}{$this_nick} = 0 unless (defined ($name2nick->{$this_name}{$this_nick}));
                                $name2nick->{$this_name}{$this_nick} += $this_total;
 
-                               $name2ident->{$this_name}{$this_ident} = 0 unless (defined ($names->{$this_name}{$this_ident}));
+                               $name2ident->{$this_name}{$this_ident} = 0 unless (defined ($name2nick->{$this_name}{$this_ident}));
                                $name2ident->{$this_name}{$this_ident} += $this_total;
                        }
                        else
@@ -528,8 +561,7 @@ Returns the name of the channel we're generating stats for.
 
 sub get_channel
 {
-       my $chan = '#unknown'
-       ;
+       my $chan = '#unknown';
        if (get_config ('channel'))
        {
                $chan = get_config ('channel');
@@ -550,9 +582,9 @@ sub get_channel
        }
 
        # Fix network-safe channel named (RFC 2811)
-       if ($chan =~ m/^![A-Z0-9]{5}.+/)
+       if ($chan =~ m/^![A-Z0-9]{5}(.+)/)
        {
-               $chan =~ s/[A-Z0-9]{5}//;
+               $chan = '!' . $1;
        }
 
        return ($chan);
@@ -599,7 +631,7 @@ sub nick_to_ident
        }
        else
        {
-               ($ident) = $Nick2Ident->get ($nick);
+               ($ident) = $NickToIdentCache->get ($nick);
                $ident ||= '';
        }
 
@@ -626,6 +658,48 @@ sub ident_to_nick
        }
 }
 
+=item I<$name> = B<nick_to_name> (I<$nick>)
+
+Return the name associated with I<$nick>.
+
+=cut
+
+sub nick_to_name
+{
+       my $nick = shift;
+       my $ident = nick_to_ident ($nick);
+
+       if ($ident)
+       {
+               return (chatter_to_name ("$nick!$ident"));
+       }
+       else
+       {
+               return ('');
+       }
+}
+
+=item I<$name> = B<ident_to_name> (I<$ident>)
+
+Returns the name associated with I<$ident>.
+
+=cut
+
+sub ident_to_name
+{
+       my $ident = shift;
+       my $nick = ident_to_nick ($ident);
+
+       if ($nick)
+       {
+               return (chatter_to_name ("$nick!$ident"));
+       }
+       else
+       {
+               return ('');
+       }
+}
+
 =item I<$lines> = B<get_total_lines> ()
 
 Returns the total number of lines parsed so far.
@@ -634,7 +708,25 @@ Returns the total number of lines parsed so far.
 
 sub get_total_lines
 {
-       return ($DATA->{'total_lines'});
+       my ($total) = $GeneralCounters->get ('lines_total');
+
+       return (qw()) unless ($total);
+       
+       return ($total, $LinesThisRun);
+}
+
+=item I<$epoch> = B<get_most_recent_time> ()
+
+Returns the epoch of the most recent line received from the parser.
+
+=cut
+
+sub get_most_recent_time
+{
+       my ($time) = $GeneralCounters->get ('most_recent_time');
+       $time ||= 0;
+
+       return ($time);
 }
 
 =item B<nick_rename> (I<$old_nick>, I<$new_nick>)
@@ -649,11 +741,11 @@ sub nick_rename
        my $new_nick = shift;
        my $ident;
 
-       ($ident) = $Nick2Ident->get ($old_nick);
+       ($ident) = $NickToIdentCache->get ($old_nick);
 
        if (defined ($ident) and ($ident))
        {
-               $Nick2Ident->put ($new_nick, $ident);
+               $NickToIdentCache->put ($new_nick, $ident);
        }
 }
 
@@ -665,7 +757,9 @@ Print the output. Should be called only once..
 
 sub print_output
 {
-       if (!$DATA->{'total_lines'})
+       my ($total, $this) = get_total_lines ();
+
+       if (!$total)
        {
                print STDERR <<'MESSAGE';
 
@@ -681,14 +775,11 @@ MESSAGE
        }
        
        calculate_nicks ();
-       merge_idents ();
 
-       for (@$OUTPUT)
+       for (@$OutputCallbacks)
        {
                &$_ ();
        }
-
-       delete ($DATA->{'byname'});
 }
 
 =item I<$data> = B<register_plugin> (I<$type>, I<$sub_ref>)
@@ -712,7 +803,7 @@ sub register_plugin
 
        if ($type eq 'OUTPUT')
        {
-               push (@$OUTPUT, $sub_ref);
+               push (@$OutputCallbacks, $sub_ref);
        }
        else
        {
@@ -727,97 +818,6 @@ sub register_plugin
        print STDERR $/, __FILE__, ': ', scalar (caller ()), " registered for ``$type''." if ($::DEBUG & 0x800);
 }
 
-=item B<merge_idents> ()
-
-Merges idents. Does magic, don't interfere ;)
-
-=cut
-
-sub merge_idents
-{
-       my @idents = keys (%IdentToNick);
-
-       for (@idents)
-       {
-               my $ident = $_;
-               my $name = ident_to_name ($ident);
-
-               if (!defined ($DATA->{'byident'}{$ident}))
-               {
-                       next;
-               }
-               
-               if (!defined ($DATA->{'byname'}{$name}))
-               {
-                       $DATA->{'byname'}{$name} = {};
-               }
-
-               add_hash ($DATA->{'byname'}{$name}, $DATA->{'byident'}{$ident});
-       }
-}
-
-sub add_hash
-{
-       my $dst = shift;
-       my $src = shift;
-
-       my @keys = keys (%$src);
-
-       for (@keys)
-       {
-               my $key = $_;
-               my $val = $src->{$key};
-
-               if (!defined ($dst->{$key}))
-               {
-                       $dst->{$key} = $val;
-               }
-               elsif (!ref ($val))
-               {
-                       if ($val =~ m/\D/)
-                       {
-                               # FIXME
-                               print STDERR $/, __FILE__, ": ``$key'' = ``$val''" if ($::DEBUG);
-                       }
-                       else
-                       {
-                               $dst->{$key} += $val;
-                       }
-               }
-               elsif (ref ($val) ne ref ($dst->{$key}))
-               {
-                       print STDERR $/, __FILE__, ": Destination and source type do not match!" if ($::DEBUG);
-               }
-               elsif (ref ($val) eq "HASH")
-               {
-                       add_hash ($dst->{$key}, $val);
-               }
-               elsif (ref ($val) eq "ARRAY")
-               {
-                       my $i = 0;
-                       for (@$val)
-                       {
-                               my $j = $_;
-                               if ($j =~ m/\D/)
-                               {
-                                       # FIXME
-                                       print STDERR $/, __FILE__, ": ``", $key, '[', $i, "]'' = ``$j''" if ($::DEBUG);
-                               }
-                               else
-                               {
-                                       $dst->{$key}->[$i] += $j;
-                               }
-                               $i++;
-                       }
-               }
-               else
-               {
-                       my $type = ref ($val);
-                       print STDERR $/, __FILE__, ": Reference type ``$type'' is not supported!", $/;
-               }
-       }
-}
-
 =back
 
 =head1 AUTHOR