Fixed syntactic errors in Onis::Plugins::Core, Onis::Data::Persistent::None, Onis...

[onis.git] / lib / Onis / Data / Core.pm

diff --git a/lib/Onis/Data/Core.pm b/lib/Onis/Data/Core.pm
index b15ba95..e505dc4 100644 (file)
--- a/lib/Onis/Data/Core.pm
+++ b/lib/Onis/Data/Core.pm
@@ -15,9 +15,10 @@ use strict;
 use warnings;
 
 use Exporter;
 use warnings;
 
 use Exporter;

-use Onis::Config qw#get_config#;
-use Onis::Users qw#host_to_username nick_to_username#;
+use Onis::Config qw(get_config);
+use Onis::Users qw(ident_to_name);

 use Onis::Data::Persistent;
 use Onis::Data::Persistent;

+use Onis::Parser::Persistent qw(get_absolute_time);

 
 =head1 NAMING CONVENTION
 
 
 =head1 NAMING CONVENTION
 


@@ -37,25 +38,24 @@ our $Nick2Ident   = Onis::Data::Persistent->new ('Nick2Ident', 'nick', 'ident');
 our $ChatterList  = Onis::Data::Persistent->new ('ChatterList', 'chatter', 'counter');
 our $ChannelNames = Onis::Data::Persistent->new ('ChannelNames', 'channel', 'counter');
 
 our $ChatterList  = Onis::Data::Persistent->new ('ChatterList', 'chatter', 'counter');
 our $ChannelNames = Onis::Data::Persistent->new ('ChannelNames', 'channel', 'counter');
 

+@Onis::Data::Core::EXPORT_OK =
+qw(
+       store unsharp calculate_nicks 

 
 

-
-@Onis::Data::Core::EXPORT_OK = qw#all_nicks get_channel
-       nick_to_ident
-       ident_to_nick ident_to_name
-       get_main_nick
-       get_total_lines nick_rename print_output
-       register_plugin store get_print_name#;
+       get_all_nicks get_channel get_main_nick nick_to_ident ident_to_nick
+       get_total_lines nick_rename print_output register_plugin
+);

 @Onis::Data::Core::ISA = ('Exporter');
 
 @Onis::Data::Core::ISA = ('Exporter');
 

-our $DATA = init ('$DATA', 'hash');
-

 our $PluginCallbacks = {};
 our $OUTPUT   = [];
 our @AllNicks = ();
 our @ALLNAMES = ();
 our $PluginCallbacks = {};
 our $OUTPUT   = [];
 our @AllNicks = ();
 our @ALLNAMES = ();

-our %NickMap = ();
+
+our %NickToNick = ();

 our %NickToIdent = ();
 our %NickToIdent = ();

-our %IDENT2NICK = ();
+our %IdentToNick = ();
+

 our $LASTRUN_DAYS = 0;
 
 
 our $LASTRUN_DAYS = 0;
 
 


@@ -80,30 +80,9 @@ if (get_config ('unsharp'))
        }
 }
 
        }
 }
 

-if (!%$DATA)
-{
-               $DATA->{'idents_of_nick'} = {};
-               $DATA->{'channel'} = {};
-               $DATA->{'total_lines'} = 0;
-}
-
-if (defined ($DATA->{'lastrun'}))
-{
-       my $last = $DATA->{'lastrun'};
-       my $now  = time;
-
-       my $diff = ($now - $last) % 86400;
-
-       if ($diff > 0)
-       {
-               $DATA->{'lastrun'} = $now;
-               $LASTRUN_DAYS = $diff;
-       }
-}
-else
-{
-       $DATA->{'lastrun'} = time;
-}
+# TODO
+# - lastrun
+# - total lines

 
 my $VERSION = '$Id: Core.pm,v 1.14 2004/10/31 15:00:32 octo Exp $';
 print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);
 
 my $VERSION = '$Id: Core.pm,v 1.14 2004/10/31 15:00:32 octo Exp $';
 print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);


