Armed with these tools, it was the work of two (short) evenings to implement this system. The accesslevel attribute is introduced for an "application", and the argument to that attribute describes the maximum level a user must have to be allowed to call a method. I use a ranking system where lower access levels mean higher privileges (root has ID 0, as on unix), since this allows adding new levels more easily IMO. So I install my own wrapper around the attributed method of my "application", and check the (implied) current user level against the access level of that method and log an error if the user level is too big. Nice and easy.

Since this is all so nice and easy, there are also some warts. First, if an invocation is rejected, an exception should be raised, since there is no sensible return value to return. Second, the security is only mediocre. The security won't blow up if you manage to call a restricted method from within an unrestricted method (this still raises an access violation), but if you manage to run other, unguarded Perl code, all bets are off.

Enough talking, let's see the code !

The code implements the "security features" and a crude "application" consisting of three pages and two commands. The pages are shown through three commands, show_front, show_inside and show_admin, which show the frontpage (accessible to everybody), the inside of the "website" (accessible only to registered users) and the administration page (accessible only by ROOT). Then there are also the help and quit commands, which show help respective quit the input loop. And there is the backdoor command su [num], which allows you to change your access level on the fly.
But now for the code :

#!/usr/bin/perl -w
use strict;

# For our crude help system, see below
use vars qw/%accessibleCommands/;

{
  # The first package, implementing the "accesslevel" attribute.
  # All objects which implement security must inherit
  # from this package
  package Security;
  
  use Attribute::Handlers;
  use Hook::LexWrap;
  
  use vars qw/$verbose/;
  
  $verbose = 0;
  
  # This is called for each use of ":accessLevel(0)"
  # in a definition of a subroutine
  sub accessLevel :ATTR(CODE) {
    my ($package, $symbol, $referent, $attr, $data, $phase) = @_;
    
    my $name = *{$symbol}{NAME};
    print "Adding $name => $data\n" if $verbose;
    $::accessibleCommands{$name} = $data;
    
    # Install our access level checker :
    wrap *{$symbol}, 
      pre => sub { 
                   my ($self,@args) = @_;
                   if ($self->{"userlevel"} <= $data) {
                     # We will call the original routine
                     $self->log_action($name);
                     #$self->log_action($name,@args);
                     # Why does this crash IndigoPerl 5.6.1, build 626
+ ??
                   } else {
                     $self->log_accessViolation($name,$data);
                     # Due to lack of a better value. 
                     $_[-1] = "Access violation in $name() : Level $da
+ta too large !"; 
                     # Maybe an exception should be raised instead
                   }
                 };
    
    print STDERR
      ref($referent), " $name  ($referent) was just declared ",
      "and ascribed the ${attr} attribute ",
      "with data ($data)\n",
      "in phase $phase\n" if $verbose;
  };

sub new {
  my $self = {
    userlevel => 666,
    username => "Hieronymous Monk",
    url => "<none>",
  };
  my $classname = shift;
  $classname = ref($classname)||$classname;
  bless $self, $classname;
  return $self;
};

sub log_accessViolation {
  my ($session,$symbol,$level) = @_;
  print "ACCESS VIOLATION on $symbol: user: ",$session->{'username'},"
+/",$session->{'userlevel'}," tried ",$session->{'url'},"/$level\n"
};

sub log_action {
  my ($session,@params) = @_;
  print "ACTION: user: ",$session->{username},"/",$session->{'userleve
+l'},":",join("", @params);
};

sub log_error {
  my ($session,$message) = @_;
  print "ERROR: user: ",$session->{'username'},"/",$session->{'userlev
+el'}," $message";
};
1;
}

{
# This is the "application", inheriting from
# the Security package
package secureApp;
no warnings 'redefine'; # because that's what we'll do plenty

use base 'Security';
use UNIVERSAL;

use constant ANONYMOUS => 666;
use constant REGISTERED => 1;
use constant ROOT => 0;

sub export_show_inside :accessLevel(1) {
  my $self = shift;
  print "Showing the inside.\n";
  # return "the inside";
  # Return values are not (yet) well thought out
};

sub export_show_frontpage :accessLevel(666) {
  my $self = shift;
  print "Showing the front page.\n";
};

sub export_show_admin :accessLevel(0) {
  my $self = shift;
  print "Showing the admin page.\n";
};

sub export_su :accessLevel(666) {
  my ($self,$newlevel) = @_;
  $self->{"userlevel"} = $newlevel;
  print "You become a new " . ((rand > 0.5) ? "wo" : "" ) . "man.\n";
};

sub export_quit :accessLevel(666) {
  my ($self) = @_;
  exit 0;
};

sub export_help :accessLevel(666) {
  my ($self) = @_;
  # A really crude help system which dosen't account
  # for multiple classes etc.
  foreach (sort (keys %::accessibleCommands)) {
    print "$1 : $::accessibleCommands{$_}\n" if /^export_(.*)/;
  };
};

# The main (and blind) dispatch loop
sub handle {
  my ($self,$command,@params) = @_;
  
  my $handler = $self->can( "export_$command" );
  if ($handler) {
    #print "$command(", join( ",", @params ), ");\n";
    $self->{"url"} = "export_$command";
    &$handler( $self,@params );
  } else {
    $self->log_error("Invalid command requested: '$command'\n");
  };
};

sub new {
  my $self = new Security;
  
  my $classname = shift;
  $classname = ref($classname)|| $classname;
  bless $self,$classname;
  
  print "Current user level : ",$self->{userlevel},"\n";
  return $self;
};

1;
};

my $app = new secureApp;

print "Type 'help' for commands\n";
print $app->{'userlevel'},">";
while (<>) {
  chomp;
  my ($command, @params) = split / /;
  $app->handle($command,@params) if /./;
  print $app->{'userlevel'},">";
};
[download]

perl -MHTTP::Daemon -MHTTP::Response -MLWP::Simple -e ' ;    # The  
$d = new HTTP::Daemon and fork and getprint $d->url and exit;#spider
($c = $d->accept())->get_request(); $c->send_response( new   #in the
HTTP::Response(200,$_,$_,qq(Just another Perl hacker\n))); ' #  web
[download]