###################################################################### # # EPrints::DataObj::User # ###################################################################### # # ###################################################################### =pod =for Pod2Wiki =head1 NAME B - Class representing a single user. =head1 DESCRIPTION This class represents a single eprint user record and the metadata associated with it. This class is a subclass of L with the following metadata fields, along with fields in C. =head1 CORE METADATA FIELDS =over 4 =item userid (int) The unique ID number of this user record. Unique within the current repository. =item rev_number (int) The revision number of this record. Each time it is changed the revision number is increased. This is not currently used for anything but it may be used for logging later. =item username (text) The username of this user. Used for logging into the system. Unique within this repository. =item password (secret) The crypted password for this user as generated by L. This may be ignored if for example LDAP authentication is being used. =item usertype (namedset) The type of this user. The options are configured in C. =item newemail (email) Used to store a new but as yet unconfirmed email address. =item newpassword (secret) Used to store a new but as yet unconfirmed password. =item pin (text) A code required to confirm a new username or password. This code is emailed to the user to confirm they are who they say they are. =item pinsettime (int) When the pin code was set, so we can make it time out. =item loginattempts (int) Number of login attempts since last successful login. =item unlocktime (int) Time at which user account will be unlocked after too many failed login attempts. =item joined (time) The date and time that the user account was created. Before EPrints 2.4 this was a date field so users created before the upgrade will appear to have been created at midnight. =item email (email) The email address of this user. Unique within the repository. =item lang (arclanguage) The ID of the preferred language of this user. Only really used in multilingual repositories. =item editperms (search, multiple) This field is used to filter what eprints a staff member can approve and modify. If it's unset then they can modify any (given the correct privs. but if it is set then an eprint must match at least one of the searches to be within their scope. =item frequency (set) Only relevant to staff accounts. Is the frequency they want to be mailed about eprints matching their scope that are in editorial review. never, daily, weekly or monthly. =item mailempty (boolean) Only relevant to staff accounts. If set to true then emails are sent even if there are no items matching the scope. =item latitude (float) The latitude of the location where the user is based. =item longitude (float) The longitude of the location where the user is based. =item preference (storable) User preferences which need to be persistent. Stored as a serialization of simple key-value pairs. =item captcha (recaptcha) A ReCAPTCHA field to use to protect user password resets and similar forms from being spammed. =back =head1 REFERENCES AND RELATED OBJECTS =over 4 =item saved_searches (subobject, multiple) Saved searches created by this user. =item item_fields (fields, multiple) Stores bespoke metafields created by this user and stored in the database. =head1 INSTANCE VARIABLES See L. =back =head1 METHODS =cut package EPrints::DataObj::User; @ISA = ( 'EPrints::DataObj' ); use EPrints; use EPrints::Search; use strict; # Privs and Role related methods # this maps roles onto privs my $PRIVMAP = { general => [ "user/view:owner", "user/details:owner", "user/history:owner", ], "edit-own-record" => [ "user/edit:owner", ], "set-password" => [ "set-password", ], "change-email" => [ # not done ], "change-user" => [ # not done ], "staff-view" => [ # still needs search tools "eprint/inbox/view", "eprint/inbox/summary", "eprint/inbox/export", "eprint/inbox/details", "eprint/inbox/history", "eprint/buffer/view", "eprint/buffer/summary", "eprint/buffer/export", "eprint/buffer/details", "eprint/buffer/history", "eprint/archive/view", "eprint/archive/export", "eprint/archive/details", "eprint/archive/history", "eprint/deletion/view", "eprint/deletion/summary", "eprint/deletion/export", "eprint/deletion/details", "eprint/deletion/history", "eprint/search/staff", ], "view-status" => [ "status" ], "admin" => [ "indexer/stop", "indexer/start", "indexer/force_start", "create_user", "subject/edit", "staff/user_search", "staff/history_search", "staff/issue_search", "config/view", "config/view/xml", "config/view/workflow", "config/view/citation", "config/view/phrase", "config/view/namedset", "config/view/template", "config/view/static", "config/view/autocomplete", "config/view/apache", "config/view/perl", "config/test_email", "config/imports", "config/add_field", "config/remove_field", "config/regen_abstracts", "config/regen_citations", "config/regen_views", "config/edit/perl", "storage/manager", "repository/epm", #EPrints Package Manager "event_queue/destroy", "event_queue/details", "event_queue/edit", "event_queue/export", "event_queue/view", "eprint/destroy", "eprint/details", "eprint/edit", "eprint/export", "eprint/upsert", "eprint/view", "eprint/archive/remove", "eprint/archive/edit", # BatchEdit "file/destroy", "file/export", "file/view", "import/view", "import/edit", "saved_search/destroy", "saved_search/details", "saved_search/edit", "saved_search/export", "saved_search/view", "user/remove", "user/edit", "user/view", "user/details", "user/destroy", "user/history", "user/staff/edit", "repository/epm-submit", #EPrints Package Manager - Bazaar Package Submission ], "toolbox" => [ "toolbox", ], "edit-config" => [ "config/edit", "config/edit/xml", "config/edit/workflow", "config/edit/citation", "config/edit/phrase", "config/edit/namedset", "config/edit/template", "config/edit/static", "config/edit/autocomplete", # not editing perl files or apache files! "config/reload", ], "saved-searches" => [ "saved_search", "create_saved_search", "saved_search/view:owner", "saved_search/edit:owner", "saved_search/destroy:owner", ], deposit => [ "items", "create_eprint", "user/history:owner", "eprint/inbox/view:owner", "eprint/inbox/export:owner", "eprint/inbox/summary:owner", "eprint/inbox/destroy:owner", "eprint/inbox/deposit:owner", "eprint/inbox/edit:owner", "eprint/inbox/remove:owner", "eprint/inbox/details:owner", "eprint/inbox/history:owner", "eprint/inbox/messages:owner", "eprint/inbox/issues:owner", "eprint/inbox/deposit:owner", "eprint/inbox/use_as_template:owner", "eprint/inbox/derive_version:owner", "eprint/buffer/view:owner", "eprint/buffer/export:owner", "eprint/buffer/summary:owner", "eprint/buffer/move_inbox:owner", "eprint/buffer/details:owner", "eprint/buffer/history:owner", "eprint/buffer/messages:owner", "eprint/buffer/request_removal:owner", "eprint/buffer/use_as_template:owner", "eprint/buffer/derive_version:owner", "eprint/archive/view:owner", "eprint/archive/export:owner", "eprint/archive/summary:owner", "eprint/archive/details:owner", "eprint/archive/history:owner", "eprint/archive/messages:owner", "eprint/archive/request_removal:owner", "eprint/archive/use_as_template:owner", "eprint/archive/derive_version:owner", "eprint/deletion/view:owner", "eprint/deletion/export:owner", "eprint/deletion/summary:owner", "eprint/deletion/details:owner", "eprint/deletion/history:owner", "eprint/deletion/messages:owner", "eprint/deletion/use_as_template:owner", "eprint/deletion/derive_version:owner", ], editor => [ "datasets", "editorial_review", "eprint/inbox/view:editor", "eprint/inbox/export:editor", "eprint/inbox/summary:editor", "eprint/inbox/export:editor", "eprint/inbox/details:editor", "eprint/inbox/history:editor", "eprint/inbox/messages:editor", "eprint/inbox/remove_with_email:editor", "eprint/inbox/move_archive:editor", "eprint/inbox/move_buffer:editor", "eprint/inbox/use_as_template:editor", "eprint/inbox/derive_version:editor", "eprint/inbox/edit:editor", "eprint/inbox/takelock:editor", "eprint/buffer/view:editor", "eprint/buffer/export:editor", "eprint/buffer/summary:editor", "eprint/buffer/export:editor", "eprint/buffer/details:editor", "eprint/buffer/history:editor", "eprint/buffer/messages:editor", "eprint/buffer/issues:editor", "eprint/buffer/remove_with_email:editor", "eprint/buffer/reject_with_email:editor", "eprint/buffer/move_inbox:editor", "eprint/buffer/move_archive:editor", "eprint/buffer/move_deletion:editor", "eprint/buffer/use_as_template:editor", "eprint/buffer/derive_version:editor", "eprint/buffer/edit:editor", "eprint/buffer/takelock:editor", "eprint/archive/view:editor", "eprint/archive/export:editor", "eprint/archive/details:editor", "eprint/archive/history:editor", "eprint/archive/messages:editor", "eprint/archive/issues:editor", "eprint/archive/move_buffer:editor", "eprint/archive/move_deletion:editor", "eprint/archive/use_as_template:editor", "eprint/archive/derive_version:editor", "eprint/archive/edit:editor", "eprint/archive/takelock:editor", "eprint/deletion/view:editor", "eprint/deletion/export:editor", "eprint/deletion/summary:editor", "eprint/deletion/export:editor", "eprint/deletion/details:editor", "eprint/deletion/history:editor", "eprint/deletion/messages:editor", "eprint/deletion/move_archive:editor", "eprint/deletion/move_buffer:editor", "eprint/deletion/use_as_template:editor", "eprint/deletion/derive_version:editor", "eprint/deletion/takelock:editor", ], rest => [ "eprint/archive/rest/get:editor", "eprint/archive/rest/put:editor", "eprint/buffer/rest/get:editor", "eprint/buffer/rest/put:editor", "eprint/inbox/rest/get:editor", "eprint/inbox/rest/put:editor", "eprint/deletion/rest/get:editor", "eprint/deletion/rest/put:editor", "eprint/inbox/rest/get:owner", "eprint/inbox/rest/put:owner", "eprint/buffer/rest/get:owner", "eprint/archive/rest/get:owner", "eprint/deletion/rest/get:owner", "user/rest/get:owner", "subject/rest/get", ], }; ###################################################################### =pod =head2 Constructor Methods =cut ###################################################################### ###################################################################### =pod =over 4 =item $user = EPrints::DataObj::User->new( $session, $userid ) Load the user with the ID of $userid from the database and return it as an EPrints::DataObj::User object. =cut ###################################################################### sub new { my( $class, $session, $userid ) = @_; return $session->get_database->get_single( $session->dataset( "user" ), $userid ); } ###################################################################### =pod =item $user = EPrints::DataObj::User->new_from_data( $session, $data ) Construct a new EPrints::DataObj::User object based on the $data hash reference of metadata. Used to create an object from the data retrieved from the database. =cut ###################################################################### sub new_from_data { my( $class, $session, $known ) = @_; return $class->SUPER::new_from_data( $session, $known, $session->dataset( "user" ) ); } ###################################################################### =pod =item $user = EPrints::DataObj::User::create( $session, $user_type ) Create a new user in the database with the specified user type. =cut ###################################################################### sub create { my( $session, $user_type ) = @_; return EPrints::DataObj::User->create_from_data( $session, { usertype=>$user_type }, $session->dataset( "user" ) ); } ###################################################################### =pod =item $dataobj = EPrints::DataObj->create_from_data( $session, $data, $dataset ) Create a new object of this type in the database. $dataset is the dataset it will belong to. $data is the data structured as with new_from_data. =cut ###################################################################### sub create_from_data { my( $class, $session, $data, $dataset ) = @_; my $new_user = $class->SUPER::create_from_data( $session, $data, $dataset ); $new_user->update_triggers(); if( scalar( keys %{$new_user->{changed}} ) > 0 ) { # Remove empty slots in multiple fields $new_user->tidy; # Write the data to the database $session->get_database->update( $new_user->{dataset}, $new_user->{data}, $new_user->{changed} ); } $session->get_database->counter_minimum( "userid", $new_user->get_id ); return $new_user; } ###################################################################### =pod =back =head2 Class Methods =cut ###################################################################### ###################################################################### =pod =over 4 =item $fields = EPrints::DataObj::User->get_system_field_info Returns an array describing the system metadata of the the user dataset. =cut ###################################################################### sub get_system_field_info { my( $class ) = @_; return ( { name=>"userid", type=>"counter", required=>1, import=>0, can_clone=>1, sql_counter=>"userid" }, { name=>"rev_number", type=>"int", required=>1, can_clone=>0, default_value=>1 }, { name=>"saved_searches", type=>"subobject", datasetid=>'saved_search', multiple=>1 }, { name=>"username", type=>"idci", required=>1 }, { name=>"password", type=>"secret", show_in_html=>0, fromform=>\&EPrints::Utils::crypt_password }, { name=>"usertype", type=>"namedset", required=>1, set_name=>"user", input_style=>"medium", default_value=>"user" }, { name=>"newemail", type=>"email", show_in_html=>0 }, { name=>"newpassword", type=>"secret", show_in_html=>0, fromform=>\&EPrints::Utils::crypt_password }, { name=>"pin", type=>"text", show_in_html=>0 }, { name=>"pinsettime", type=>"int", show_in_html=>0 }, { name=>"loginattempts", type=>"int", "volatile" => 0, show_in_html=>0 }, { name=>"unlocktime", type=>"int", "volatile" => 0, show_in_html=>0 }, { name=>"joined", type=>"timestamp", required=>1 }, { name=>"email", type=>"email", required=>1 }, { name=>"lang", type=>"arclanguage", required=>0, input_rows=>1 }, { name => "editperms", multiple => 1, input_ordered => 0, input_add_boxes => 1, input_boxes => 1, type => "search", datasetid => "eprint", fieldnames_config => "editor_limit_fields", }, { name => "roles", multiple => 1, type => "id", text_index=>0 }, { name=>"frequency", type=>"set", input_style=>"medium", options=>["never","daily","weekly","monthly"], default_value=>"never" }, { name=>"mailempty", type=>"boolean", input_style=>"radio", default_value=>"FALSE" }, { name=>"items_fields", type=>"fields", datasetid=>"eprint", multiple=>1, input_ordered=>1, required=>1, volatile=>1 }, { name=>"latitude", type=>"float", required=>0 }, { name=>"longitude", type=>"float", required=>0 }, { name => "preference", type => "storable", sql_index => 0, text_index => 0, volatile => 1, }, { name => "captcha", type => "recaptcha", } ) }; ###################################################################### =pod =item $dataset = EPrints::DataObj::User->get_dataset_id Returns the ID of the L object to which this record belongs. =cut ###################################################################### sub get_dataset_id { return "user"; } ###################################################################### =pod =back =head2 Object Methods =cut ###################################################################### ###################################################################### =pod =over 4 =item $problems = $user->validate Validate the user - find out if all the required fields are filled out, and that what's been filled in is OK. Returns a reference to an array of problem descriptions. If there are no problems then the array is empty. The problems are XHTML DOM objects describing the problem. =cut ###################################################################### sub validate { my( $self, $for_archive, $workflow_id ) = @_; $workflow_id = "default" if !defined $workflow_id; my @problems; my $user_ds = $self->{session}->get_repository->get_dataset( "user" ); my %opts = ( item=> $self, session=>$self->{session} ); my $workflow = EPrints::Workflow->new( $self->{session}, $workflow_id, %opts ); push @problems, $workflow->validate; push @problems, @{ $self->SUPER::validate( $for_archive ) }; return( \@problems ); } ###################################################################### =pod =item $success = $user->commit( [ $force ] ) Writes this user data object to the database. If C<$force> is set and C then dave to the database even if no fields have changed. Otherwise, only save if at least one field has changed. Returns a boolean depending on whether the user data object was successfully committed. =cut ###################################################################### sub commit { my( $self, $force ) = @_; $self->update_triggers(); if( !defined $self->{changed} || scalar( keys %{$self->{changed}} ) == 0 ) { # don't do anything if there isn't anything to do return( 1 ) unless $force; } if( $self->{non_volatile_change} ) { $self->set_value( "rev_number", ($self->get_value( "rev_number" )||0) + 1 ); } if (exists $self->{changed}->{password}) { $self->close_non_current_login_tickets; } my $success = $self->SUPER::commit( $force ); return( $success ); } ###################################################################### =pod =item $user->close_non_current_login_tickets Close all login tickets for this user except the one they are currently logged in on. =cut ###################################################################### sub close_non_current_login_tickets { my ($self) = @_; my $repo = $self->repository; my $current_ticket = defined $repo->get_request ? $repo->current_loginticket : undef; my $ticket_ds = $repo->dataset('loginticket'); my $user_tickets = $ticket_ds->search( filters => [ {meta_fields => ['userid'], value => $self->id} ] ); $user_tickets->map( sub { my ($repo, $ds, $ticket, $current_ticket) = @_; if (!defined $current_ticket || $ticket->value('code') ne $current_ticket->value('code')) { $ticket->remove; } }, $current_ticket ); } ###################################################################### =pod =item $success = $user->remove Remove this user from the database. Also, remove their saved searches, but do not remove their eprints. =cut ###################################################################### sub remove { my( $self ) = @_; my $success = 1; foreach my $saved_search ( $self->get_saved_searches ) { $saved_search->remove; } # clean-up citation cache for this item $self->clear_citationcaches() if defined $self->{session}->config( "citation_caching", "enabled" ) && $self->{session}->config( "citation_caching", "enabled" ) && $self->{dataset}->confid ne "citationcache"; # remove user record my $user_ds = $self->{session}->get_repository->get_dataset( "user" ); $success = $success && $self->{session}->get_database->remove( $user_ds, $self->get_value( "userid" ) ); return( $success ); } ###################################################################### =pod =item $bool = $user->is_staff Returns true if the user L is C or C. =cut ###################################################################### sub is_staff { my( $self ) = @_; return $self->has_role( 'editor' ) || $self->has_role( 'admin' ); } ###################################################################### =pod =item $lang = $user->language Get the preferred language of this user. =cut ###################################################################### sub language { my( $self ) = @_; my $langid = $self->value( "lang" ); my $lang = $self->{session}->get_repository->get_language( $langid ); return $lang; } ###################################################################### =pod =item $list = $user->owned_eprints_list( %opts ) Returns a L of all the Ls owned by this user. C<%opts> is passed to a L, which is used to filter the results. If necessary, a config function can be defined. An example is provided below. The function must return an L. The default behaviour can be obtained by calling C<$user->owned_eprints_list_actual( %opts );> $c->{'get_users_owned_eprints'} = sub { my( $session, $user, %opts ) = @_; # for non-editorial accounts, return the normal list if( $user->get_type ne "editor" ) { return $user->owned_eprints_list_actual( %opts ); } # only interested in editor accounts now # allow editors to see their items, and items from a specific userid e.g. 99999 my $extra_userid = 99999; my $searchexp = $opts{dataset}->prepare_search( %opts ); $searchexp->add_field( $opts{dataset}->field( "userid" ), $user->id . " $extra_userid", "IN", "ANY" ); return $searchexp->perform_search; }; =cut ###################################################################### sub owned_eprints_list { my( $self, %opts ) = @_; $opts{dataset} = $self->{session}->dataset( "eprint" ) if !defined $opts{dataset}; my $fn = $self->{session}->config( "get_users_owned_eprints" ); if( !defined $fn ) { return $self->owned_eprints_list_actual( %opts ); } return &$fn( $self->{session}, $self, %opts ); } sub owned_eprints_list_actual { my( $self, %opts ) = @_; my $searchexp = $opts{dataset}->prepare_search( %opts ); $searchexp->add_field( $opts{dataset}->field( "userid" ), $self->id ); return $searchexp->perform_search; } ###################################################################### =pod =item $list = $user->editable_eprints_list( %opts ) Returns a L of Ls that match this user's editorial search expressions. If the user has no editorial scope a list of all eprints that match the given C<%opts> is returned. C<%opts> is passed to a L which is used to filter the results. $list = $user->editable_eprints_list( dataset => $repo->dataset( "buffer" ), ); =cut ###################################################################### sub editable_eprints_list { my( $self, %opts ) = @_; $opts{dataset} = $self->{session}->dataset( "eprint" ) if !defined $opts{dataset}; if( !$self->is_set( 'editperms' ) ) { return $opts{dataset}->search( custom_order => "-datestamp", %opts ); } my @conds; my $editperms = $self->{dataset}->get_field( "editperms" ); foreach my $sv ( @{$self->get_value( 'editperms' )} ) { push @conds, $editperms->make_searchexp( $self->{session}, $sv )->get_conditions; } my $cond = EPrints::Search::Condition->new( "OR", @conds ); # Condition::process() doesn't check dataset filters, so manually # add them here $opts{filters} = [] if !defined $opts{filters}; push @{$opts{filters}}, $opts{dataset}->get_filters; if( EPrints::Utils::is_set( $opts{filters} ) ) { my $searchexp = $opts{dataset}->prepare_search( %opts ); $cond = EPrints::Search::Condition->new( "AND", $searchexp->get_conditions, $cond ); } my $ids = $cond->process( session => $self->{session}, dataset => $opts{dataset} ); return EPrints::List->new( session => $self->{session}, dataset => $opts{dataset}, ids => $ids, order => "-datestamp" ); } ###################################################################### =pod =item $boolean = $user->has_owner( $possible_owner ) Returns C if C<$possible_owner> is the same as this user. =cut ###################################################################### sub has_owner { my( $self, $possible_owner ) = @_; if( $possible_owner->get_value( "userid" ) == $self->get_value( "userid" ) ) { return 1; } return 0; } ###################################################################### =pod =item $ok = $user->mail( $subjectid, $message, [$replyto, $email, $cc_list] ) Send an email to this user. C<$subjectid> is the ID of a phrase to use as the subject of this email. C<$message> is an XML DOM object describing the message in simple XHTML. C<$replyto> is the reply to address for this email, if different to the repository default. C<$email> is the email address to send this email to if different from this users configured email address. C<$cc_list> is an optional CC list (array reference) Returns C if the email was sent OK. =cut ###################################################################### sub mail { my( $self, $subjectid, $message, $replyto, $email, $cc_list ) = @_; #EPrints Services/sf2 2010-11-18 added optional cc_list (array ref) for GREENWICH-17 # User , string, DOM, User/undef Other Email # Mail the admin in the default language my $langid = $self->get_value( "lang" ); my $lang = $self->{session}->get_repository->get_language( $langid ); my $remail; my $rname; if( defined $replyto && ! $self->{session}->get_repository->config( 'reply_to_adminemail' ) ) { $remail = $replyto->get_value( "email" ); $rname = EPrints::Utils::tree_to_utf8( $replyto->render_description() ); } if( !defined $email ) { $email = $self->get_value( "email" ); } # Sometimes users do not have associated email addresses. bin scripts don't need to be told this. use English qw<$PROGRAM_NAME>; return 0 if !EPrints::Utils::is_set( $email ) && $PROGRAM_NAME =~ m/\/bin\//; return EPrints::Email::send_mail( session => $self->{session}, langid => $langid, to_name => EPrints::Utils::tree_to_utf8( $self->render_description ), to_email => $email, subject => EPrints::Utils::tree_to_utf8( $lang->phrase( $subjectid, {}, $self->{session} ) ), message => $message, sig => $lang->phrase( "mail_sig", {}, $self->{session} ), replyto_name => $rname, replyto_email => $remail, cc_list => $cc_list, ); } ###################################################################### =pod =item ( $page, $title ) = $user->render Returns XHTML DOM renderings of the page and the title for this user's page. This uses the configurable C<$user_render> method that can typically be found in C. =cut ###################################################################### sub render { my( $self ) = @_; my( $dom, $title ) = $self->{session}->get_repository->call( "user_render", $self, $self->{session} ); if( !defined $title ) { $title = $self->render_description; } return( $dom, $title ); } ###################################################################### =pod =item ( $page, $title ) = $user->render_full The same as L, but returns page and title renderings for all fields, not just those intended for public viewing. This is the admin view of the user. =cut ###################################################################### sub render_full { my( $self ) = @_; my( $table, $title ) = $self->SUPER::render_full; my $ds = $self->{session}->get_repository->get_dataset( "saved_search" ); foreach my $saved_search ( $self->get_saved_searches ) { my $rowright = $self->{session}->make_doc_fragment; foreach( "frequency","spec","mailempty" ) { my $strong; $strong = $self->{session}->make_element( "strong" ); $strong->appendChild( $ds->get_field( $_ )->render_name( $self->{session} ) ); $strong->appendChild( $self->{session}->make_text( ": " ) ); $rowright->appendChild( $strong ); $rowright->appendChild( $saved_search->render_value( $_ ) ); $rowright->appendChild( $self->{session}->make_element( "br" ) ); } $table->appendChild( $self->{session}->render_row( $self->{session}->html_phrase( "page:saved_search" ), $rowright ) ); } return( $table, $title ); } ###################################################################### =pod =item $url = $user->get_url Returns the URL which will display information about this user. =cut ###################################################################### sub get_url { my( $self ) = @_; return $self->get_control_url; } ###################################################################### =pod =item $url = $dataobj->get_control_url Returns the URL for the control page for this user. =cut ###################################################################### sub get_control_url { my( $self ) = @_; return $self->{session}->get_repository->get_conf( "perl_url" )."/users/home?screen=User::View&userid=".$self->get_value( "userid" ); } ###################################################################### =pod =item $type = $user->get_type Return the type of this user. Alias for: $user->get_value( "usertype" ) =cut ###################################################################### sub get_type { my( $self ) = @_; return $self->get_value( "usertype" ); } ###################################################################### =pod =item @saved_searches = $eprint->get_saved_searches Returns an array of all L objects associated with this user. =cut ###################################################################### sub get_saved_searches { my( $self ) = @_; my $dataset = $self->{session}->dataset( "saved_search" ); my $results = $dataset->search( filters => [ { meta_fields => [qw( userid )], value => $self->value( "userid" ), } ], custom_order => $dataset->key_field->name ); return $results->slice; } ###################################################################### =pod =item $value = $user->preference( $key ) Returns the preference value for C<$key>. Otherwise, returns C. =cut ###################################################################### sub preference { my( $self, $key ) = @_; my $prefs = $self->value( "preference" ); return undef if !defined $prefs; return $prefs->{$key}; } ###################################################################### =pod =item $user->set_preference( $key, $value ) Set a preference C<$key> to C<$value> for this user. =cut ###################################################################### sub set_preference { my( $self, $key, $value ) = @_; my $prefs = $self->value( "preference" ); $prefs = defined $prefs ? { %$prefs } : {}; if( EPrints::Utils::is_set( $value ) ) { $prefs->{$key} = $value; } else { delete $prefs->{$key}; } $self->set_value( "preference", $prefs ); } ###################################################################### =pod =item $user->send_out_editor_alert Called on users who are editors, when it's time to send their update on what items are in the editorial review buffer. Typically called by L. Only sends the email if needed. =cut ###################################################################### sub send_out_editor_alert { my( $self ) = @_; my $freq = $self->get_value( "frequency" ); if( $freq eq "never" ) { $self->{session}->get_repository->log( "Attempt to send out an editor alert for a user\n". "which has frequency 'never'\n" ); return; } unless( $self->has_role( "editor" ) ) { $self->{session}->get_repository->log( "Attempt to send out an editor alert for a user\n". "which does not have editor role (". $self->get_value("username").")\n" ); return; } my $origlangid = $self->{session}->get_langid; $self->{session}->change_lang( $self->get_value( "lang" ) ); # we're only interested in items under review (buffer) my $list = $self->editable_eprints_list( dataset => $self->{session}->dataset( "buffer" ), ); if( $list->count > 0 || $self->get_value( "mailempty" ) eq 'TRUE' ) { my $url = URI->new($self->{session}->get_repository->get_conf( "perl_url" )."/users/home"); $url->query_form( screen => "User::Edit", userid => $self->get_id ); my $freqphrase = $self->{session}->html_phrase( "lib/saved_search:".$freq ); # nb. reusing the SavedSearch.pm phrase my $searchdesc = $self->render_value( "editperms" ); my $matches = $self->{session}->make_doc_fragment; $list->map( sub { my( $session, $dataset, $eprint ) = @_; my $p = $self->{session}->make_element( "p" ); $p->appendChild( $eprint->render_citation_link_staff ); $matches->appendChild( $p ); } ); my $mail = $self->{session}->html_phrase( "lib/user:editor_update_mail", howoften => $freqphrase, n => $self->{session}->make_text( $list->count ), search => $searchdesc, matches => $matches, url => $self->{session}->render_link( $url ) ); $self->mail( "lib/user:editor_update_subject", $mail ); EPrints::XML::dispose( $mail ); } $self->{session}->change_lang( $origlangid ); } ###################################################################### =pod =item $result = $user->allow( $priv, [ $item ] ) Returns C if user can perform an action specified by C<$priv>. If set, further checks whether the user is permitted to perform the action of C<$priv> on a particular C<$item> data object. =cut ###################################################################### sub allow { my( $self, $priv, $item ) = @_; my $r = 0; $r |= 1 if $self->{session}->allow_anybody( $priv ); $r |= 2 if $self->has_privilege( $priv ); $r |= $item->permit( $priv, $self ) if defined $item; return $r; } ###################################################################### =pod =item $boolean = $user->has_privilege( $priv ) Returns C if C<$priv> is in the user's privileges list. =cut ###################################################################### sub has_privilege { my( $self, $priv ) = @_; return $self->get_privs->{$priv}; } ###################################################################### =pod =item $privs = $user->get_privs Returns the privileges this user has. Currently just based on roles, but could do more later. Returns a reference to a hash. Caching the result to save time in future. =cut ###################################################################### sub get_privs { my( $self ) = @_; return $self->{".privs"} if( defined $self->{".privs"} ) ; my $rep = $self->{session}->get_repository; my $role_config = $rep->get_conf( "user_roles", $self->get_value( "usertype" ) ); my $extra_roles = $self->get_value( "roles" ) || []; my %privmap = %{$PRIVMAP}; # extra hats defined in this repository my %override_roles = %{$rep->get_conf( "roles" )||{}}; foreach my $role_id ( keys %override_roles ) { $privmap{$role_id} = $override_roles{$role_id}; } $self->{".privs"} = {}; foreach my $role ( @{$role_config}, @{$extra_roles} ) { if( $role =~ m/^\+(.*)$/ ) { $self->{".privs"}->{$1} = 1; next; } if( $role =~ m/^-(.*)$/ ) { delete $self->{".privs"}->{$1}; next; } foreach my $priv ( @{$privmap{$role}} ) { if( $priv =~ m/^\+(.*)$/ ) { $self->{".privs"}->{$1} = 1; next; } if( $priv =~ m/^-(.*)$/ ) { delete $self->{".privs"}->{$1}; next; } $self->{".privs"}->{$priv} = 1; } } return $self->{".privs"}; } ###################################################################### =pod =item @roles = $user->get_roles; Returns the roles this user has. Each role represents a whole bunch of privileges. =cut ###################################################################### sub get_roles { my( $self ) = @_; my $rep = $self->{session}->get_repository; my $role_config = $rep->get_conf( "user_roles", $self->get_value( "usertype" ) ); my $extra_roles = $self->get_value( "roles" ) || []; my @roles = (); foreach my $role ( @{$role_config}, @{$extra_roles} ) { next if( $role =~ m/^[+-]/ ); push @roles, $role; } return @roles; } ###################################################################### =pod =item $user->has_role( $roleid ) Returns boolean dependent on whether this user has the role C<$roleid>. =cut ###################################################################### sub has_role { my( $self, $roleid ) = @_; foreach my $hasid ( $self->get_roles ) { return 1 if $hasid eq $roleid; } return 0; } ###################################################################### =pod =back =head2 Utility Methods =cut ###################################################################### ###################################################################### =pod =over 4 =item $user = EPrints::DataObj::User::user_with_email( $repo, $email ) Returns the use with the specified C<$email>, or C if they cannot benot found. =cut ###################################################################### sub user_with_email { my( $repo, $email ) = @_; my $dataset = $repo->dataset( "user" ); $email = $repo->get_database->ci_lookup( $dataset->field( "email" ), $email ); my $results = $dataset->search( filters => [ { meta_fields => [qw( email )], value => $email, match => "EX" } ]); return $results->item( 0 ); } ###################################################################### =pod =item $user = EPrints::DataObj::User::user_with_username( $session, $username ) Returns the user with the specified C<$username>, or C if they cannot be not found. =cut ###################################################################### sub user_with_username { my( $repo, $username ) = @_; my $dataset = $repo->dataset( "user" ); $username = $repo->get_database->ci_lookup( $dataset->field( "username" ), $username ); my $results = $dataset->search( filters => [ { meta_fields => [qw( username )], value => $username, match => "EX" } ]); return $results->item( 0 ); } ###################################################################### =pod =item EPrints::DataObj::User::process_editor_alerts( $session, $frequency ); Called to send out all editor alerts of a given frequency (daily, weekly, monthly) for the current repository by the C script that is configured as daily, weekly and monthly cron jobs. =cut ###################################################################### sub process_editor_alerts { my( $session, $frequency ) = @_; if( $frequency ne "daily" && $frequency ne "weekly" && $frequency ne "monthly" ) { $session->get_repository->log( "EPrints::DataObj::User::process_editor_alerts called with unknown frequency: ".$frequency ); return; } my $subs_ds = $session->dataset( "user" ); my $searchexp = EPrints::Search->new( session => $session, dataset => $subs_ds ); $searchexp->add_field( $subs_ds->get_field( "frequency" ), $frequency ); my $fn = sub { my( $session, $dataset, $item, $info ) = @_; return unless( $item->has_role( "editor" ) ); $item->send_out_editor_alert; if( $session->get_noise >= 2 ) { print "Sending out editor alert for ".$item->get_value( "username" )."\n"; } }; my $list = $searchexp->perform_search; $list->map( $fn, {} ); # currently no timestamp for editor alerts } 1; ###################################################################### =pod =back =head1 SEE ALSO L and L. =head1 COPYRIGHT =begin COPYRIGHT Copyright 2024 University of Southampton. EPrints 3.4 is supplied by EPrints Services. http://www.eprints.org/eprints-3.4/ =end COPYRIGHT =begin LICENSE This file is part of EPrints 3.4 L. EPrints 3.4 and this file are released under the terms of the GNU Lesser General Public License version 3 as published by the Free Software Foundation unless otherwise stated. EPrints 3.4 is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with EPrints 3.4. If not, see L. =end LICENSE