From: octo Date: Sat, 9 Apr 2005 15:33:17 +0000 (+0000) Subject: Made Onis::Users consistent with new naming convention. Also it's documentation is... X-Git-Tag: Release-0.8.0~20^2~42 X-Git-Url: https://git.octo.it/?p=onis.git;a=commitdiff_plain;h=682812f41e5b83e006d5c482eaf8e33883dc7bce Made Onis::Users consistent with new naming convention. Also it's documentation is complete now. --- diff --git a/lib/Onis/Data/Core.pm b/lib/Onis/Data/Core.pm index b15ba95..29a5b4b 100644 --- a/lib/Onis/Data/Core.pm +++ b/lib/Onis/Data/Core.pm @@ -39,7 +39,7 @@ our $ChannelNames = Onis::Data::Persistent->new ('ChannelNames', 'channel', 'cou -@Onis::Data::Core::EXPORT_OK = qw#all_nicks get_channel +@Onis::Data::Core::EXPORT_OK = qw#get_all_nicks get_channel nick_to_ident ident_to_nick ident_to_name get_main_nick @@ -55,7 +55,7 @@ our @AllNicks = (); our @ALLNAMES = (); our %NickMap = (); our %NickToIdent = (); -our %IDENT2NICK = (); +our %IdentToNick = (); our $LASTRUN_DAYS = 0; @@ -307,7 +307,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 -B, B, B and B. +B, B, B and B. 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 @@ -341,6 +341,8 @@ sub calculate_nicks my $temp = $name ? $name : $ident; + next if (lc ($name) eq 'ignore'); + $nicks->{$nick}{$temp} = 0 unless (defined ($nicks->{$nick}{$temp})); $nicks->{$nick}{$temp} += $counter; } @@ -424,20 +426,21 @@ sub calculate_nicks { push (@AllNicks, $_); $NickMap{$_} = $this_nick; + # FIXME $NickToIdent{$_} = $this_ident; } - $IDENT2NICK{$this_ident} = $this_nick; + $IdentToNick{$this_ident} = $this_nick; } } -=item I<@nicks> = B () +=item I<@nicks> = B () Returns an array of all seen nicks. =cut -sub all_nicks +sub get_all_nicks { return (@AllNicks); } @@ -504,14 +507,11 @@ Returns the ident for this nick or an empty string if unknown. sub nick_to_ident { my $nick = shift; - if (defined ($NickToIdent{$nick})) - { - return ($NickToIdent{$nick}); - } - else - { - return (''); - } + + my ($ident) = $Nick2Ident->get ($nick); + $ident ||= ''; + + return ($ident); } =item I<$nick> = B (I<$ident>) @@ -530,9 +530,9 @@ sub ident_to_nick { return (''); } - elsif (defined ($IDENT2NICK{$ident})) + elsif (defined ($IdentToNick{$ident})) { - return ($IDENT2NICK{$ident}); + return ($IdentToNick{$ident}); } else { @@ -711,7 +711,7 @@ Merges idents. Does magic, don't interfere ;) sub merge_idents { - my @idents = keys (%IDENT2NICK); + my @idents = keys (%IdentToNick); for (@idents) { diff --git a/lib/Onis/Users.pm b/lib/Onis/Users.pm new file mode 100644 index 0000000..42f8cf7 --- /dev/null +++ b/lib/Onis/Users.pm @@ -0,0 +1,329 @@ +package Onis::Users; + +use strict; +use warnings; +use Exporter; +use Onis::Config qw#get_config#; +use Onis::Data::Core qw(nick_to_ident); +use Onis::Data::Persistent; + +@Onis::Users::EXPORT_OK = qw#host_to_username nick_to_username get_link get_image get_realname#; +@Onis::Users::ISA = ('Exporter'); + +=head1 NAME + +Onis::Users - Management of configures users, so called "names". + +=head1 DESCRIPTION + +Parses user-info and provides query-routines. The definition of "name" can be found in L. + +=head1 USAGE + + use Onis::Users qw#ident_to_name chatter_to_name nick_to_name get_realname get_link get_image#; + + # Functions to query the name + $name = ident_to_name ($ident); + $name = chatter_to_name ($chatter); + $name = nick_to_name ($nick); + + # Functions to query a name's properties + my $realname = get_realname ($name); + my $link = get_link ($name); + my $image = get_image ($name); + +=head1 DIAGNOSTIGS + +Set $::DEBUG to ``0x1000'' to get extra debug messages. + +=cut + +our $Users = {}; +# FIXME +our $HostmaskCache = init ('$HostmaskCache', 'hash'); + +my $VERSION = '$Id: Users.pm,v 1.2 2004/08/01 13:45:27 octo Exp $'; +print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG); + +read_config (); + +return (1); + +sub read_config +{ + my $config_file = 'users.conf'; + my $content; + my $fh; + + if (get_config ('users_config')) + { + my $temp = get_config ('users_config'); + if (-e $temp and -r $temp) + { + $config_file = $temp; + } + elsif (-e $temp) + { + print STDERR $/, __FILE__, ": Unable to read users_config ``$temp'': ", + "File not readable. Check your permissions."; + } + else + { + print STDERR $/, __FILE__, ": Unable to read users_config ``$temp'': ", + "File does not exist."; + } + } + + # Fail silently, if fle does not exist.. + if (!-e $config_file) { return (0); } + + print STDERR $/, __FILE__, ": Reading config file ``$config_file''" if ($::DEBUG & 0x1000); + + # read the file + unless (open ($fh, "< $config_file")) + { + print STDERR $/, __FILE__, ": Unable to open ``$config_file'' for reading: $!"; + return (0); + } + + { + local ($/) = undef; + $content = <$fh>; + } + + close ($fh); + + # parse the file + #$content =~ s/[\n\r\s]+//gs; + $content =~ s/#.*$//gm; + $content =~ s/[\n\r]+//gs; + + #while ($content =~ m/([^{]+){([^}]+)}/g) + while ($content =~ m/([^\s{]+)\s*{([^}]+)}/g) + { + my $user = $1; + my $line = $2; + + print STDERR $/, __FILE__, ": User ``$user''" if ($::DEBUG & 0x1000); + + while ($line =~ m/([^\s:]+)\s*:([^;]+);/g) + { + my $key = lc ($1); + my $val = $2; + $val =~ s/^\s+|\s+$//g; + + print STDERR $/, __FILE__, ": + $key = ``$val''" if ($::DEBUG & 0x1000); + + if (($key eq 'image') or ($key eq 'link') + or ($key eq 'name')) + { + if (!defined ($Users->{$user}{$key})) + { + $Users->{$user}{$key} = []; + } + push (@{$Users->{$user}{$key}}, $val); + } + elsif (($key eq 'host') or ($key eq 'hostmask')) + { + my $this_nick; + my $this_user; + my $this_host; + + if ($val =~ m/^([^!]+)!([^@]+)@(.+)$/) + { + $this_nick = quotemeta (lc ($1)); + $this_user = quotemeta (lc ($2)); + $this_host = quotemeta (lc ($3)); + } + else + { + print STDERR $/, __FILE__, ": Invalid hostmask for user $user: ``$val''"; + next; + } + + $this_nick =~ s/\\\*/[^!]*/g; + $this_nick =~ s/\\\?/[^!]/g; + + $this_user =~ s/\\\*/[^@]*/g; + $this_user =~ s/\\\?/[^@]/g; + + $this_host =~ s/\\\*/.*/g; + $this_host =~ s/\\\?/./g; + + $val = "$this_nick!$this_user\@$this_host"; + + if (!defined ($Users->{$user}{'host'})) + { + $Users->{$user}{'host'} = []; + } + + print STDERR " --> m/^$val\$/i" if ($::DEBUG & 0x1000); + + push (@{$Users->{$user}{'host'}}, qr/^$val$/i); + } + else + { + print STDERR $/, __FILE__, ": Invalid key in users_config: ``$key''"; + } + } + + if (!defined ($Users->{$user}{'host'})) + { + print STDERR $/, __FILE__, ": No hostmask given for user $user. Ignoring him/her."; + delete ($Users->{$user}); + } + } + + return (1); +} + +=head1 EXPORTED FUNCTIONS + +=over 4 + +=item B (I<$ident>) + +Matches the ident against the configured hostmasks. Uses caching to +speed up execution. Returns the name or an empty string if not found. + +=cut + +sub ident_to_name +{ + my $ident = shift; + my $name = ''; + + if (defined ($HostmaskCache->{$ident})) + { + $name = $HostmaskCache->{$ident}; + } + else + { + USER: for (keys (%$Users)) + { + my $this_name = $_; + for (@{$Users->{$this_name}{'host'}}) + { + my $host_re = $_; + + if ($ident =~ $host_re) + { + $name = $this_name; + last (USER); + } + } + } + + if (($::DEBUG & 0x1000) and $name) + { + print STDERR $/, __FILE__, ": Host ``$ident'' belongs to ``$name''"; + } + } + + $HostmaskCache->{$ident} = $name; + return ($name); +} + +=item B (I<$chatter>) + +Passes the ident-part of I<$chatter> to B. + +=cut + +sub chatter_to_name +{ + my $chatter = shift; + my ($nick, $ident) = split (m/!/, $chatter); + + return (ident_to_name ($ident)); +} + +=item B (I<$nick>) + +Return the name associated with I<$nick>. This function uses B +(see L) to convert I<$nick> to an ident and then calls +B. + +=cut + +sub nick_to_name +{ + my $nick = shift; + my $ident = nick_to_ident ($nick); + + if ($ident) + { + return (ident_to_name ($ident)); + } + else + { + return (''); + } +} + +=item B (I<$name>) + +Returns the B for this (user)name as defined in the config. Sorry +for the confusing terms. + +=cut + +sub get_realname +{ + my $name = shift; + my $retval = ''; + + if (defined ($Users->{$name}{'name'})) + { + my $tmp = int (rand (scalar (@{$Users->{$name}{'name'}}))); + $retval = $Users->{$name}{'name'}[$tmp]; + } + + return ($retval); +} + +=item B (I<$name>) + +Returns the URL defined for this name in the config. + +=cut + +sub get_link +{ + my $name = shift; + my $retval = ''; + + if (defined ($Users->{$name}{'link'})) + { + my $tmp = int (rand (scalar (@{$Users->{$name}{'link'}}))); + $retval = $Users->{$name}{'link'}[$tmp]; + } + + return ($retval); +} + +=item B (I<$name>) + +Returns the URL of the (user)name's image, if one is configured. + +=cut + +sub get_image +{ + my $name = shift; + my $retval = ''; + + if (defined ($Users->{$name}{'image'})) + { + my $tmp = int (rand (scalar (@{$Users->{$name}{'image'}}))); + $retval = $Users->{$name}{'image'}[$tmp]; + } + + return ($retval); +} + +=back + +=head1 AUTHOR + +Florian octo Forster Eocto at verplant.orgE