1 package FS::access_user;
2 use base qw( FS::Password_Mixin
7 use vars qw( $DEBUG $me );
11 use FS::Record qw( qsearch qsearchs dbh );
18 $me = '[FS::access_user]';
22 FS::access_user - Object methods for access_user records
28 $record = new FS::access_user \%hash;
29 $record = new FS::access_user { 'column' => 'value' };
31 $error = $record->insert;
33 $error = $new_record->replace($old_record);
35 $error = $record->delete;
37 $error = $record->check;
41 An FS::access_user object represents an internal access user. FS::access_user
42 inherits from FS::Record. The following fields are currently supported:
54 =item _password_encoding
68 Master customer for this employee (for commissions)
72 Default sales person for this employee (for reports)
86 Creates a new internal access user. To add the user to the database, see L<"insert">.
88 Note that this stores the hash reference, not a distinct copy of the hash it
89 points to. You can ask the object for a copy with the I<hash> method.
93 # the new method can be inherited from FS::Record, if a table method is defined
95 sub table { 'access_user'; }
97 sub _option_table { 'access_user_pref'; }
98 sub _option_namecol { 'prefname'; }
99 sub _option_valuecol { 'prefvalue'; }
103 Adds this record to the database. If there is an error, returns the error,
104 otherwise returns false.
111 my $error = $self->check;
112 return $error if $error;
114 local $SIG{HUP} = 'IGNORE';
115 local $SIG{INT} = 'IGNORE';
116 local $SIG{QUIT} = 'IGNORE';
117 local $SIG{TERM} = 'IGNORE';
118 local $SIG{TSTP} = 'IGNORE';
119 local $SIG{PIPE} = 'IGNORE';
121 my $oldAutoCommit = $FS::UID::AutoCommit;
122 local $FS::UID::AutoCommit = 0;
126 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
130 $error = $self->SUPER::insert(@_);
131 if ( $self->_password ) {
132 $error ||= $self->insert_password_history;
136 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
139 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
147 Delete this record from the database.
154 local $SIG{HUP} = 'IGNORE';
155 local $SIG{INT} = 'IGNORE';
156 local $SIG{QUIT} = 'IGNORE';
157 local $SIG{TERM} = 'IGNORE';
158 local $SIG{TSTP} = 'IGNORE';
159 local $SIG{PIPE} = 'IGNORE';
161 my $oldAutoCommit = $FS::UID::AutoCommit;
162 local $FS::UID::AutoCommit = 0;
165 my $error = $self->delete_password_history
166 || $self->SUPER::delete(@_);
169 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
172 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
178 =item replace OLD_RECORD
180 Replaces the OLD_RECORD with this one in the database. If there is an error,
181 returns the error, otherwise returns false.
188 my $old = ( ref($_[0]) eq ref($new) )
192 local $SIG{HUP} = 'IGNORE';
193 local $SIG{INT} = 'IGNORE';
194 local $SIG{QUIT} = 'IGNORE';
195 local $SIG{TERM} = 'IGNORE';
196 local $SIG{TSTP} = 'IGNORE';
197 local $SIG{PIPE} = 'IGNORE';
199 my $oldAutoCommit = $FS::UID::AutoCommit;
200 local $FS::UID::AutoCommit = 0;
203 return "Must change password when enabling this account"
204 if $old->disabled && !$new->disabled
205 && ( $new->_password =~ /changeme/i
206 || $new->_password eq 'notyet'
209 my $error = $new->SUPER::replace($old, @_);
210 if ( $old->_password ne $new->_password ) {
211 $error ||= $new->insert_password_history;
215 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
218 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
226 Checks all fields to make sure this is a valid internal access user. If there is
227 an error, returns the error, otherwise returns false. Called by the insert
232 # the check method should currently be supplied - FS::Record contains some
233 # data checking routines
239 $self->ut_numbern('usernum')
240 || $self->ut_alpha_lower('username')
241 || $self->ut_textn('_password')
242 || $self->ut_textn('last')
243 || $self->ut_textn('first')
244 || $self->ut_foreign_keyn('user_custnum', 'cust_main', 'custnum')
245 || $self->ut_foreign_keyn('report_salesnum', 'sales', 'salesnum')
246 || $self->ut_enum('disabled', [ '', 'Y' ] )
248 return $error if $error;
255 Returns a name string for this user: "Last, First".
261 return $self->username
262 if $self->get('last') eq 'Lastname' && $self->first eq 'Firstname'
263 or $self->get('last') eq '' && $self->first eq '';
264 return $self->get('last'). ', '. $self->first;
269 Returns the FS::cust_main object (see L<FS::cust_main>), if any, for this
276 qsearchs( 'cust_main', { 'custnum' => $self->user_custnum } );
281 Returns the FS::sales object (see L<FS::sales>), if any, for this
288 qsearchs( 'sales', { 'salesnum' => $self->report_salesnum } );
291 =item access_usergroup
293 Returns links to the the groups this user is a part of, as FS::access_usergroup
294 objects (see L<FS::access_usergroup>).
298 Returns the number of agents this user can view (via group membership).
305 'SELECT COUNT(DISTINCT agentnum) FROM access_usergroup
306 JOIN access_groupagent USING ( groupnum )
314 Returns a list of agentnums this user can view (via group membership).
320 my $sth = dbh->prepare(
321 "SELECT DISTINCT agentnum FROM access_usergroup
322 JOIN access_groupagent USING ( groupnum )
324 ) or die dbh->errstr;
325 $sth->execute($self->usernum) or die $sth->errstr;
326 map { $_->[0] } @{ $sth->fetchall_arrayref };
331 Returns a hashref of agentnums this user can view.
337 scalar( { map { $_ => 1 } $self->agentnums } );
340 =item agentnums_sql [ HASHREF | OPTION => VALUE ... ]
342 Returns an sql fragement to select only agentnums this user can view.
344 Options are passed as a hashref or a list. Available options are:
350 The frament will also allow the selection of null agentnums.
354 The fragment will also allow the selection of null agentnums if the current
355 user has the provided access right
359 Optional table name in which agentnum is being checked. Sometimes required to
360 resolve 'column reference "agentnum" is ambiguous' errors.
364 All agents will be viewable if the current user has the provided access right.
365 Defaults to 'View customers of all agents'.
373 my %opt = ref($_[0]) ? %{$_[0]} : @_;
375 my $agentnum = $opt{'table'} ? $opt{'table'}.'.agentnum' : 'agentnum';
379 my $viewall_right = $opt{'viewall_right'} || 'View customers of all agents';
380 if ( $self->access_right($viewall_right) ) {
381 push @or, "$agentnum IS NOT NULL";
383 my @agentnums = $self->agentnums;
384 push @or, "$agentnum IN (". join(',', @agentnums). ')'
388 push @or, "$agentnum IS NULL"
390 || ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) );
392 return ' 1 = 0 ' unless scalar(@or);
393 '( '. join( ' OR ', @or ). ' )';
399 Returns true if the user can view the specified agent.
401 Also accepts optional hashref cache, to avoid redundant database calls.
406 my( $self, $agentnum, $cache ) = @_;
408 return $cache->{$self->usernum}->{$agentnum}
409 if $cache->{$self->usernum}->{$agentnum};
410 my $sth = dbh->prepare(
411 "SELECT COUNT(*) FROM access_usergroup
412 JOIN access_groupagent USING ( groupnum )
413 WHERE usernum = ? AND agentnum = ?"
414 ) or die dbh->errstr;
415 $sth->execute($self->usernum, $agentnum) or die $sth->errstr;
416 $cache->{$self->usernum}->{$agentnum} = $sth->fetchrow_arrayref->[0];
418 return $cache->{$self->usernum}->{$agentnum};
421 =item agents [ HASHREF | OPTION => VALUE ... ]
423 Returns the list of agents this user can view (via group membership), as
424 FS::agent objects. Accepts the same options as the agentnums_sql method.
432 'hashref' => { disabled=>'' },
433 'extra_sql' => ' AND '. $self->agentnums_sql(@_),
434 'order_by' => 'ORDER BY agent',
438 =item access_users [ HASHREF | OPTION => VALUE ... ]
440 Returns an array of FS::access_user objects, one for each non-disabled
441 access_user in the system that shares an agent (via group membership) with
442 the invoking object. Regardless of options and agents, will always at
443 least return the invoking user and any users who have viewall_right.
445 Accepts the following options:
451 Only return users who appear in the usernum field of this table
455 Include disabled users if true (defaults to false)
459 All users will be returned if the current user has the provided
460 access right, regardless of agents (other filters still apply.)
461 Defaults to 'View customers of all agents'
465 #Leaving undocumented until such time as this functionality is actually used
469 #Users with no agents will be returned.
473 #Users with no agents will be returned if the current user has the provided
478 my %opt = ref($_[0]) ? %{$_[0]} : @_;
479 my $table = $opt{'table'};
480 my $search = { 'table' => 'access_user' };
481 $search->{'hashref'} = $opt{'disabled'} ? {} : { 'disabled' => '' };
482 $search->{'addl_from'} = "INNER JOIN $table ON (access_user.usernum = $table.usernum)"
484 my @access_users = qsearch($search);
485 my $viewall_right = $opt{'viewall_right'} || 'View customers of all agents';
486 return @access_users if $self->access_right($viewall_right);
487 #filter for users with agents $self can view
489 my $agentnum_cache = {};
491 foreach my $access_user (@access_users) {
492 # you can always view yourself, regardless of agents,
493 # and you can always view someone who can view you,
494 # since they might have affected your customers
495 if ( ($self->usernum eq $access_user->usernum)
496 || $access_user->access_right($viewall_right)
498 push(@out,$access_user);
501 # if user has no agents, you need null or null_right to view
502 my @agents = $access_user->agents('viewall_right'=>'NONE'); #handled viewall_right above
505 ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) )
507 push(@out,$access_user);
511 # otherwise, you need an agent in common
512 foreach my $agent (@agents) {
513 if ($self->agentnum($agent->agentnum,$agentnum_cache)) {
514 push(@out,$access_user);
522 =item access_users_hashref [ HASHREF | OPTION => VALUE ... ]
524 Accepts same options as L</access_users>. Returns a hashref of
525 users, with keys of usernum and values of username.
529 sub access_users_hashref {
531 my %access_users = map { $_->usernum => $_->username }
532 $self->access_users(@_);
533 return \%access_users;
536 =item access_right RIGHTNAME | LISTREF
538 Given a right name or a list reference of right names, returns true if this
539 user has this right, or, for a list, one of the rights (currently via group
540 membership, eventually also via user overrides).
545 my( $self, $rightname ) = @_;
547 $rightname = [ $rightname ] unless ref($rightname);
549 warn "$me access_right called on ". join(', ', @$rightname). "\n"
552 #some caching of ACL requests for low-hanging fruit perf improvement
553 #since we get a new $CurrentUser object each page view there shouldn't be any
554 #issues with stickiness
555 if ( $self->{_ACLcache} ) {
557 unless ( grep !exists($self->{_ACLcache}{$_}), @$rightname ) {
558 warn "$me ACL cache hit for ". join(', ', @$rightname). "\n"
560 return scalar( grep $self->{_ACLcache}{$_}, @$rightname );
563 warn "$me ACL cache miss for ". join(', ', @$rightname). "\n"
568 warn "initializing ACL cache\n"
570 $self->{_ACLcache} = {};
574 my $has_right = ' rightname IN ('. join(',', map '?', @$rightname ). ') ';
576 my $sth = dbh->prepare("
577 SELECT groupnum FROM access_usergroup
578 LEFT JOIN access_group USING ( groupnum )
579 LEFT JOIN access_right
580 ON ( access_group.groupnum = access_right.rightobjnum )
582 AND righttype = 'FS::access_group'
585 ") or die dbh->errstr;
586 $sth->execute($self->usernum, @$rightname) or die $sth->errstr;
587 my $row = $sth->fetchrow_arrayref;
589 my $return = $row ? $row->[0] : '';
591 #just caching the single-rightname hits should be enough of a win for now
592 if ( scalar(@$rightname) == 1 ) {
593 $self->{_ACLcache}{${$rightname}[0]} = $return;
600 =item refund_rights PAYBY
602 Accepts payment $payby (BILL,CASH,MCRD,MCHK,CARD,CHEK) and returns a
603 list of the refund rights associated with that $payby.
605 Returns empty list if $payby wasn't recognized.
613 push @rights, 'Post refund' if $payby =~ /^(BILL|CASH|MCRD|MCHK)$/;
614 push @rights, 'Post check refund' if $payby eq 'BILL';
615 push @rights, 'Post cash refund ' if $payby eq 'CASH';
616 push @rights, 'Refund payment' if $payby =~ /^(CARD|CHEK)$/;
617 push @rights, 'Refund credit card payment' if $payby eq 'CARD';
618 push @rights, 'Refund Echeck payment' if $payby eq 'CHEK';
622 =item refund_access_right PAYBY
624 Returns true if user has L</access_right> for any L</refund_rights>
625 for the specified payby.
629 sub refund_access_right {
632 my @rights = $self->refund_rights($payby);
633 return '' unless @rights;
634 return $self->access_right(\@rights);
637 =item default_customer_view
639 Returns the default customer view for this user, from the
640 "default_customer_view" user preference, the "cust_main-default_view" config,
641 or the hardcoded default, "basics" (formerly "jumbo" prior to 3.0).
645 sub default_customer_view {
648 $self->option('default_customer_view')
649 || FS::Conf->new->config('cust_main-default_view')
650 || 'basics'; #s/jumbo/basics/ starting with 3.0
654 =item spreadsheet_format [ OVERRIDE ]
656 Returns a hashref of this user's Excel spreadsheet download settings:
657 'extension' (xls or xlsx), 'class' (Spreadsheet::WriteExcel or
658 Excel::Writer::XLSX), and 'mime_type'. If OVERRIDE is 'XLS' or 'XLSX',
659 use that instead of the user's setting.
663 # is there a better place to put this?
667 class => 'Spreadsheet::WriteExcel',
668 mime_type => 'application/vnd.ms-excel',
671 extension => '.xlsx',
672 class => 'Excel::Writer::XLSX',
673 mime_type => # it's on wikipedia, it must be true
674 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet',
678 sub spreadsheet_format {
680 my $override = shift;
683 || $self->option('spreadsheet_format')
684 || FS::Conf->new->config('spreadsheet_format')
692 Returns true if this user has the name of a known system account. These
693 users cannot log into the web interface and can't have passwords set.
699 return grep { $_ eq $self->username } ( qw(
710 =item change_password NEW_PASSWORD
712 Changes the user's password to NEW_PASSWORD. This does not check password
713 policy rules (see C<is_password_allowed>) and will return an error only if
714 editing the user's record fails for some reason.
716 If NEW_PASSWORD is the same as the existing password, this does nothing.
720 sub change_password {
721 #my( $self, $password ) = @_;
722 #FS::Auth->auth_class->change_password( $self, $password );
723 FS::Auth->auth_class->change_password( @_ );
726 =item change_password_fields NEW_PASSWORD
730 sub change_password_fields {
731 #my( $self, $password ) = @_;
732 #FS::Auth->auth_class->change_password_fields( $self, $password );
733 FS::Auth->auth_class->change_password_fields( @_ );
742 return $self->{_locale} if exists($self->{_locale});
743 $self->{_locale} = $self->option('locale');
746 =item get_page_pref PATH, NAME, TABLENUM
748 Returns the user's page preference named NAME for the page at PATH. If the
749 page is a view or edit page or otherwise shows a single record at a time,
750 it should use TABLENUM to tell which record the preference is for.
756 my ($path, $prefname, $tablenum) = @_;
759 my $access_user_page_pref = qsearchs('access_user_page_pref', {
761 usernum => $self->usernum,
762 tablenum => $tablenum,
763 prefname => $prefname,
765 $access_user_page_pref ? $access_user_page_pref->prefvalue : '';
768 =item set_page_pref PATH, NAME, TABLENUM, VALUE
770 Sets the user's page preference named NAME for the page at PATH. Use TABLENUM
771 as for get_page_pref.
777 my ($path, $prefname, $tablenum, $prefvalue) = @_;
781 my $access_user_page_pref = qsearchs('access_user_page_pref', {
783 usernum => $self->usernum,
784 tablenum => $tablenum,
785 prefname => $prefname,
787 if ( $access_user_page_pref ) {
788 if ( $prefvalue eq $access_user_page_pref->get('prefvalue') ) {
791 if ( length($prefvalue) > 0 ) {
792 $access_user_page_pref->set('prefvalue', $prefvalue);
793 $error = $access_user_page_pref->replace;
794 $error .= " (updating $prefname)" if $error;
796 $error = $access_user_page_pref->delete;
797 $error .= " (removing $prefname)" if $error;
800 if ( length($prefvalue) > 0 ) {
801 $access_user_page_pref = FS::access_user_page_pref->new({
803 usernum => $self->usernum,
804 tablenum => $tablenum,
805 prefname => $prefname,
806 prefvalue => $prefvalue,
808 $error = $access_user_page_pref->insert;
809 $error .= " (creating $prefname)" if $error;
820 Fetch the prefvalue column from L<FS::access_user_pref> for prefname NAME
822 Returns undef when no value has been saved, or when record has expired
827 my ( $self, $prefname ) = @_;
828 croak 'prefname parameter requrired' unless $prefname;
830 my $pref_row = $self->get_pref_row( $prefname )
834 if $pref_row->expiration
835 && $pref_row->expiration < time();
837 $pref_row->prefvalue;
840 =item get_pref_row NAME
842 Fetch the row object from L<FS::access_user_pref> for prefname NAME
844 returns undef when no row has been created
849 my ( $self, $prefname ) = @_;
850 croak 'prefname parameter required' unless $prefname;
853 access_user_pref => {
854 usernum => $self->usernum,
855 prefname => $prefname,
860 =item set_pref NAME, VALUE, [EXPIRATION_EPOCH]
862 Add or update user preference in L<FS::access_user_pref> table
864 Passing an undefined VALUE will delete the user preference
872 my ( $prefname, $prefvalue, $expiration ) = @_;
874 return $self->delete_pref( $prefname )
875 unless defined $prefvalue;
877 if ( my $pref_row = $self->get_pref_row( $prefname )) {
879 if $pref_row->prefvalue eq $prefvalue;
881 $pref_row->prefvalue( $prefvalue );
882 $pref_row->expiration( $expiration || '');
884 if ( my $error = $pref_row->replace ) { croak $error }
889 my $pref_row = FS::access_user_pref->new({
890 usernum => $self->usernum,
891 prefname => $prefname,
892 prefvalue => $prefvalue,
893 expiration => $expiration,
895 if ( my $error = $pref_row->insert ) { croak $error }
900 =item delete_pref NAME
902 Delete user preference from L<FS::access_user_pref> table
907 my ( $self, $prefname ) = @_;
909 my $pref_row = $self->get_pref_row( $prefname )
912 if ( my $error = $pref_row->delete ) { croak $error }
921 L<FS::Record>, schema.html from the base documentation.