@@ -168,6 +147,7 @@ sub store
        elsif (($ident) = $Nick2Ident->get ($nick))
        {
                my $chatter = "$nick!$ident";
        elsif (($ident) = $Nick2Ident->get ($nick))
        {
                my $chatter = "$nick!$ident";

+               my $counter;

                ($user, $host) = split (m/@/, $ident);
 
                $data->{'host'} = $host;
                ($user, $host) = split (m/@/, $ident);
 
                $data->{'host'} = $host;


@@ -198,6 +178,11 @@ sub store
                $ChannelNames->put ($chan, $count);
        }
 
                $ChannelNames->put ($chan, $count);
        }
 

+       if (!defined ($data->{'epoch'}))
+       {
+               $data->{'epoch'} = get_absolute_time ();
+       }
+

        if ($::DEBUG & 0x400)
        {
                my @keys = keys (%$data);
        if ($::DEBUG & 0x400)
        {
                my @keys = keys (%$data);


@@ -210,6 +195,7 @@ sub store
                }
        }
 
                }
        }
 

+       # TODO

        #$DATA->{'total_lines'}++;
 
        if (defined ($PluginCallbacks->{$type}))
        #$DATA->{'total_lines'}++;
 
        if (defined ($PluginCallbacks->{$type}))


@@ -307,7 +293,7 @@ sub unsharp
 
 Iterates over all chatters found so far, trying to figure out which belong to
 the same person. This function has to be called before any calls to
 
 Iterates over all chatters found so far, trying to figure out which belong to
 the same person. This function has to be called before any calls to

-B<all_nicks>, B<get_main_nick>, B<get_print_name> and B<nick_to_ident>.
+B<get_all_nicks>, B<get_main_nick>, B<get_print_name> and B<nick_to_ident>.

 
 This is normally the step after having parsed all files and before doing any
 output. After this function has been run all the other informative functions
 
 This is normally the step after having parsed all files and before doing any
 output. After this function has been run all the other informative functions


