6 use Onis::Config (qw(get_config));
7 use Onis::Data::Persistent ();
9 @Onis::Users::EXPORT_OK =
12 name_to_chatter name_to_ident name_to_nick
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 get_realname get_link get_image#;
29 # Functions to query the name
30 $name = ident_to_name ($ident);
31 $name = chatter_to_name ($chatter);
33 # Functions to query a name's properties
34 my $realname = get_realname ($name);
35 my $link = get_link ($name);
36 my $image = get_image ($name);
40 Set $::DEBUG to ``0x1000'' to get extra debug messages.
45 our $ChatterToName = {};
46 our $NameToChatter = {};
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<chatter_to_name> (I<$chatter>)
201 Passes the ident-part of I<$chatter> to B<ident_to_name>.
210 if (defined ($ChatterToName->{$chatter}))
212 return ($ChatterToName->{$chatter});
215 USER: for (keys %$Users)
218 for (@{$Users->{$name}{'host'}})
230 if (($::DEBUG & 0x1000) and $retval)
232 print STDERR $/, __FILE__, ": ``$chatter'' identified as ``$retval''";
235 $ChatterToName->{$chatter} = $retval;
236 $NameToChatter->{$retval} = $chatter if ($retval);
241 =item B<name_to_chatter> (I<$name>)
243 Returns the most recent chatter for I<$name>.
251 if (defined ($NameToChatter->{$name}))
253 return ($NameToChatter->{$name});
261 =item B<name_to_ident> (I<$name>)
263 Returns the most recent ident for I<$name>.
271 if (defined ($NameToChatter->{$name}))
273 my $chatter = $NameToChatter->{$name};
274 my ($nick, $ident) = split (m/!/, $chatter);
284 =item B<name_to_nick> (I<$name>)
286 Returns the most recent nick for I<$name>.
294 if (defined ($NameToChatter->{$name}))
296 my $chatter = $NameToChatter->{$name};
297 my ($nick, $ident) = split (m/!/, $chatter);
307 =item B<get_realname> (I<$name>)
309 Returns the B<real name> for this (user)name as defined in the config. Sorry
310 for the confusing terms.
319 if (defined ($Users->{$name}{'name'}))
321 my $tmp = int (rand (scalar (@{$Users->{$name}{'name'}})));
322 $retval = $Users->{$name}{'name'}[$tmp];
328 =item B<get_link> (I<$name>)
330 Returns the URL defined for this name in the config.
339 if (defined ($Users->{$name}{'link'}))
341 my $tmp = int (rand (scalar (@{$Users->{$name}{'link'}})));
342 $retval = $Users->{$name}{'link'}[$tmp];
348 =item B<get_image> (I<$name>)
350 Returns the URL of the (user)name's image, if one is configured.
359 if (defined ($Users->{$name}{'image'}))
361 my $tmp = int (rand (scalar (@{$Users->{$name}{'image'}})));
362 $retval = $Users->{$name}{'image'}[$tmp];
372 Florian octo Forster E<lt>octo at verplant.orgE<gt>