view release on metacpan or  search on metacpan

examples/cudbi-example  view on Meta::CPAN

# Assign some privileges to roles.

my $wkrp = Class::User::DBI::RolePrivileges->new( $conn, 'workers'     );
my $plrp = Class::User::DBI::RolePrivileges->new( $conn, 'players'     );
my $prrp = Class::User::DBI::RolePrivileges->new( $conn, 'principles'  );
$wkrp->add_privileges( 'work',  'work_hard'                        );
$plrp->add_privileges( 'play',  'rest'                             );
$prrp->add_privileges( 'worry', 'work_hard',  'play', 'administer' );

# Create some domains.

my $d = Class::User::DBI::Domains->new( $conn );
$d->add_domains( [ 'east',  'The Eastern territories'  ],
                 [ 'west',  'The Western territories'  ],
                 [ 'north', 'The Northern territories' ],
                 [ 'south', 'The Southern territories' ],
);

# Now add a user.
my $user = Class::User::DBI->new( $conn, 'kahn' );

$user->add_user( {
    password => 'The rain in Spain falls mainly on the planes.',
    ip_req   => 1,
    username => 'Ghengis Kahn',
    email    => 'wreker@havoc.net',
    ips      => [ '192.168.0.1', '127.0.0.1' ],
    role     => 'principles',
    domains  => [ qw( east west north south ) ],
} );


print $user->userid, ": He's the real deal!\n"
    if $user->validate(
        'The rain in Spain falls mainly on the planes.', '192.168.0.1' );

print "He rules the north.\n"
    if $user->user_domains->has_domain( 'north' );
    
my @domains = $user->user_domains->fetch_domains;
print "In fact he is feared @domains!\n";

print "He's in charge of it all.\n" if $user->is_role( 'principles' );

print "Nobody can stop him from playing.\n"
    if $user->role_privileges->has_privilege( 'play' );

print "He can't stand by and watch...."
    if ! $user->role_privileges->has_privilege( 'watch' );

print " He never sleeps!\n"
    if ! $user->role_privileges->has_privilege( 'rest' );


my $profile = $user->load_profile;
print "He is $profile->{username}!\n";

print "And here is everything you need to know about him:\n";
print Dumper $profile;

my $credentials = $user->get_credentials;
print "And these are his secrets:\n";
print Dumper $credentials;

print "But eventually everyone kicks the bucket... " if $user->delete_user;

print "Loses validity,\n"
    if ! $user->validated;
    
print "And ceases to exist.\n"
    if ! $user->exists_user;