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.
43 our $HostmaskCache = init ('$HostmaskCache', 'hash');
45 my $VERSION = '$Id: Users.pm,v 1.2 2004/08/01 13:45:27 octo Exp $';
46 print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);
54 my $config_file = 'users.conf';
58 if (get_config ('users_config'))
60 my $temp = get_config ('users_config');
61 if (-e $temp and -r $temp)
67 print STDERR $/, __FILE__, ": Unable to read users_config ``$temp'': ",
68 "File not readable. Check your permissions.";
72 print STDERR $/, __FILE__, ": Unable to read users_config ``$temp'': ",
73 "File does not exist.";
77 # Fail silently, if fle does not exist..
78 if (!-e $config_file) { return (0); }
80 print STDERR $/, __FILE__, ": Reading config file ``$config_file''" if ($::DEBUG & 0x1000);
83 unless (open ($fh, "< $config_file"))
85 print STDERR $/, __FILE__, ": Unable to open ``$config_file'' for reading: $!";
97 #$content =~ s/[\n\r\s]+//gs;
98 $content =~ s/#.*$//gm;
99 $content =~ s/[\n\r]+//gs;
101 #while ($content =~ m/([^{]+){([^}]+)}/g)
102 while ($content =~ m/([^\s{]+)\s*{([^}]+)}/g)
107 print STDERR $/, __FILE__, ": User ``$user''" if ($::DEBUG & 0x1000);
109 while ($line =~ m/([^\s:]+)\s*:([^;]+);/g)
113 $val =~ s/^\s+|\s+$//g;
115 print STDERR $/, __FILE__, ": + $key = ``$val''" if ($::DEBUG & 0x1000);
117 if (($key eq 'image') or ($key eq 'link')
120 if (!defined ($Users->{$user}{$key}))
122 $Users->{$user}{$key} = [];
124 push (@{$Users->{$user}{$key}}, $val);
126 elsif (($key eq 'host') or ($key eq 'hostmask'))
132 if ($val =~ m/^([^!]+)!([^@]+)@(.+)$/)
134 $this_nick = quotemeta (lc ($1));
135 $this_user = quotemeta (lc ($2));
136 $this_host = quotemeta (lc ($3));
140 print STDERR $/, __FILE__, ": Invalid hostmask for user $user: ``$val''";
144 $this_nick =~ s/\\\*/[^!]*/g;
145 $this_nick =~ s/\\\?/[^!]/g;
147 $this_user =~ s/\\\*/[^@]*/g;
148 $this_user =~ s/\\\?/[^@]/g;
150 $this_host =~ s/\\\*/.*/g;
151 $this_host =~ s/\\\?/./g;
153 $val = "$this_nick!$this_user\@$this_host";
155 if (!defined ($Users->{$user}{'host'}))
157 $Users->{$user}{'host'} = [];
160 print STDERR " --> m/^$val\$/i" if ($::DEBUG & 0x1000);
162 push (@{$Users->{$user}{'host'}}, qr/^$val$/i);
166 print STDERR $/, __FILE__, ": Invalid key in users_config: ``$key''";
170 if (!defined ($Users->{$user}{'host'}))
172 print STDERR $/, __FILE__, ": No hostmask given for user $user. Ignoring him/her.";
173 delete ($Users->{$user});
180 =head1 EXPORTED FUNCTIONS
184 =item B<ident_to_name> (I<$ident>)
186 Matches the ident against the configured hostmasks. Uses caching to
187 speed up execution. Returns the name or an empty string if not found.
196 if (defined ($HostmaskCache->{$ident}))
198 $name = $HostmaskCache->{$ident};
202 USER: for (keys (%$Users))
205 for (@{$Users->{$this_name}{'host'}})
209 if ($ident =~ $host_re)
217 if (($::DEBUG & 0x1000) and $name)
219 print STDERR $/, __FILE__, ": Host ``$ident'' belongs to ``$name''";
223 $HostmaskCache->{$ident} = $name;
227 =item B<chatter_to_name> (I<$chatter>)
229 Passes the ident-part of I<$chatter> to B<ident_to_name>.
236 my ($nick, $ident) = split (m/!/, $chatter);
238 return (ident_to_name ($ident));
241 =item B<nick_to_name> (I<$nick>)
243 Return the name associated with I<$nick>. This function uses B<nick_to_ident>
244 (see L<Onis::Data::Core>) to convert I<$nick> to an ident and then calls
252 my $ident = nick_to_ident ($nick);
256 return (ident_to_name ($ident));
264 =item B<get_realname> (I<$name>)
266 Returns the B<real name> for this (user)name as defined in the config. Sorry
267 for the confusing terms.
276 if (defined ($Users->{$name}{'name'}))
278 my $tmp = int (rand (scalar (@{$Users->{$name}{'name'}})));
279 $retval = $Users->{$name}{'name'}[$tmp];
285 =item B<get_link> (I<$name>)
287 Returns the URL defined for this name in the config.
296 if (defined ($Users->{$name}{'link'}))
298 my $tmp = int (rand (scalar (@{$Users->{$name}{'link'}})));
299 $retval = $Users->{$name}{'link'}[$tmp];
305 =item B<get_image> (I<$name>)
307 Returns the URL of the (user)name's image, if one is configured.
316 if (defined ($Users->{$name}{'image'}))
318 my $tmp = int (rand (scalar (@{$Users->{$name}{'image'}})));
319 $retval = $Users->{$name}{'image'}[$tmp];
329 Florian octo Forster E<lt>octo at verplant.orgE<gt>