#/usr/bin/perl
use v5.14.2;
use strict;
use warnings;
use Data::Dumper;
use DBIx::Class;
use My::Schema;
use Config::Any;
# set config file and load it
my $config_file = './config.yml' ;
# retreives information from first entry in array.
my $cfg = Config::Any->load_files({
files => [$config_file],
use_ext => 1
})->[0]->{$config_file};
# load db_config
my $db_config = $cfg->{'Database'};
my $db_name = $db_config->{'db_name'};
my $db_driver = $db_config->{'db_driver'};
my $user_name = $db_config->{'user_name'};
my $password = $db_config->{'password'};
my $db_host = $db_config->{'db_host'} || 'localhost';
#create dsn
my $dsn = $db_config->{'dsn'}
|| "dbi:$db_driver:dbname=$db_name;host=$db_host";
$dsn .= ';port=' . $db_config->{'port'} if $db_config->{'port'};
# deploy Schema
my $schema = My::Schema->connect($dsn, $user_name, $password);
$schema->deploy({ add_drop_table => 1});
# add new row
say "[*] Creating artist and insertng albums";
my $new_album = $schema->resultset('Artist')->create(
{
artist => 'Pink Floyd',
albums => [
{ title => 'Wish You Were Here', rank => '2', },
{ title => 'The Wall', rank => '3', },
{ title => 'Dark Side of the Moon', rank => '1',},
],
},
);
$new_album->update;
say "[*] Searching Database for Artist";
my $rs = $schema->resultset('Artist');
my $res = $rs->search ({ artist => "Pink Floyd" })->single;
say "[*] Printing titles of Albums";
say $_->title foreach $res->albums->all;
say "[*] Creating Roles";
$schema->populate('Role', [
[ qw/role rank/, ],
[ 'Administrator', '-1',],
[ 'Contributor', '2', ],
[ 'User', '3', ],
]
);
say "[*] Creating Users";
#$schema->create({passphrase => 'plain'});
$schema->populate('User', [
[ qw/ username password user_roles/, ],
[ 'test1', 'test1', [ 'Administrator', 'Contributor', 'User',], ],
[ 'test2', 'test2', qw/Administrator/, ],
[ 'test3', 'test3', qw/Contributor/, ],
[ 'test4', 'test4', qw/User/, ],
[ 'test5', 'test5', qw/Contributor User/, ],
],
);
####
package My::Schema::Result::User;
use strict;
use warnings;
use Moose;
use MooseX::NonMoose;
use namespace::autoclean;
#use base qw/DBIx::Class::Core/;
extends 'DBIx::Class::Core';
__PACKAGE__->load_components(qw/ InflateColumn::DateTime Ordered TimeStamp PassphraseColumn /);
__PACKAGE__->position_column('user_id');
__PACKAGE__->table('users');
__PACKAGE__->add_columns(
user_id =>
{ accessor => 'userid',
data_type => 'integer',
size => 16,
is_nullable => 0,
is_auto_increment => 1,
},
username =>
{ accessor => 'username',
data_type => 'varchar',
size => 256,
is_nullable => 0,
is_auto_increment => 0,
},
# Have the 'password' column use a SHA-1 hash and
# 20-byte salt
# with RFC 2307 encoding; Generate the
# 'check_password' method
password =>
{ data_type => 'varchar',
size => 256,
is_nullable => 0,
is_auto_increment => 0,
passphrase => 'rfc2307',
passphrase_class => 'SaltedDigest',
passphrase_args => {
algorithm => 'SHA-1',
salt_random => 20.
},
passphrase_check_method
=> 'check_password',
},
email_address =>
{ data_type => "varchar",
size => 256,
is_nullable => 1,
},
last_name =>
{ data_type => "varchar",
size => 100,
is_nullable => 1,
},
active =>
{ data_type => "integer",
size => 1,
is_nullable => 1,
},
);
__PACKAGE__->set_primary_key('user_id');
__PACKAGE__->has_many(
user_roles => 'My::Schema::Result::UserRole',
{ "foreign.user_id" => "self.id" },
{ cascade_copy => 0, cascade_delete => 0 },
);
# many_to_many():
# args:
# 1) Name of relationship,
# DBIC will create accessor with this name
# 2) Name of has_many() relationship
# this many_to_many() is shortcut for
# 3) Name of belongs_to() relationship
# in model class of has_many() above
# You must already have the has_many()
# defined to use a many_to_many().
__PACKAGE__->many_to_many(roles => 'user_roles', 'role');
=head2 has_role
Check if a user has the specified role
=cut
use Perl6::Junction qw/any/;
sub has_role {
my ($self, $role) = @_;
# Does this user posses the required role?
return any(map { $_->role } $self->roles) eq $role;
}
__PACKAGE__->meta->make_immutable;
1;
__END__
####
DBIx::Class::Row::new(): new_result needs a hash at /usr/lib/perl5/Class/MOP/Method.pm line 125
####
perl deploy.pl
Ignoring relationship 'user_roles' - related resultsource 'MyApp::Schema::Result::UserRole' is not registered with this schema
Ignoring relationship 'role' - related resultsource 'MyApp::Schema::Result::Role' is not registered with this schema
Ignoring relationship 'user' - related resultsource 'MyApp::Schema::Result::User' is not registered with this schema
NOTICE: drop cascades to constraint album_artistid_fkey on table album
NOTICE: CREATE TABLE will create implicit sequence "artist_artistid_seq" for serial column "artist.artistid"
NOTICE: CREATE TABLE / PRIMARY KEY will create implicit index "artist_pkey" for table "artist"
NOTICE: CREATE TABLE will create implicit sequence "roles_role_id_seq" for serial column "roles.role_id"
NOTICE: CREATE TABLE / PRIMARY KEY will create implicit index "roles_pkey" for table "roles"
NOTICE: CREATE TABLE / PRIMARY KEY will create implicit index "user_role_pkey" for table "user_role"
NOTICE: CREATE TABLE will create implicit sequence "users_user_id_seq" for serial column "users.user_id"
NOTICE: CREATE TABLE / PRIMARY KEY will create implicit index "users_pkey" for table "users"
NOTICE: CREATE TABLE will create implicit sequence "album_albumid_seq" for serial column "album.albumid"
NOTICE: CREATE TABLE / PRIMARY KEY will create implicit index "album_pkey" for table "album"
[*] Creating artist and insertng albums
[*] Searching Database for Artist
[*] Printing titles of Albums
Dark Side of the Moon
The Wall
Wish You Were Here
[*] Creating Roles
[*] Creating Users
Odd number of elements in anonymous hash at deploy.pl line 77.
Odd number of elements in anonymous hash at deploy.pl line 77.
Odd number of elements in anonymous hash at deploy.pl line 77.
Odd number of elements in anonymous hash at deploy.pl line 77.
DBIx::Class::Schema::populate(): HASH(0x382f740) reference found where bind expected for column 'roles' in populate slice:
{
roles => {
Administrator => undef
},
username => "test2"
} at deploy.pl line 77
####
perl deploy.pl
Ignoring relationship 'user_roles' - related resultsource 'MyApp::Schema::Result::UserRole' is not registered with this schema
Ignoring relationship 'role' - related resultsource 'MyApp::Schema::Result::Role' is not registered with this schema
Ignoring relationship 'user' - related resultsource 'MyApp::Schema::Result::User' is not registered with this schema
NOTICE: drop cascades to constraint album_artistid_fkey on table album
NOTICE: CREATE TABLE will create implicit sequence "artist_artistid_seq" for serial column "artist.artistid"
NOTICE: CREATE TABLE / PRIMARY KEY will create implicit index "artist_pkey" for table "artist"
NOTICE: CREATE TABLE will create implicit sequence "roles_role_id_seq" for serial column "roles.role_id"
NOTICE: CREATE TABLE / PRIMARY KEY will create implicit index "roles_pkey" for table "roles"
NOTICE: CREATE TABLE / PRIMARY KEY will create implicit index "user_role_pkey" for table "user_role"
NOTICE: CREATE TABLE will create implicit sequence "users_user_id_seq" for serial column "users.user_id"
NOTICE: CREATE TABLE / PRIMARY KEY will create implicit index "users_pkey" for table "users"
NOTICE: CREATE TABLE will create implicit sequence "album_albumid_seq" for serial column "album.albumid"
NOTICE: CREATE TABLE / PRIMARY KEY will create implicit index "album_pkey" for table "album"
[*] Creating artist and insertng albums
[*] Searching Database for Artist
[*] Printing titles of Albums
Dark Side of the Moon
The Wall
Wish You Were Here
[*] Creating Roles
[*] Creating Users
DBIx::Class::Schema::populate(): ARRAY(0x2f066c8) reference found where bind expected for column 'roles' in populate slice:
{
roles => [
"Administrator"
],
username => "test2"
} at deploy.pl line 77
####
Ignoring relationship 'user_roles' - related resultsource 'MyApp::Schema::Result::UserRole' is not registered with this schema
Ignoring relationship 'role' - related resultsource 'MyApp::Schema::Result::Role' is not registered with this schema
Ignoring relationship 'user' - related resultsource 'MyApp::Schema::Result::User' is not registered with this schema