activate user control for stexaminer and root page

diff --git a/lib/Text/Tradition/Directory.pm b/lib/Text/Tradition/Directory.pm
index 674e1b5..0734168 100644 (file)
--- a/lib/Text/Tradition/Directory.pm
+++ b/lib/Text/Tradition/Directory.pm
@@ -224,7 +224,8 @@ around BUILDARGS => sub {
        my @column_args;
        if( $args->{'dsn'} =~ /^dbi/ ) { # We're using Backend::DBI
                @column_args = ( 'columns',
-                       [ 'name' => { 'data_type' => 'varchar', 'is_nullable' => 1 } ] );
+                       [ 'name' => { 'data_type' => 'varchar', 'is_nullable' => 1 },
+                         'public' => { 'data_type' => 'bool', 'is_nullable' => 1 } ] );
        }
        my $ea = $args->{'extra_args'};
        if( ref( $ea ) eq 'ARRAY' ) {
@@ -304,7 +305,7 @@ sub tradition {
 
 sub user_traditionlist {
     my ($self, $user) = @_;
-
+    
     my @tlist;
     if(ref $user && $user->is_admin) {
         ## Admin sees all
@@ -321,13 +322,8 @@ sub user_traditionlist {
     }
     
     ## Search for all traditions which allow public viewing
-    ## When they exist!
-## 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?)
-    return $self->traditionlist();
+       my @list = grep { $_->{public} } $self->traditionlist();
+       return @list;
 }
 
 sub traditionlist {
@@ -347,18 +343,19 @@ sub traditionlist {
                $connection[3]->{'sqlite_unicode'} = 1 if $dbtype eq 'SQLite';
                $connection[3]->{'pg_enable_utf8'} = 1 if $dbtype eq 'Pg';
                my $dbh = DBI->connect( @connection );
-               my $q = $dbh->prepare( 'SELECT id, name from entries WHERE class = "Text::Tradition"' );
+               my $q = $dbh->prepare( 'SELECT id, name, public from entries WHERE class = "Text::Tradition"' );
                $q->execute();
                while( my @row = $q->fetchrow_array ) {
                        my( $id, $name ) = @row;
                        # Horrible horrible hack
                        $name = decode_utf8( $name ) if $dbtype eq 'mysql';
-                       push( @tlist, { 'id' => $row[0], 'name' => $row[1] } );
+                       push( @tlist, { 'id' => $row[0], 'name' => $row[1], 'public' => $row[2] } );
                }
        } else {
                $self->scan( sub { my $o = shift; 
                                                   push( @tlist, { 'id' => $self->object_to_id( $o ), 
-                                                                                  'name' => $o->name } ) } );
+                                                                                  'name' => $o->name,
+                                                                                  'public' => $o->public } ) } );
        }
        return @tlist;
 }
@@ -495,13 +492,13 @@ sub modify_user {
     my $password = $userinfo->{password};
     my $role = $userinfo->{role};
 
-    throw( "Missing username or bad password" )
-       unless $username && $self->validate_password($password);
+    throw( "Missing username" ) unless $username;
 
     my $user = $self->find_user({ username => $username });
     throw( "Could not find user $username" ) unless $user;
 
     if($password) {
+       throw( "Bad password" ) unless $self->validate_password($password);
         $user->password(crypt_password($password));
     }
     if($role) {

diff --git a/script/admin_users.pl b/script/admin_users.pl
index 737573d..a532f0d 100644 (file)
--- a/script/admin_users.pl
+++ b/script/admin_users.pl
@@ -12,7 +12,7 @@ use lib 'lib';
 
 use Text::Tradition::Directory;
 
-my ($dsn, $command) = ('dbi:SQLite:dbname=db/traditions.db', 'add');
+my ($dsn, $command) = ('dbi:SQLite:dbname=stemmaweb/db/traditions.db', 'add');
 my ($username, $password, $tradition_id, $rolename);
 
 GetOptions(

diff --git a/stemmaweb/lib/stemmaweb/Controller/Stexaminer.pm b/stemmaweb/lib/stemmaweb/Controller/Stexaminer.pm
index 16c515f..72f8fc8 100644 (file)
--- a/stemmaweb/lib/stemmaweb/Controller/Stexaminer.pm
+++ b/stemmaweb/lib/stemmaweb/Controller/Stexaminer.pm
@@ -33,6 +33,8 @@ sub index :Path :Args(1) {
     my( $self, $c, $textid ) = @_;
     my $m = $c->model('Directory');
        my $tradition = $m->tradition( $textid );
+       my $ok = _check_permission( $c, $tradition );
+       return unless $ok;
        if( $tradition->stemma_count ) {
                my $stemma = $tradition->stemma(0);
                $c->stash->{svg} = $stemma->as_svg( { size => [ 600, 350 ] } );
@@ -92,6 +94,25 @@ sub _stringify_element {
        }
 }
 
+sub _check_permission {
+       my( $c, $tradition ) = @_;
+    my $user = $c->user_exists ? $c->user->get_object : undef;
+    if( $user ) {
+       $c->stash->{'permission'} = 'full'
+               if( $user->is_admin || $tradition->user->id eq $user->id );
+       return 1;
+    } elsif( $tradition->public ) {
+       $c->stash->{'permission'} = 'readonly';
+       return 1;
+    } else {
+       # Forbidden!
+       $c->response->status( 403 );
+       $c->response->body( 'You do not have permission to view this tradition.' );
+       $c->detach( 'View::Plain' );
+       return 0;
+    }
+}
+
 =head2 graphsvg
 
   POST stexaminer/graphsvg