CUDBI::Roles added, along with tests. Next: RolePrivileges, and updat…

…es to User.pm
daoswald · Jun 19, 2012 · 0d6c8ca · 0d6c8ca
1 parent ec8fb01
commit 0d6c8ca
Show file tree

Hide file tree

Showing 11 changed files with 369 additions and 134 deletions.
diff --git a/MANIFEST b/MANIFEST
@@ -3,6 +3,7 @@ lib/Class/User/DBI.pm
 lib/Class/User/DBI/DB.pm
 lib/Class/User/DBI/Privileges.pm
 lib/Class/User/DBI/Domains.pm
+lib/Class/User/DBI/Roles.pm
 Makefile.PL
 MANIFEST			This list of files
 MANIFEST.SKIP
@@ -19,6 +20,7 @@ t/15-class_tests.t
 t/16-cudbi_privileges.t
 t/17-cudbi_db.t
 t/18-cudbi_domains.t
+t/19-cudbi_roles.t
 scripts/cudbi-configdb
 META.json
 META.yml
diff --git a/Makefile.PL b/Makefile.PL
@@ -44,6 +44,10 @@ WriteMakefile(
                 file    => 'lib/Class/User/DBI/Domains.pm',
                 version => '0.01_002',
             },
+            'Class::User::DBI::Roles' => {
+                file    => 'lib/Class/User/DBI/Domains.pm',
+                version => '0.01_002',
+            },
         },
         version   => '0.02',
         resources => {

diff --git a/lib/Class/User/DBI.pm b/lib/Class/User/DBI.pm
@@ -12,7 +12,7 @@ use List::MoreUtils qw( any );
 
 use Authen::Passphrase::SaltedSHA512;
 
-use Class::User::DBI::DB qw( %USER_QUERY _db_run_ex );
+use Class::User::DBI::DB qw( %USER_QUERY db_run_ex );
 
 our $VERSION = '0.01_002';
 $VERSION = eval $VERSION;    ## no critic (eval)
@@ -45,16 +45,16 @@ sub _db_conn {
 sub update_email {
     my ( $self, $new_email ) = @_;
     return if !$self->exists_user;
-    my $sth = $self->_db_run( $USER_QUERY{SQL_update_email},
-        $new_email, $self->userid );
+    my $sth =
+      $self->_db_run( $USER_QUERY{SQL_update_email}, $new_email,
+        $self->userid );
     return $new_email;
 }
 
 sub update_username {
     my ( $self, $new_username ) = @_;
     return if !$self->exists_user;
-    my $sth =
-      $self->_db_run( $USER_QUERY{SQL_update_username},
+    my $sth = $self->_db_run( $USER_QUERY{SQL_update_username},
         $new_username, $self->userid );
     return $new_username;
 }
@@ -82,16 +82,15 @@ sub validated {
 sub _db_run {
     my ( $self, $sql, @ex_params ) = @_;
     my $conn = $self->_db_conn;
-    # We import _db_run_ex() from Class::User::DBI::DB.
-    return _db_run_ex( $conn, $sql, @ex_params );
+
+    # We import db_run_ex() from Class::User::DBI::DB.
+    return db_run_ex( $conn, $sql, @ex_params );
 }
 
 # Fetches all IP's that are whitelisted for the user.
 sub fetch_valid_ips {
     my $self = shift;
-    my $sth =
-      $self->_db_run( $USER_QUERY{SQL_fetch_valid_ips},
-        $self->userid );
+    my $sth = $self->_db_run( $USER_QUERY{SQL_fetch_valid_ips}, $self->userid );
     my @rv;
     while ( defined( my $row = $sth->fetchrow_arrayref ) ) {
         if ( defined $row->[0] ) {
@@ -105,8 +104,7 @@ sub fetch_valid_ips {
 sub fetch_credentials {
     my $self = shift;
     my $sth =
-      $self->_db_run( $USER_QUERY{SQL_fetch_credentials},
-        $self->userid );
+      $self->_db_run( $USER_QUERY{SQL_fetch_credentials}, $self->userid );
     my ( $salt_hex, $pass_hex, $ip_required ) = $sth->fetchrow_array;
     return if not defined $salt_hex;    # User wasn't found.
     my @valid_ips = $self->fetch_valid_ips;
@@ -153,17 +151,15 @@ sub exists_user {
     my $self = shift;
     return $self->{exists_user}
       if $self->{exists_user};    # Only query if we have to.
-    my $sth = $self->_db_run( $USER_QUERY{SQL_exists_user},
-        $self->userid );
+    my $sth = $self->_db_run( $USER_QUERY{SQL_exists_user}, $self->userid );
     return $sth->fetchrow_array;    # Will be undef if user doesn't exist.
 }
 
 # May be useful later on if we add user information.
 sub load_profile {
     my $self = shift;
-    my $sth = $self->_db_run( $USER_QUERY{SQL_load_profile},
-        $self->userid );
-    my $hr = $sth->fetchrow_hashref;
+    my $sth  = $self->_db_run( $USER_QUERY{SQL_load_profile}, $self->userid );
+    my $hr   = $sth->fetchrow_hashref;
     return $hr;
 }
 
@@ -181,8 +177,8 @@ sub add_ips {
     # Prepare the userid,ip bundles for our insert query.
     my @execution_param_bundles =
       map { [ $self->userid, unpack( 'N', inet_aton($_) ) ] } @ips_to_insert;
-    my $sth = $self->_db_run( $USER_QUERY{SQL_add_ips},
-        @execution_param_bundles );
+    my $sth =
+      $self->_db_run( $USER_QUERY{SQL_add_ips}, @execution_param_bundles );
 
     return scalar @ips_to_insert;    # Return a count of IP's inserted.
 }
@@ -196,8 +192,8 @@ sub delete_ips {
     my @ips_for_deletion = grep { exists $found{$_} } @ips;
     my @execution_param_bundles =
       map { [ $self->userid, unpack( 'N', inet_aton($_) ) ] } @ips_for_deletion;
-    my $sth = $self->_db_run( $USER_QUERY{SQL_delete_ips},
-        @execution_param_bundles );
+    my $sth =
+      $self->_db_run( $USER_QUERY{SQL_delete_ips}, @execution_param_bundles );
     return scalar @ips_for_deletion;    # Return a count of IP's deleted.
 }
 
@@ -216,7 +212,7 @@ sub add_user {
     my $ips_aref =
       exists( $userinfo->{ips_aref} )
       ? $userinfo->{ips_aref}
-      : $userinfo->{ips};                          # Detect later if missing.
+      : $userinfo->{ips};               # Detect later if missing.
 
     return if $ip_req && !ref $ips_aref eq 'ARRAY';
 
@@ -261,8 +257,7 @@ sub update_password {
     my $hash_hex = $passgen->hash_hex;
     $self->_db_conn->txn(
         fixup => sub {
-            my $sth =
-              $_->prepare( $USER_QUERY{SQL_update_password} );
+            my $sth = $_->prepare( $USER_QUERY{SQL_update_password} );
             $sth->execute( $salt_hex, $hash_hex, $self->userid );
         }
     );
@@ -274,12 +269,9 @@ sub delete_user {
     return if !$self->exists_user;    # undef if user wasn't in the DB.
     $self->_db_conn->txn(
         fixup => sub {
-            my $sth =
-              $_->prepare(
-                $USER_QUERY{SQL_delete_user_users} );
+            my $sth = $_->prepare( $USER_QUERY{SQL_delete_user_users} );
             $sth->execute( $self->userid );
-            my $sth2 =
-              $_->prepare( $USER_QUERY{SQL_delete_user_ips} );
+            my $sth2 = $_->prepare( $USER_QUERY{SQL_delete_user_ips} );
             $sth2->execute( $self->userid );
         }
     );
@@ -289,7 +281,6 @@ sub delete_user {
     return 1;
 }
 
-
 =cut
 sub fetch_roles {
     my $self = shift;
@@ -330,6 +321,7 @@ sub delete_roles {
     return scalar @prepared_deletes;
 }
 =cut
+
 # Class methods
 
 sub list_users {
@@ -346,7 +338,8 @@ sub configure_db {
       SQL_configure_db_user_ips
 
     );
-#      Deleted: SQL_configure_db_user_roles
+
+    #      Deleted: SQL_configure_db_user_roles
     foreach my $sql_key (@SQL_keys) {
         $conn->run(
             fixup => sub {

diff --git a/lib/Class/User/DBI/DB.pm b/lib/Class/User/DBI/DB.pm
@@ -6,14 +6,20 @@ use warnings;
 use 5.008;
 
 use Exporter;
-our @ISA    = qw( Exporter );     ## no critic (ISA)
-our @EXPORT = qw( _db_run_ex );
-our @EXPORT_OK = qw(  %USER_QUERY  %PRIV_QUERY  %DOM_QUERY _db_run_ex );
+our @ISA       = qw( Exporter );     ## no critic (ISA)
+our @EXPORT    = qw( db_run_ex );    ## no critic (export)
+our @EXPORT_OK = qw(
+  %USER_QUERY
+  %PRIV_QUERY
+  %DOM_QUERY
+  %ROLE_QUERY
+  _db_run_ex
+);
 
 use Carp;
 
 our $VERSION = '0.01_003';
-$VERSION = eval $VERSION;         ## no critic (eval)
+$VERSION = eval $VERSION;            ## no critic (eval)
 
 # ---------------- SQL queries for Class::User::DBI --------------------------
 
@@ -111,6 +117,27 @@ END_SQL
     SQL_list_domains => 'SELECT * FROM cud_domains',
 );
 
+#----------------- Queries for Class::User::DBI::Domains ---------------------
+
+our %ROLE_QUERY = (
+    SQL_configure_db_cud_roles => << 'END_SQL',
+    CREATE TABLE IF NOT EXISTS cud_roles (
+        role        VARCHAR(24)           NOT NULL,
+        description VARCHAR(40)           NOT NULL DEFAULT '',
+        PRIMARY KEY (role)
+    )
+END_SQL
+    SQL_exists_role => 'SELECT role FROM cud_roles WHERE role = ?',
+    SQL_add_roles =>
+      'INSERT INTO cud_roles ( role, description ) VALUES ( ?, ? )',
+    SQL_delete_roles => 'DELETE FROM cud_roles WHERE role = ?',
+    SQL_get_role_description =>
+      'SELECT description FROM cud_roles WHERE role = ?',
+    SQL_update_role_description =>
+      'UPDATE cud_roles SET description = ? WHERE role = ?',
+    SQL_list_roles => 'SELECT * FROM cud_roles',
+);
+
 # ------------------------------ Functions -----------------------------------
 
 # Prepares and executes a database command using DBIx::Connector's 'run'
@@ -123,7 +150,7 @@ END_SQL
 #     [ first param list ], [ second param list ], ...
 # );
 
-sub _db_run_ex {
+sub db_run_ex {
     my ( $conn, $sql, @ex_params ) = @_;
     croak ref($conn) . ' is not a DBIx::Connector.'
       if !$conn->isa('DBIx::Connector');

diff --git a/lib/Class/User/DBI/Domains.pm b/lib/Class/User/DBI/Domains.pm
@@ -1,11 +1,12 @@
+## no critic (RCS,VERSION)
 package Class::User::DBI::Domains;
 
 use strict;
 use warnings;
 
 use Carp;
 
-use Class::User::DBI::DB qw( _db_run_ex  %DOM_QUERY );
+use Class::User::DBI::DB qw( db_run_ex  %DOM_QUERY );
 
 our $VERSION = '0.01_003';
 $VERSION = eval $VERSION;    ## no critic (eval)
@@ -46,13 +47,13 @@ sub _db_conn {
 # returns 0 or 1.
 sub exists_domain {
     my ( $self, $domain ) = @_;
-    croak "Must pass a defined value in domain test."
+    croak 'Must pass a defined value in domain test.'
       if !defined $domain;
-    croak "Must pass a non-empty value in domain test."
+    croak 'Must pass a non-empty value in domain test.'
       if !length $domain;
     return 1 if exists $self->{domains}{$domain};
     my $sth =
-      _db_run_ex( $self->_db_conn, $DOM_QUERY{SQL_exists_domain}, $domain );
+      db_run_ex( $self->_db_conn, $DOM_QUERY{SQL_exists_domain}, $domain );
     my $result = defined $sth->fetchrow_array;
     $self->{domains}{$domain}++ if $result;    # Cache the result.
     return $result;
@@ -74,7 +75,7 @@ sub add_domains {
         # This change is intended to propagate back to @domains_to_insert.
         $dom_bundle->[1] = q{} if !$dom_bundle->[1];
     }
-    my $sth = _db_run_ex( $self->_db_conn, $DOM_QUERY{SQL_add_domains},
+    my $sth = db_run_ex( $self->_db_conn, $DOM_QUERY{SQL_add_domains},
         @domains_to_insert );
     return scalar @domains_to_insert;
 }
@@ -85,11 +86,11 @@ sub delete_domains {
     my ( $self, @domains ) = @_;
     my @domains_to_delete;
     foreach my $domain (@domains) {
-        next if !$domain or !$self->exists_domain($domain);
+        next if !$domain || !$self->exists_domain($domain);
         push @domains_to_delete, [$domain];
         delete $self->{domains}{$domain};    # Remove it from the cache too.
     }
-    my $sth = _db_run_ex( $self->_db_conn, $DOM_QUERY{SQL_delete_domains},
+    my $sth = db_run_ex( $self->_db_conn, $DOM_QUERY{SQL_delete_domains},
         @domains_to_delete );
     return scalar @domains_to_delete;
 }
@@ -102,7 +103,7 @@ sub get_domain_description {
     croak 'Specified domain must exist.'
       if !$self->exists_domain($domain);
     my $sth =
-      _db_run_ex( $self->_db_conn, $DOM_QUERY{SQL_get_domain_description},
+      db_run_ex( $self->_db_conn, $DOM_QUERY{SQL_get_domain_description},
         $domain );
     return ( $sth->fetchrow_array )[0];
 }
@@ -118,15 +119,15 @@ sub update_domain_description {
     croak 'Must specify a description (q{} is ok too).'
       if !defined $description;
     my $sth =
-      _db_run_ex( $self->_db_conn, $DOM_QUERY{SQL_update_domain_description},
+      db_run_ex( $self->_db_conn, $DOM_QUERY{SQL_update_domain_description},
         $description, $domain );
     return 1;
 }
 
 # Returns an array of pairs (AoA).  Pairs are [ domain, description ],...
 sub fetch_domains {
     my $self    = shift;
-    my $sth     = _db_run_ex( $self->_db_conn, $DOM_QUERY{SQL_list_domains} );
+    my $sth     = db_run_ex( $self->_db_conn, $DOM_QUERY{SQL_list_domains} );
     my @domains = @{ $sth->fetchall_arrayref };
     return @domains;
 }