The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/env perl

use strict;
use warnings;
use v5.008;

use Class::User::DBI::Roles;
use Class::User::DBI::Privileges;
use Class::User::DBI::Domains;
use Class::User::DBI::RolePrivileges;
use Class::User::DBI::UserDomains;
use Class::User::DBI;

use DBIx::Connector;

use Data::Dumper;
$Data::Dumper::Terse  = 1;
$Data::Dumper::Indent = 1;
$Data::Dumper::Sortkeys = 1;

# SQLite database settings.
my $dsn     = 'dbi:SQLite:dbname=:memory:';
my $db_user = q{};
my $db_pass = q{};

# mysql database settings.
# my $database = 'cudbi_test';
# my $dsn      = "dbi:mysql:database=$database";
# my $db_user  = 'tester';
# my $db_pass  = 'testers_pass';

my $conn = DBIx::Connector->new(
    $dsn, $db_user, $db_pass,
    {
        RaiseError => 1,
        AutoCommit => 1,
    }
);

my @classes = qw(
    Class::User::DBI::Roles
    Class::User::DBI::Privileges
    Class::User::DBI::Domains
    Class::User::DBI::RolePrivileges
    Class::User::DBI::UserDomains
    Class::User::DBI
);

foreach my $class ( @classes ) {
    $class->configure_db( $conn );
}

# Create some roles.

my $r = Class::User::DBI::Roles->new( $conn );
$r->add_roles( [ 'workers',     'Those who work'    ],
               [ 'players',     'Those who play'    ],
               [ 'principles',  'Those who care'    ],
);

# Create some privileges.

my $p = Class::User::DBI::Privileges->new( $conn );
$p->add_privileges( [ 'work',       'The right to work'       ],
                    [ 'work_hard',  'The right to work hard'  ],
                    [ 'play',       'The right to play'       ],
                    [ 'worry',      'The right to worry'      ],
                    [ 'administer', 'The right to administer' ],
                    [ 'watch',      'The right to watch'      ],
                    [ 'rest',       'The right to rest'       ],
);

# 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;