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 = {};
49 print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);
55 =head1 CONFIGURATION OPTIONS
59 =item B<users_config>: I<users.conf>;
61 Sets the file from which to read the user configuration.
69 my $config_file = 'users.conf';
73 if (get_config ('users_config'))
75 my $temp = get_config ('users_config');
76 if (-e $temp and -r $temp)
82 print STDERR $/, __FILE__, ": Unable to read users_config ``$temp'': ",
83 "File not readable. Check your permissions.";
87 print STDERR $/, __FILE__, ": Unable to read users_config ``$temp'': ",
88 "File does not exist.";
92 # Fail silently, if fle does not exist..
93 if (!-e $config_file) { return (0); }
95 print STDERR $/, __FILE__, ": Reading config file ``$config_file''" if ($::DEBUG & 0x1000);
98 unless (open ($fh, "< $config_file"))
100 print STDERR $/, __FILE__, ": Unable to open ``$config_file'' for reading: $!";
112 #$content =~ s/[\n\r\s]+//gs;
113 $content =~ s/#.*$//gm;
114 $content =~ s/[\n\r]+//gs;
116 #while ($content =~ m/([^{]+){([^}]+)}/g)
117 while ($content =~ m/([^\s{]+)\s*{([^}]+)}/g)
122 print STDERR $/, __FILE__, ": User ``$user''" if ($::DEBUG & 0x1000);
124 while ($line =~ m/([^\s:]+)\s*:([^;]+);/g)
128 $val =~ s/^\s+|\s+$//g;
130 print STDERR $/, __FILE__, ": + $key = ``$val''" if ($::DEBUG & 0x1000);
132 if (($key eq 'image') or ($key eq 'link')
135 if (!defined ($Users->{$user}{$key}))
137 $Users->{$user}{$key} = [];
139 push (@{$Users->{$user}{$key}}, $val);
141 elsif (($key eq 'host') or ($key eq 'hostmask'))
147 if ($val =~ m/^([^!]+)!([^@]+)@(.+)$/)
149 $this_nick = quotemeta (lc ($1));
150 $this_user = quotemeta (lc ($2));
151 $this_host = quotemeta (lc ($3));
155 print STDERR $/, __FILE__, ": Invalid hostmask for user $user: ``$val''";
159 $this_nick =~ s/\\\*/[^!]*/g;
160 $this_nick =~ s/\\\?/[^!]/g;
162 $this_user =~ s/\\\*/[^@]*/g;
163 $this_user =~ s/\\\?/[^@]/g;
165 $this_host =~ s/\\\*/.*/g;
166 $this_host =~ s/\\\?/./g;
168 $val = "$this_nick!$this_user\@$this_host";
170 if (!defined ($Users->{$user}{'host'}))
172 $Users->{$user}{'host'} = [];
175 print STDERR " --> m/^$val\$/i" if ($::DEBUG & 0x1000);
177 push (@{$Users->{$user}{'host'}}, qr/^$val$/i);
181 print STDERR $/, __FILE__, ": Invalid key in users_config: ``$key''";
185 if (!defined ($Users->{$user}{'host'}))
187 print STDERR $/, __FILE__, ": No hostmask given for user $user. Ignoring him/her.";
188 delete ($Users->{$user});
195 =head1 EXPORTED FUNCTIONS
199 =item B<ident_to_name> (I<$ident>)
201 Matches the ident against the configured hostmasks. Uses caching to
202 speed up execution. Returns the name or an empty string if not found.
211 if (defined ($IdentToName->{$ident}))
213 $name = $IdentToName->{$ident};
217 USER: for (keys (%$Users))
220 for (@{$Users->{$this_name}{'host'}})
224 if ($ident =~ $host_re)
232 if (($::DEBUG & 0x1000) and $name)
234 print STDERR $/, __FILE__, ": Host ``$ident'' belongs to ``$name''";
238 $IdentToName->{$ident} = $name;
239 $NameToIdent->{$name} = $ident if ($name);
243 =item B<chatter_to_name> (I<$chatter>)
245 Passes the ident-part of I<$chatter> to B<ident_to_name>.
252 my ($nick, $ident) = split (m/!/, $chatter);
254 return (ident_to_name ($ident));
257 =item B<name_to_ident> (I<$name>)
259 Does the reverse of B<ident_to_name>: Returns the most recent association of
260 I<$name> to an ident. This function should rarely be needed..
268 if (defined ($NameToIdent->{$name}))
270 return ($NameToIdent->{$name});
278 =item B<get_realname> (I<$name>)
280 Returns the B<real name> for this (user)name as defined in the config. Sorry
281 for the confusing terms.
290 if (defined ($Users->{$name}{'name'}))
292 my $tmp = int (rand (scalar (@{$Users->{$name}{'name'}})));
293 $retval = $Users->{$name}{'name'}[$tmp];
299 =item B<get_link> (I<$name>)
301 Returns the URL defined for this name in the config.
310 if (defined ($Users->{$name}{'link'}))
312 my $tmp = int (rand (scalar (@{$Users->{$name}{'link'}})));
313 $retval = $Users->{$name}{'link'}[$tmp];
319 =item B<get_image> (I<$name>)
321 Returns the URL of the (user)name's image, if one is configured.
330 if (defined ($Users->{$name}{'image'}))
332 my $tmp = int (rand (scalar (@{$Users->{$name}{'image'}})));
333 $retval = $Users->{$name}{'image'}[$tmp];
343 Florian octo Forster E<lt>octo at verplant.orgE<gt>