@@ -329,49 +315,50 @@ only once and so does every nick.
 
 sub calculate_nicks
 {
 
 sub calculate_nicks
 {

-       my $nicks  = {};
-       my $idents = {};
+       my $nicks      = {};
+       my $idents     = {};
+       my $name2nick  = {};
+       my $name2ident = {};

        
        for ($ChatterList->keys ())
        {
                my $chatter = shift;
                my ($nick, $ident) = split (m/!/, $chatter);
        
        for ($ChatterList->keys ())
        {
                my $chatter = shift;
                my ($nick, $ident) = split (m/!/, $chatter);

-               my $name = host_to_username ($chatter);
+               my $name = ident_to_name ($ident);

                my ($counter) = $ChatterList->get ($chatter);
 
                my ($counter) = $ChatterList->get ($chatter);
 

-               my $temp = $name ? $name : $ident;
-
-               $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)
        {
                my $this_nick = $_;
                my $this_ident = 'unidentified';
        }
 
        for (keys %$nicks)
        {
                my $this_nick = $_;
                my $this_ident = 'unidentified';

+               my $this_name = '';

                my $this_total = 0;
                my $this_max = 0;
                my $this_total = 0;
                my $this_max = 0;

-               my $this_ident_is_user = 0;

 
                for (keys %{$nicks->{$this_nick}})
                {
                        my $ident = $_;
 
                for (keys %{$nicks->{$this_nick}})
                {
                        my $ident = $_;

+                       my $name = ident_to_name ($ident);

                        my $num = $nicks->{$this_nick}{$ident};
                        
                        $this_total += $num;
 
                        my $num = $nicks->{$this_nick}{$ident};
                        
                        $this_total += $num;
 

-                       if ($ident =~ m/@/) # $ident is a (user)name
+                       if ($name)

                        {
                        {

-                               if (($num >= $this_max) or !$this_ident_is_user)
+                               if (($num >= $this_max) or !$this_name)

                                {
                                        $this_max = $num;
                                        $this_ident = $ident;
                                {
                                        $this_max = $num;
                                        $this_ident = $ident;

-                                       $this_ident_is_user = 1;
+                                       $this_name = $name;

                                }
                        }
                        else
                        {
                                }
                        }
                        else
                        {

-                               if (($num >= $this_max) and !$this_ident_is_user)
+                               if (($num >= $this_max) and !$this_name)

                                {
                                        $this_max = $num;
                                        $this_ident = $ident;
                                {
                                        $this_max = $num;
                                        $this_ident = $ident;


@@ -383,8 +370,19 @@ sub calculate_nicks
 
                if ($this_ident ne 'unidentified')
                {
 
                if ($this_ident ne 'unidentified')
                {

-                       $idents->{$this_ident}{$this_nick} = 0 unless (defined ($idents->{$this_ident}{$this_nick}));
-                       $idents->{$this_ident}{$this_nick} += $this_total;
+                       if ($this_name)
+                       {
+                               $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 ($name2nick->{$this_name}{$this_ident}));
+                               $name2ident->{$this_name}{$this_ident} += $this_total;
+                       }
+                       else
+                       {
+                               $idents->{$this_ident}{$this_nick} = 0 unless (defined ($idents->{$this_ident}{$this_nick}));
+                               $idents->{$this_ident}{$this_nick} += $this_total;
+                       }

                }
                elsif ($::DEBUG & 0x100)
                {
                }
                elsif ($::DEBUG & 0x100)
                {


@@ -404,7 +402,7 @@ sub calculate_nicks
                for (@nicks)
                {
                        my $nick = $_;
                for (@nicks)
                {
                        my $nick = $_;

-                       my $num = $nicks_of_ident->{$this_ident}{$nick};
+                       my $num = $idents->{$this_ident}{$nick};

 
                        if ($num > $this_max)
                        {
 
                        if ($num > $this_max)
                        {


@@ -423,21 +421,79 @@ sub calculate_nicks
                for (@other_nicks, $this_nick)
                {
                        push (@AllNicks, $_);
                for (@other_nicks, $this_nick)
                {
                        push (@AllNicks, $_);

-                       $NickMap{$_} = $this_nick;
+                       $NickToNick{$_} = $this_nick;

                        $NickToIdent{$_} = $this_ident;
                }
 
                        $NickToIdent{$_} = $this_ident;
                }
 

-               $IDENT2NICK{$this_ident} = $this_nick;
+               $IdentToNick{$this_ident} = $this_nick;
+       }
+
+       for (keys %$name2nick)
+       {
+               my $name = $_;
+               my $max_num = 0;
+               my $max_nick = '';
+               my $max_ident = '';
+
+               my @other_nicks = ();
+               my @other_idents = ();
+
+               for (keys %{$name2nick->{$name}})
+               {
+                       my $nick = $_;
+                       my $num = $name2nick->{$name}{$nick};
+
+                       if ($num > $max_num)
+                       {
+                               push (@other_nicks, $max_nick) if ($max_nick);
+                               $max_nick = $nick;
+                               $max_num  = $num;
+                       }
+                       else
+                       {
+                               push (@other_nicks, $nick);
+                       }
+               }
+
+               $max_num = 0;
+               for (keys %{$name2ident->{$name}})
+               {
+                       my $ident = $_;
+                       my $num = $name2ident->{$name}{$ident};
+
+                       if ($num > $max_num)
+                       {
+                               push (@other_idents, $max_ident) if ($max_ident);
+                               $max_ident = $ident;
+                               $max_num  = $num;
+                       }
+                       else
+                       {
+                               push (@other_idents, $ident);
+                       }
+               }
+
+               for (@other_nicks, $max_nick)
+               {
+                       push (@AllNicks, $_);
+                       $NickToNick{$_} = $max_nick;
+                       $NickToIdent{$_} = $max_ident;
+               }
+
+               for (@other_idents, $max_ident)
+               {
+                       $IdentToNick{$_} = $max_nick;
+               }

        }
 }
 
        }
 }
 

-=item I<@nicks> = B<all_nicks> ()
+=item I<@nicks> = B<get_all_nicks> ()

 
 Returns an array of all seen nicks.
 
 =cut
 
 
 Returns an array of all seen nicks.
 
 =cut
 

-sub all_nicks
+sub get_all_nicks

 {
        return (@AllNicks);
 }
 {
        return (@AllNicks);
 }


@@ -450,21 +506,25 @@ Returns the name of the channel we're generating stats for.
 
 sub get_channel
 {
 
 sub get_channel
 {

-       my $chan;
+       my $chan = '#unknown'
+       ;

        if (get_config ('channel'))
        {
                $chan = get_config ('channel');
        }
        if (get_config ('channel'))
        {
                $chan = get_config ('channel');
        }

-       elsif (keys (%{$DATA->{'channel'}}))
-       {
-               ($chan) = sort
-               {
-                       $DATA->{'channel'}{$b} <=> $DATA->{'channel'}{$a}
-               } (keys (%{$DATA->{'channel'}}));
-       }

        else
        {
        else
        {

-               $chan = '#unknown';
+               my $max = 0;
+               for ($ChannelNames->keys ())
+               {
+                       my $c = $_;
+                       my ($num) = $ChannelNames->get ($c);
+                       if (defined ($num) and ($num > $max))
+                       {
+                               $max = $num;
+                               $chan = $c;
+                       }
+               }

        }
 
        # Fix network-safe channel named (RFC 2811)
        }
 
        # Fix network-safe channel named (RFC 2811)


@@ -485,9 +545,9 @@ Returns the main nick for I<$nick> or an empty string if the nick is unknown..
 sub get_main_nick
 {
        my $nick = shift;
 sub get_main_nick
 {
        my $nick = shift;

-       if (defined ($NickMap{$nick}))
+       if (defined ($NickToNick{$nick}))

        {
        {

-               return ($NickMap{$nick});
+               return ($NickToNick{$nick});

        }
        else
        {
        }
        else
        {


@@ -497,21 +557,31 @@ sub get_main_nick
 
 =item I<$ident> = B<nick_to_ident> (I<$nick>)
 
 
 =item I<$ident> = B<nick_to_ident> (I<$nick>)
 

-Returns the ident for this nick or an empty string if unknown.
+Returns the ident for this nick or an empty string if unknown. Before
+B<calculate_nicks> is run it will use the database to find the most recent
+mapping. After B<calculate_nicks> is run the calculated mapping will be used.

 
 =cut
 
 sub nick_to_ident
 {
        my $nick = shift;
 
 =cut
 
 sub nick_to_ident
 {
        my $nick = shift;

-       if (defined ($NickToIdent{$nick}))
+       my $ident = '';
+
+       if (%NickToIdent)

        {
        {

-               return ($NickToIdent{$nick});
+               if (defined ($NickToIdent{$nick}))
+               {
+                       $ident = $NickToIdent{$nick};
+               }

        }
        else
        {
        }
        else
        {

-               return ('');
+               ($ident) = $Nick2Ident->get ($nick);
+               $ident ||= '';

        }
        }

+
+       return ($ident);

 }
 
 =item I<$nick> = B<ident_to_nick> (I<$ident>)
 }
 
 =item I<$nick> = B<ident_to_nick> (I<$ident>)


@@ -524,15 +594,9 @@ sub ident_to_nick
 {
        my $ident = shift;
 
 {
        my $ident = shift;
 

-       if (!defined ($ident)
-                       or (lc ($ident) eq 'ignore')
-                       or (lc ($ident) eq 'unidentified'))
+       if (defined ($IdentToNick{$ident}))

        {
        {

-               return ('');
-       }
-       elsif (defined ($IDENT2NICK{$ident}))
-       {
-               return ($IDENT2NICK{$ident});
+               return ($IdentToNick{$ident});

        }
        else
        {
        }
        else
        {


@@ -540,55 +604,6 @@ sub ident_to_nick
        }
 }
 
        }
 }
 

-=item I<$name> = B<ident_to_name> (I<$ident>)
-
-Returns the printable version of the name for the chatter identified by
-I<$ident>. Returns an empty string if the ident is not known.
-
-=cut
-
-sub ident_to_name
-{
-       my $ident = shift;
-       my $nick = ident_to_nick ($ident);
-       my $name;
-       
-       if (!$nick)
-       {
-               return ('');
-       }
-
-       $name = get_print_name ($nick);
-
-       return ($name);
-}
-
-=item I<$name> = B<get_print_name> (I<$nick>)
-
-Returns the printable version of the name for the nick I<$nick> or I<$nick> if
-unknown.
-
-=cut
-
-sub get_print_name
-{
-       my $nick = shift;
-       my $ident = '';
-       my $name = $nick;
-
-       if (defined ($NickToIdent{$nick}))
-       {
-               $ident = $NickToIdent{$nick};
-       }
-
-       if (($ident !~ m/^[^@]+@.+$/) and $ident)
-       {
-               $name = $ident;
-       }
-
-       return ($name);
-}
-

 =item I<$lines> = B<get_total_lines> ()
 
 Returns the total number of lines parsed so far.
 =item I<$lines> = B<get_total_lines> ()
 
 Returns the total number of lines parsed so far.


@@ -597,7 +612,8 @@ Returns the total number of lines parsed so far.
 
 sub get_total_lines
 {
 
 sub get_total_lines
 {

-       return ($DATA->{'total_lines'});
+       # TODO
+       #return ($DATA->{'total_lines'});

 }
 
 =item B<nick_rename> (I<$old_nick>, I<$new_nick>)
 }
 
 =item B<nick_rename> (I<$old_nick>, I<$new_nick>)


@@ -610,24 +626,13 @@ sub nick_rename
 {
        my $old_nick = shift;
        my $new_nick = shift;
 {
        my $old_nick = shift;
        my $new_nick = shift;

+       my $ident;

 
 

-       if (defined ($DATA->{'host_cache'}{$old_nick}))
-       {
-               my $host = $DATA->{'host_cache'}{$old_nick};
-               $DATA->{'host_cache'}{$new_nick} = $host;
-
-               if (!defined ($DATA->{'hosts_of_nick'}{$new_nick}{$host}))
-               {
-                       $DATA->{'hosts_of_nick'}{$new_nick}{$host} = 1;
-               }
-       }
+       ($ident) = $Nick2Ident->get ($old_nick);

 
 

-       if (defined ($DATA->{'byident'}{"$old_nick\@unidentified"}))
+       if (defined ($ident) and ($ident))

        {
        {

-               # Other data may be overwritten, but I don't care here..
-               # This should be a extremely rare case..
-               $DATA->{'byident'}{"$new_nick\@unidentified"} = $DATA->{'byident'}{"$old_nick\@unidentified"};
-               delete ($DATA->{'byident'}{"$old_nick\@unidentified"});
+               $Nick2Ident->put ($new_nick, $ident);

        }
 }
 
        }
 }
 


@@ -639,7 +644,7 @@ Print the output. Should be called only once..
 
 sub print_output
 {
 
 sub print_output
 {

-       if (!$DATA->{'total_lines'})
+       if (!get_total_lines ())

        {
                print STDERR <<'MESSAGE';
 
        {
                print STDERR <<'MESSAGE';
 


@@ -655,14 +660,11 @@ MESSAGE
        }
        
        calculate_nicks ();
        }
        
        calculate_nicks ();

-       merge_idents ();

 
        for (@$OUTPUT)
        {
                &$_ ();
        }
 
        for (@$OUTPUT)
        {
                &$_ ();
        }

-
-       delete ($DATA->{'byname'});

 }
 
 =item I<$data> = B<register_plugin> (I<$type>, I<$sub_ref>)
 }
 
 =item I<$data> = B<register_plugin> (I<$type>, I<$sub_ref>)


@@ -699,99 +701,6 @@ sub register_plugin
        push (@{$PluginCallbacks->{$type}}, $sub_ref);
 
        print STDERR $/, __FILE__, ': ', scalar (caller ()), " registered for ``$type''." if ($::DEBUG & 0x800);
        push (@{$PluginCallbacks->{$type}}, $sub_ref);
 
        print STDERR $/, __FILE__, ': ', scalar (caller ()), " registered for ``$type''." if ($::DEBUG & 0x800);

-
-       return ($DATA);
-}
-
-=item B<merge_idents> ()
-
-Merges idents. Does magic, don't interfere ;)
-
-=cut
-
-sub merge_idents
-{
-       my @idents = keys (%IDENT2NICK);
-
-       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
 }
 
 =back