6 use Onis::Config (qw(get_config));
7 use Onis::Data::Persistent ();
9 @Onis::Users::EXPORT_OK =
11 ident_to_name chatter_to_name name_to_ident
12 get_realname get_link get_image
14 @Onis::Users::ISA = ('Exporter');
18 Onis::Users - Management of configures users, so called "names".
22 Parses user-info and provides query-routines. The definition of "name" can be found in L<Onis::Data::Core>.
26 use Onis::Users qw#ident_to_name chatter_to_name get_realname get_link get_image#;
28 # Functions to query the name
29 $name = ident_to_name ($ident);
30 $name = chatter_to_name ($chatter);
32 # Functions to query a name's properties
33 my $realname = get_realname ($name);
34 my $link = get_link ($name);
35 my $image = get_image ($name);
39 Set $::DEBUG to ``0x1000'' to get extra debug messages.
44 our $IdentToName = {};
45 our $NameToIdent = {};
48 my $VERSION = '$Id: Users.pm,v 1.2 2004/08/01 13:45:27 octo Exp $';
49 print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);
57 my $config_file = 'users.conf';
61 if (get_config ('users_config'))
63 my $temp = get_config ('users_config');
64 if (-e $temp and -r $temp)
70 print STDERR $/, __FILE__, ": Unable to read users_config ``$temp'': ",
71 "File not readable. Check your permissions.";
75 print STDERR $/, __FILE__, ": Unable to read users_config ``$temp'': ",
76 "File does not exist.";
80 # Fail silently, if fle does not exist..
81 if (!-e $config_file) { return (0); }
83 print STDERR $/, __FILE__, ": Reading config file ``$config_file''" if ($::DEBUG & 0x1000);
86 unless (open ($fh, "< $config_file"))
88 print STDERR $/, __FILE__, ": Unable to open ``$config_file'' for reading: $!";
100 #$content =~ s/[\n\r\s]+//gs;
101 $content =~ s/#.*$//gm;
102 $content =~ s/[\n\r]+//gs;
104 #while ($content =~ m/([^{]+){([^}]+)}/g)
105 while ($content =~ m/([^\s{]+)\s*{([^}]+)}/g)
110 print STDERR $/, __FILE__, ": User ``$user''" if ($::DEBUG & 0x1000);
112 while ($line =~ m/([^\s:]+)\s*:([^;]+);/g)
116 $val =~ s/^\s+|\s+$//g;
118 print STDERR $/, __FILE__, ": + $key = ``$val''" if ($::DEBUG & 0x1000);
120 if (($key eq 'image') or ($key eq 'link')
123 if (!defined ($Users->{$user}{$key}))
125 $Users->{$user}{$key} = [];
127 push (@{$Users->{$user}{$key}}, $val);
129 elsif (($key eq 'host') or ($key eq 'hostmask'))
135 if ($val =~ m/^([^!]+)!([^@]+)@(.+)$/)
137 $this_nick = quotemeta (lc ($1));
138 $this_user = quotemeta (lc ($2));
139 $this_host = quotemeta (lc ($3));
143 print STDERR $/, __FILE__, ": Invalid hostmask for user $user: ``$val''";
147 $this_nick =~ s/\\\*/[^!]*/g;
148 $this_nick =~ s/\\\?/[^!]/g;
150 $this_user =~ s/\\\*/[^@]*/g;
151 $this_user =~ s/\\\?/[^@]/g;
153 $this_host =~ s/\\\*/.*/g;
154 $this_host =~ s/\\\?/./g;
156 $val = "$this_nick!$this_user\@$this_host";
158 if (!defined ($Users->{$user}{'host'}))
160 $Users->{$user}{'host'} = [];
163 print STDERR " --> m/^$val\$/i" if ($::DEBUG & 0x1000);
165 push (@{$Users->{$user}{'host'}}, qr/^$val$/i);
169 print STDERR $/, __FILE__, ": Invalid key in users_config: ``$key''";
173 if (!defined ($Users->{$user}{'host'}))
175 print STDERR $/, __FILE__, ": No hostmask given for user $user. Ignoring him/her.";
176 delete ($Users->{$user});
183 =head1 EXPORTED FUNCTIONS
187 =item B<ident_to_name> (I<$ident>)
189 Matches the ident against the configured hostmasks. Uses caching to
190 speed up execution. Returns the name or an empty string if not found.
199 if (defined ($IdentToName->{$ident}))
201 $name = $IdentToName->{$ident};
205 USER: for (keys (%$Users))
208 for (@{$Users->{$this_name}{'host'}})
212 if ($ident =~ $host_re)
220 if (($::DEBUG & 0x1000) and $name)
222 print STDERR $/, __FILE__, ": Host ``$ident'' belongs to ``$name''";
226 $IdentToName->{$ident} = $name;
227 $NameToIdent->{$name} = $ident if ($name);
231 =item B<chatter_to_name> (I<$chatter>)
233 Passes the ident-part of I<$chatter> to B<ident_to_name>.
240 my ($nick, $ident) = split (m/!/, $chatter);
242 return (ident_to_name ($ident));
245 =item B<name_to_ident> (I<$name>)
247 Does the reverse of B<ident_to_name>: Returns the most recent association of
248 I<$name> to an ident. This function should rarely be needed..
256 if (defined ($NameToIdent->{$name}))
258 return ($NameToIdent->{$name});
266 =item B<get_realname> (I<$name>)
268 Returns the B<real name> for this (user)name as defined in the config. Sorry
269 for the confusing terms.
278 if (defined ($Users->{$name}{'name'}))
280 my $tmp = int (rand (scalar (@{$Users->{$name}{'name'}})));
281 $retval = $Users->{$name}{'name'}[$tmp];
287 =item B<get_link> (I<$name>)
289 Returns the URL defined for this name in the config.
298 if (defined ($Users->{$name}{'link'}))
300 my $tmp = int (rand (scalar (@{$Users->{$name}{'link'}})));
301 $retval = $Users->{$name}{'link'}[$tmp];
307 =item B<get_image> (I<$name>)
309 Returns the URL of the (user)name's image, if one is configured.
318 if (defined ($Users->{$name}{'image'}))
320 my $tmp = int (rand (scalar (@{$Users->{$name}{'image'}})));
321 $retval = $Users->{$name}{'image'}[$tmp];
331 Florian octo Forster E<lt>octo at verplant.orgE<gt>