6 use Onis::Config qw#get_config#;
7 use Onis::Data::Core qw(nick_to_ident);
8 use Onis::Data::Persistent;
10 @Onis::Users::EXPORT_OK =
12 ident_to_name chatter_to_name nick_to_name name_to_ident
13 get_realname get_link get_image
15 @Onis::Users::ISA = ('Exporter');
19 Onis::Users - Management of configures users, so called "names".
23 Parses user-info and provides query-routines. The definition of "name" can be found in L<Onis::Data::Core>.
27 use Onis::Users qw#ident_to_name chatter_to_name nick_to_name get_realname get_link get_image#;
29 # Functions to query the name
30 $name = ident_to_name ($ident);
31 $name = chatter_to_name ($chatter);
32 $name = nick_to_name ($nick);
34 # Functions to query a name's properties
35 my $realname = get_realname ($name);
36 my $link = get_link ($name);
37 my $image = get_image ($name);
41 Set $::DEBUG to ``0x1000'' to get extra debug messages.
46 our $IdentToName = {};
47 our $NameToIdent = {};
50 my $VERSION = '$Id: Users.pm,v 1.2 2004/08/01 13:45:27 octo Exp $';
51 print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);
59 my $config_file = 'users.conf';
63 if (get_config ('users_config'))
65 my $temp = get_config ('users_config');
66 if (-e $temp and -r $temp)
72 print STDERR $/, __FILE__, ": Unable to read users_config ``$temp'': ",
73 "File not readable. Check your permissions.";
77 print STDERR $/, __FILE__, ": Unable to read users_config ``$temp'': ",
78 "File does not exist.";
82 # Fail silently, if fle does not exist..
83 if (!-e $config_file) { return (0); }
85 print STDERR $/, __FILE__, ": Reading config file ``$config_file''" if ($::DEBUG & 0x1000);
88 unless (open ($fh, "< $config_file"))
90 print STDERR $/, __FILE__, ": Unable to open ``$config_file'' for reading: $!";
102 #$content =~ s/[\n\r\s]+//gs;
103 $content =~ s/#.*$//gm;
104 $content =~ s/[\n\r]+//gs;
106 #while ($content =~ m/([^{]+){([^}]+)}/g)
107 while ($content =~ m/([^\s{]+)\s*{([^}]+)}/g)
112 print STDERR $/, __FILE__, ": User ``$user''" if ($::DEBUG & 0x1000);
114 while ($line =~ m/([^\s:]+)\s*:([^;]+);/g)
118 $val =~ s/^\s+|\s+$//g;
120 print STDERR $/, __FILE__, ": + $key = ``$val''" if ($::DEBUG & 0x1000);
122 if (($key eq 'image') or ($key eq 'link')
125 if (!defined ($Users->{$user}{$key}))
127 $Users->{$user}{$key} = [];
129 push (@{$Users->{$user}{$key}}, $val);
131 elsif (($key eq 'host') or ($key eq 'hostmask'))
137 if ($val =~ m/^([^!]+)!([^@]+)@(.+)$/)
139 $this_nick = quotemeta (lc ($1));
140 $this_user = quotemeta (lc ($2));
141 $this_host = quotemeta (lc ($3));
145 print STDERR $/, __FILE__, ": Invalid hostmask for user $user: ``$val''";
149 $this_nick =~ s/\\\*/[^!]*/g;
150 $this_nick =~ s/\\\?/[^!]/g;
152 $this_user =~ s/\\\*/[^@]*/g;
153 $this_user =~ s/\\\?/[^@]/g;
155 $this_host =~ s/\\\*/.*/g;
156 $this_host =~ s/\\\?/./g;
158 $val = "$this_nick!$this_user\@$this_host";
160 if (!defined ($Users->{$user}{'host'}))
162 $Users->{$user}{'host'} = [];
165 print STDERR " --> m/^$val\$/i" if ($::DEBUG & 0x1000);
167 push (@{$Users->{$user}{'host'}}, qr/^$val$/i);
171 print STDERR $/, __FILE__, ": Invalid key in users_config: ``$key''";
175 if (!defined ($Users->{$user}{'host'}))
177 print STDERR $/, __FILE__, ": No hostmask given for user $user. Ignoring him/her.";
178 delete ($Users->{$user});
185 =head1 EXPORTED FUNCTIONS
189 =item B<ident_to_name> (I<$ident>)
191 Matches the ident against the configured hostmasks. Uses caching to
192 speed up execution. Returns the name or an empty string if not found.
201 if (defined ($IdentToName->{$ident}))
203 $name = $IdentToName->{$ident};
207 USER: for (keys (%$Users))
210 for (@{$Users->{$this_name}{'host'}})
214 if ($ident =~ $host_re)
222 if (($::DEBUG & 0x1000) and $name)
224 print STDERR $/, __FILE__, ": Host ``$ident'' belongs to ``$name''";
228 $IdentToName->{$ident} = $name;
229 $NameToIdent->{$name} = $ident if ($name);
233 =item B<chatter_to_name> (I<$chatter>)
235 Passes the ident-part of I<$chatter> to B<ident_to_name>.
242 my ($nick, $ident) = split (m/!/, $chatter);
244 return (ident_to_name ($ident));
247 =item B<nick_to_name> (I<$nick>)
249 Return the name associated with I<$nick>. This function uses B<nick_to_ident>
250 (see L<Onis::Data::Core>) to convert I<$nick> to an ident and then calls
258 my $ident = nick_to_ident ($nick);
262 return (ident_to_name ($ident));
270 =item B<name_to_ident> (I<$name>)
272 Does the reverse of B<ident_to_name>: Returns the most recent association of
273 I<$name> to an ident. This function should rarely be needed..
281 if (defined ($NameToIdent->{$name}))
283 return ($NameToIdent->{$name});
291 =item B<get_realname> (I<$name>)
293 Returns the B<real name> for this (user)name as defined in the config. Sorry
294 for the confusing terms.
303 if (defined ($Users->{$name}{'name'}))
305 my $tmp = int (rand (scalar (@{$Users->{$name}{'name'}})));
306 $retval = $Users->{$name}{'name'}[$tmp];
312 =item B<get_link> (I<$name>)
314 Returns the URL defined for this name in the config.
323 if (defined ($Users->{$name}{'link'}))
325 my $tmp = int (rand (scalar (@{$Users->{$name}{'link'}})));
326 $retval = $Users->{$name}{'link'}[$tmp];
332 =item B<get_image> (I<$name>)
334 Returns the URL of the (user)name's image, if one is configured.
343 if (defined ($Users->{$name}{'image'}))
345 my $tmp = int (rand (scalar (@{$Users->{$name}{'image'}})));
346 $retval = $Users->{$name}{'image'}[$tmp];
356 Florian octo Forster E<lt>octo at verplant.orgE<gt>