lib/SGN/Authentication/User.pm

   1 =head1 NAME
   2
   3 SGN::Authentication::User - a Catalyst compatible user class
   4
   5 =head1 DESCRIPTION
   6
   7 Implemented according to Catalyst::Plugin::Authentication::Internals
   8
   9 =head1 AUTHOR
  10
  11 Lukas Mueller <lam87@cornell.edu>
  12
  13 =cut
  14
  15 use strict;
  16 use warnings;
  17
  18 package SGN::Authentication::User;
  19
  20 use base "Catalyst::Authentication::User";
  21
  22 sub id {
  23     my $self = shift;
  24     return $self->{user}->get_username();
  25 }
  26
  27 sub supported_features {
  28     my $self = shift;
  29     return { roles =>1,  self_check=>1};
  30 }
  31
  32 sub get_object {
  33     my $self = shift;
  34     return $self->{user};
  35 }
  36
  37 sub set_object {
  38     my $self = shift;
  39     $self->{user} = shift;
  40 }
  41
  42 sub roles {
  43     my $self = shift;
  44     return $self->{user}->get_roles();
  45 }
  46
  47 sub check_roles {
  48     my $self = shift;
  49     my @roles = @_;
  50     my %has_roles = ();
  51     map { $has_roles{$_} = 1; } $self->roles();
  52
  53     foreach my $r (@roles) {
  54         if (!exists($has_roles{$r})) {
  55             return 0;
  56         }
  57     }
  58     return 1;
  59 }
  60
  61 1;