The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
##########################################################################
## All portions of this code are copyright (c) 2003,2004 nethype GmbH   ##
##########################################################################
## Using, reading, modifying or copying this code requires a LICENSE    ##
## from nethype GmbH, Franz-Werfel-Str. 11, 74078 Heilbronn,            ##
## Germany. If you happen to have questions, feel free to contact us at ##
## license@nethype.de.                                                  ##
##########################################################################

=head1 NAME

PApp::User - manage users, preferences and access rights

=head1 SYNOPSIS

 use PApp::User;

=head1 DESCRIPTION

This module helps administrate users and groups (groups are more commonly
called "access rights" within PApp). Wherever a so-called "group" or
"access right" is required you can either use a string (group name) or a
number (the numerical group id).

Both usernames and group names must be valid XML-Names (this might or
might not be enforced).

=cut

package PApp::User;

use Convert::Scalar ();

use PApp::SQL;
use PApp::Exception qw(fancydie);
use PApp::Callback ();
use PApp::Config qw(DBH $DBH); DBH;
use PApp::Event ();
use PApp qw($userid *state getuid);

use base Exporter;

$VERSION = 2.0;
@EXPORT = qw( 
   authen_p access_p

   grant_access revoke_access find_access

   grpid
);

DBH;

sub PAPP_USER_MAX_CACHE (){ 1000 }

=head2 Functions

=over 4

=cut

=item grpid grpname-or-grpid

Return the numerical group id of the given group.

=cut

sub grpid($) {
   $gid_cache{$_[0]} ||= 
       ($_[0] > 0
          ? $_[0]
          : sql_fetch $DBH, "select id from grp where name = ?",
                       "$_[0]") || -1;
}

my %access_cache;
my @access_cache; # "splay-lru"(tm) ;^>

PApp::Event::on papp_user => sub {
   shift; # skip event_type
   delete $access_cache{$_} for @_;
};

# get access info from database
sub _fetch_access() {
   delete $access_cache{shift @access_cache}
      while @access_cache > PAPP_USER_MAX_CACHE;

   my $st = sql_exec $DBH, \my($name),
                     "select name
                      from usergrp inner join grp
                           on usergrp.grpid = grp.id
                      where userid = ?",
                     $userid;

   push @access_cache, $userid;

   undef $access_cache{$userid}{$name} while $st->fetch;

   $access_cache{$userid};
}

=item authen_p

Return true when the user has logged in ("authenticitated herself") using
this module

=cut

sub authen_p() {
   $state{papp_auth};
}

=item access_p $grp

Return true when the user has the specified access right (and is logged
in!). This function checks first for the given global access right and
then for the app-specific access right of the same name (by prepending
<appname>\x00 to the name).

=cut

sub access_p($) {
   my $access = $access_cache{$userid} || _fetch_access;
   $state{papp_auth}
      and (exists $access->{$_[0]} or exists $access->{"$papp::papp->{name}\000$_[0]"});
}

=item enum_access [$uid]

Return all access rights of the logged-in (or specified) user.

=cut

sub enum_access {
   die "enum_access NYI";
}

=item grant_access [$userid, ]accessright

Grant the specified access right to the logged-in (or specified) user.

=cut

sub grant_access($;$) {
   my $uid = @_ > 1 ? shift : getuid;
   my $right = shift;
   if (authen_p) {
      sql_exec $DBH, "replace into usergrp values (?, ?)", $uid, grpid $right;
      PApp::Event::broadcast papp_user => $uid;
   } else {
      fancydie "Internal error", "grant_access was called but no user was logged in";
   }
}

=item revoke_access [$userid, ]accessright

Revoke the specified access right to the logged-in (or specified) user.

=cut

sub revoke_access($;$) {
   my $uid = @_ > 1 ? shift : getuid;
   my $right = shift;
   if (authen_p) {
      sql_exec $DBH, "delete from usergrp where userid = ? and grpid = ?", $uid, grpid $right;
      PApp::Event::broadcast papp_user => $uid;
   } else {
      fancydie "Internal error", "revoke_access was called but no user was logged in";
   }
}

=item find_access $accessright

Find all users (uid's) with the given access right.

=cut

sub find_access {
   sql_fetchall $DBH, "select userid from usergrp where grpid = ?", grpid $_[0];
}

1;

=back

=head1 SEE ALSO

L<PApp>.

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/

=cut