Add support for modifying users to add/change roles

[scpubgit/stemmatology.git] / lib / Text / Tradition / Directory.pm

diff --git a/lib/Text/Tradition/Directory.pm b/lib/Text/Tradition/Directory.pm
index 29bf0f9..341da5c 100644 (file)
--- a/lib/Text/Tradition/Directory.pm
+++ b/lib/Text/Tradition/Directory.pm
@@ -221,12 +221,11 @@ around BUILDARGS => sub {
        return $class->$orig( $args );
 };
 
+## These checks don't cover store($id, $obj)
 before [ qw/ store update insert delete / ] => sub {
        my $self = shift;
        my @nontrad;
        foreach my $obj ( @_ ) {
-#              if( ref( $obj ) && ref( $obj ) ne 'Text::Tradition' ) {
-
                if( ref( $obj ) && ref( $obj ) ne 'Text::Tradition'
             && ref ($obj) ne 'Text::Tradition::User' ) {
                        # Is it an id => Tradition hash?
@@ -278,7 +277,10 @@ sub user_traditionlist {
     my ($self, $user) = @_;
 
     my @tlist;
-    if(ref $user) {
+    if(ref $user && $user->is_admin) {
+        ## Admin sees all
+        return $self->traditionlist();
+    } elsif(ref $user) {
         ## We have a user object already, so just fetch its traditions and use tose
         foreach my $t (@{ $user->traditions }) {
             push( @tlist, { 'id' => $self->object_to_id( $t ), 
@@ -291,7 +293,8 @@ sub user_traditionlist {
     
     ## Search for all traditions which allow public viewing
     ## When they exist!
-    # $self->search({ public => 1 });
+## This needs to be more sophisticated, probably needs Search::GIN
+#    my $list = $self->search({ public => 1 });
     
     ## For now, just fetch all
     ## (could use all_objects or grep down there?)
@@ -366,6 +369,7 @@ sub add_user {
     my ($self, $userinfo) = @_;
     my $username = $userinfo->{url} || $userinfo->{username};
     my $password = $userinfo->{password};
+    my $role = $userinfo->{role} || 'user';
 
     return unless ($username =~ /^https?:/ 
                    || ($username && $self->validate_password($password))) ;
@@ -373,6 +377,7 @@ sub add_user {
     my $user = Text::Tradition::User->new(
         id => $username,
         password => ($password ? crypt_password($password) : ''),
+        role => $role,
     );
 
     $self->store($user->kiokudb_object_id, $user);
@@ -400,7 +405,11 @@ sub find_user {
     # 'url' => 'http://castaway.myopenid.com/',
     my $username = $userinfo->{url} || $userinfo->{username};
 
-    return $self->lookup(Text::Tradition::User->id_for_user($username));
+    ## No logins if user is deactivated (use lookup to fetch to re-activate)
+    my $user = $self->lookup(Text::Tradition::User->id_for_user($username));
+    return if($user && !$user->active);
+
+    return $user;
     
 }
 
@@ -419,13 +428,20 @@ sub modify_user {
     my ($self, $userinfo) = @_;
     my $username = $userinfo->{username};
     my $password = $userinfo->{password};
+    my $role = $userinfo->{role};
 
-    return unless $username && $self->validate_password($password);
+    return unless $username;
+    return if($password && !$self->validate_password($password));
 
     my $user = $self->find_user({ username => $username });
     return unless $user;
 
-    $user->password(crypt_password($password));
+    if($password) {
+        $user->password(crypt_password($password));
+    }
+    if($role) {
+        $user->role($role);
+    }
 
     $self->update($user);
 
@@ -484,7 +500,7 @@ sub reactivate_user {
 
     return if !$username;
 
-    my $user = $self->find_user({ username => $username });
+    my $user = $self->lookup(Text::Tradition::User->id_for_user($username));
     return if !$user;
 
     return $user if $user->active;