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 = qw#host_to_username nick_to_username get_link get_image get_realname#;
11 @Onis::Users::ISA = ('Exporter');
15 Onis::Users - Management of configures users, so called "names".
19 Parses user-info and provides query-routines. The definition of "name" can be found in L<Onis::Data::Core>.
23 use Onis::Users qw#ident_to_name chatter_to_name nick_to_name get_realname get_link get_image#;
25 # Functions to query the name
26 $name = ident_to_name ($ident);
27 $name = chatter_to_name ($chatter);
28 $name = nick_to_name ($nick);
30 # Functions to query a name's properties
31 my $realname = get_realname ($name);
32 my $link = get_link ($name);
33 my $image = get_image ($name);
37 Set $::DEBUG to ``0x1000'' to get extra debug messages.
42 our $IdentToName = {};
43 our $NameToIdent = {};
46 my $VERSION = '$Id: Users.pm,v 1.2 2004/08/01 13:45:27 octo Exp $';
47 print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);
55 my $config_file = 'users.conf';
59 if (get_config ('users_config'))
61 my $temp = get_config ('users_config');
62 if (-e $temp and -r $temp)
68 print STDERR $/, __FILE__, ": Unable to read users_config ``$temp'': ",
69 "File not readable. Check your permissions.";
73 print STDERR $/, __FILE__, ": Unable to read users_config ``$temp'': ",
74 "File does not exist.";
78 # Fail silently, if fle does not exist..
79 if (!-e $config_file) { return (0); }
81 print STDERR $/, __FILE__, ": Reading config file ``$config_file''" if ($::DEBUG & 0x1000);
84 unless (open ($fh, "< $config_file"))
86 print STDERR $/, __FILE__, ": Unable to open ``$config_file'' for reading: $!";
98 #$content =~ s/[\n\r\s]+//gs;
99 $content =~ s/#.*$//gm;
100 $content =~ s/[\n\r]+//gs;
102 #while ($content =~ m/([^{]+){([^}]+)}/g)
103 while ($content =~ m/([^\s{]+)\s*{([^}]+)}/g)
108 print STDERR $/, __FILE__, ": User ``$user''" if ($::DEBUG & 0x1000);
110 while ($line =~ m/([^\s:]+)\s*:([^;]+);/g)
114 $val =~ s/^\s+|\s+$//g;
116 print STDERR $/, __FILE__, ": + $key = ``$val''" if ($::DEBUG & 0x1000);
118 if (($key eq 'image') or ($key eq 'link')
121 if (!defined ($Users->{$user}{$key}))
123 $Users->{$user}{$key} = [];
125 push (@{$Users->{$user}{$key}}, $val);
127 elsif (($key eq 'host') or ($key eq 'hostmask'))
133 if ($val =~ m/^([^!]+)!([^@]+)@(.+)$/)
135 $this_nick = quotemeta (lc ($1));
136 $this_user = quotemeta (lc ($2));
137 $this_host = quotemeta (lc ($3));
141 print STDERR $/, __FILE__, ": Invalid hostmask for user $user: ``$val''";
145 $this_nick =~ s/\\\*/[^!]*/g;
146 $this_nick =~ s/\\\?/[^!]/g;
148 $this_user =~ s/\\\*/[^@]*/g;
149 $this_user =~ s/\\\?/[^@]/g;
151 $this_host =~ s/\\\*/.*/g;
152 $this_host =~ s/\\\?/./g;
154 $val = "$this_nick!$this_user\@$this_host";
156 if (!defined ($Users->{$user}{'host'}))
158 $Users->{$user}{'host'} = [];
161 print STDERR " --> m/^$val\$/i" if ($::DEBUG & 0x1000);
163 push (@{$Users->{$user}{'host'}}, qr/^$val$/i);
167 print STDERR $/, __FILE__, ": Invalid key in users_config: ``$key''";
171 if (!defined ($Users->{$user}{'host'}))
173 print STDERR $/, __FILE__, ": No hostmask given for user $user. Ignoring him/her.";
174 delete ($Users->{$user});
181 =head1 EXPORTED FUNCTIONS
185 =item B<ident_to_name> (I<$ident>)
187 Matches the ident against the configured hostmasks. Uses caching to
188 speed up execution. Returns the name or an empty string if not found.
197 if (defined ($IdentToName->{$ident}))
199 $name = $IdentToName->{$ident};
203 USER: for (keys (%$Users))
206 for (@{$Users->{$this_name}{'host'}})
210 if ($ident =~ $host_re)
218 if (($::DEBUG & 0x1000) and $name)
220 print STDERR $/, __FILE__, ": Host ``$ident'' belongs to ``$name''";
224 $IdentToName->{$ident} = $name;
225 $NameToIdent->{$name} = $ident if ($name);
229 =item B<chatter_to_name> (I<$chatter>)
231 Passes the ident-part of I<$chatter> to B<ident_to_name>.
238 my ($nick, $ident) = split (m/!/, $chatter);
240 return (ident_to_name ($ident));
243 =item B<nick_to_name> (I<$nick>)
245 Return the name associated with I<$nick>. This function uses B<nick_to_ident>
246 (see L<Onis::Data::Core>) to convert I<$nick> to an ident and then calls
254 my $ident = nick_to_ident ($nick);
258 return (ident_to_name ($ident));
266 =item B<name_to_ident> (I<$name>)
268 Does the reverse of B<ident_to_name>: Returns the most recent association of
269 I<$name> to an ident. This function should rarely be needed..
277 if (defined ($NameToIdent->{$name}))
279 return ($NameToIdent->{$name});
287 =item B<get_realname> (I<$name>)
289 Returns the B<real name> for this (user)name as defined in the config. Sorry
290 for the confusing terms.
299 if (defined ($Users->{$name}{'name'}))
301 my $tmp = int (rand (scalar (@{$Users->{$name}{'name'}})));
302 $retval = $Users->{$name}{'name'}[$tmp];
308 =item B<get_link> (I<$name>)
310 Returns the URL defined for this name in the config.
319 if (defined ($Users->{$name}{'link'}))
321 my $tmp = int (rand (scalar (@{$Users->{$name}{'link'}})));
322 $retval = $Users->{$name}{'link'}[$tmp];
328 =item B<get_image> (I<$name>)
330 Returns the URL of the (user)name's image, if one is configured.
339 if (defined ($Users->{$name}{'image'}))
341 my $tmp = int (rand (scalar (@{$Users->{$name}{'image'}})));
342 $retval = $Users->{$name}{'image'}[$tmp];
352 Florian octo Forster E<lt>octo at verplant.orgE<gt>