X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FText%2FTradition%2FDirectory.pm;h=341da5cabc9cc9cd44f6375d906ac22457c132fc;hb=4d4c578966a8dde9fdf7d1a1c339435344f91c47;hp=c6eafc0d2d7088564f6cc25bc68254a9cb012c6a;hpb=cf7e4e7bbd96ff1cd20f79032af32e85f968d0c8;p=scpubgit%2Fstemmatology.git diff --git a/lib/Text/Tradition/Directory.pm b/lib/Text/Tradition/Directory.pm index c6eafc0..341da5c 100644 --- a/lib/Text/Tradition/Directory.pm +++ b/lib/Text/Tradition/Directory.pm @@ -35,11 +35,37 @@ Text::Tradition::Directory - a KiokuDB interface for storing and retrieving trad foreach my $id ( $d->traditions ) { print $d->tradition( $id )->name; } + + ## Users: + my $userstore = Text::Tradition::UserStore->new(dsn => 'dbi:SQLite:foo.db'); + my $newuser = $userstore->add_user({ username => 'fred', + password => 'somepassword' }); + + my $fetchuser = $userstore->find_user({ username => 'fred' }); + if($fetchuser->check_password('somepassword')) { + ## login user or .. whatever + } + + my $user = $userstore->deactivate_user({ username => 'fred' }); + if(!$user->active) { + ## shouldnt be able to login etc + } =head1 DESCRIPTION Text::Tradition::Directory is an interface for storing and retrieving text traditions and all their data, including an associated stemma hypothesis. It is an instantiation of a KiokuDB::Model, storing traditions and associated stemmas by UUID. +=head1 ATTRIBUTES + +=head2 MIN_PASS_LEN + +Constant for the minimum password length when validating passwords, +defaults to "8". + +=cut + +has MIN_PASS_LEN => ( is => 'ro', isa => 'Num', default => sub { 8 } ); + =head1 METHODS =head2 new @@ -195,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? @@ -248,11 +273,43 @@ sub tradition { return $obj; } +sub user_traditionlist { + my ($self, $user) = @_; + + my @tlist; + 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 ), + 'name' => $t->name } ); + } + return @tlist; + } elsif($user ne 'public') { + die "Passed neither a user object nor 'public' to 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(); +} + sub traditionlist { my $self = shift; + my ($user) = @_; + + return $self->user_traditionlist($user) if($user); + + my @tlist; # If we are using DBI, we can do it the easy way; if not, the hard way. # Easy way still involves making a separate DBI connection. Ew. - my @tlist; if( $self->dsn =~ /^dbi:(\w+):/ ) { my $dbtype = $1; my @connection = @{$self->directory->backend->connect_info}; @@ -284,46 +341,6 @@ sub throw { ); } -=head1 NAME - -Text::Tradition::UserStore - KiokuDB storage management for Users - -=head1 SYNOPSIS - - my $userstore = Text::Tradition::UserStore->new(dsn => 'dbi:SQLite:foo.db'); - my $newuser = $userstore->add_user({ username => 'fred', - password => 'somepassword' }); - - my $fetchuser = $userstore->find_user({ username => 'fred' }); - if($fetchuser->check_password('somepassword')) { - ## login user or .. whatever - } - - my $user = $userstore->deactivate_user({ username => 'fred' }); - if(!$user->active) { - ## shouldnt be able to login etc - } - -=head1 DESCRIPTION - -A L for managing the storage and creation of -L objects. Subclass or replace this module in -order to use a different source for stemmaweb users. - -=head2 ATTRIBUTES - -=head3 dsn - -Inherited from KiokuX::Model - dsn for the data store we are using. - -=head3 MIN_PASS_LEN - -Constant for the minimum password length when validating passwords, -defaults to "8". - -=cut - -has MIN_PASS_LEN => ( is => 'ro', isa => 'Num', default => sub { 8 } ); # has 'directory' => ( # is => 'rw', @@ -340,9 +357,7 @@ has MIN_PASS_LEN => ( is => 'ro', isa => 'Num', default => sub { 8 } ); ## To die or not to die, on error, this is the question. -=head2 METHODS - -=head3 add_user +=head2 add_user Takes a hashref of C, C. @@ -354,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))) ; @@ -361,9 +377,9 @@ sub add_user { my $user = Text::Tradition::User->new( id => $username, password => ($password ? crypt_password($password) : ''), + role => $role, ); - my $scope = $self->new_scope; $self->store($user->kiokudb_object_id, $user); return $user; @@ -374,7 +390,7 @@ sub create_user { return $self->add_user(@_); } -=head3 find_user +=head2 find_user Takes a hashref of C, optionally C. @@ -389,11 +405,15 @@ 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; } -=head3 modify_user +=head2 modify_user Takes a hashref of C and C (same as add_user). @@ -408,21 +428,27 @@ 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 $scope = $self->new_scope; 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); return $user; } -=head3 deactivate_user +=head2 deactivate_user Takes a hashref of C. @@ -448,7 +474,6 @@ sub deactivate_user { ## Not implemented yet # $tradition->public(0); } - my $scope = $self->new_scope; ## Should we be using Text::Tradition::Directory also? $self->update(@{ $user->traditions }); @@ -458,7 +483,7 @@ sub deactivate_user { return $user; } -=head3 reactivate_user +=head2 reactivate_user Takes a hashref of C. @@ -475,8 +500,7 @@ sub reactivate_user { return if !$username; - my $scope = $self->new_scope; - 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; @@ -487,9 +511,9 @@ sub reactivate_user { return $user; } -=head3 delete_user +=head2 delete_user -CAUTION: Delets actual data! +CAUTION: Deletes actual data! Takes a hashref of C. @@ -505,7 +529,6 @@ sub delete_user { return if !$username; - my $scope = $self->new_scope; my $user = $self->find_user({ username => $username }); return if !$user; @@ -518,7 +541,7 @@ sub delete_user { return 1; } -=head3 validate_password +=head2 validate_password Takes a password string. Returns true if it is longer than L, false otherwise.