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 );
17 $me = '[FS::access_user]';
21 FS::access_user - Object methods for access_user records
27 $record = new FS::access_user \%hash;
28 $record = new FS::access_user { 'column' => 'value' };
30 $error = $record->insert;
32 $error = $new_record->replace($old_record);
34 $error = $record->delete;
36 $error = $record->check;
40 An FS::access_user object represents an internal access user. FS::access_user
41 inherits from FS::Record. The following fields are currently supported:
53 =item _password_encoding
67 Master customer for this employee (for commissions)
71 Default sales person for this employee (for reports)
85 Creates a new internal access user. To add the user to the database, see L<"insert">.
87 Note that this stores the hash reference, not a distinct copy of the hash it
88 points to. You can ask the object for a copy with the I<hash> method.
92 # the new method can be inherited from FS::Record, if a table method is defined
94 sub table { 'access_user'; }
96 sub _option_table { 'access_user_pref'; }
97 sub _option_namecol { 'prefname'; }
98 sub _option_valuecol { 'prefvalue'; }
102 Adds this record to the database. If there is an error, returns the error,
103 otherwise returns false.
110 my $error = $self->check;
111 return $error if $error;
113 local $SIG{HUP} = 'IGNORE';
114 local $SIG{INT} = 'IGNORE';
115 local $SIG{QUIT} = 'IGNORE';
116 local $SIG{TERM} = 'IGNORE';
117 local $SIG{TSTP} = 'IGNORE';
118 local $SIG{PIPE} = 'IGNORE';
120 my $oldAutoCommit = $FS::UID::AutoCommit;
121 local $FS::UID::AutoCommit = 0;
125 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
129 $error = $self->SUPER::insert(@_);
130 if ( $self->_password ) {
131 $error ||= $self->insert_password_history;
135 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
138 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
146 Delete this record from the database.
153 local $SIG{HUP} = 'IGNORE';
154 local $SIG{INT} = 'IGNORE';
155 local $SIG{QUIT} = 'IGNORE';
156 local $SIG{TERM} = 'IGNORE';
157 local $SIG{TSTP} = 'IGNORE';
158 local $SIG{PIPE} = 'IGNORE';
160 my $oldAutoCommit = $FS::UID::AutoCommit;
161 local $FS::UID::AutoCommit = 0;
164 my $error = $self->delete_password_history
165 || $self->SUPER::delete(@_);
168 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
171 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
177 =item replace OLD_RECORD
179 Replaces the OLD_RECORD with this one in the database. If there is an error,
180 returns the error, otherwise returns false.
187 my $old = ( ref($_[0]) eq ref($new) )
191 local $SIG{HUP} = 'IGNORE';
192 local $SIG{INT} = 'IGNORE';
193 local $SIG{QUIT} = 'IGNORE';
194 local $SIG{TERM} = 'IGNORE';
195 local $SIG{TSTP} = 'IGNORE';
196 local $SIG{PIPE} = 'IGNORE';
198 my $oldAutoCommit = $FS::UID::AutoCommit;
199 local $FS::UID::AutoCommit = 0;
202 return "Must change password when enabling this account"
203 if $old->disabled && !$new->disabled
204 && ( $new->_password =~ /changeme/i
205 || $new->_password eq 'notyet'
208 my $error = $new->SUPER::replace($old, @_);
209 if ( $old->_password ne $new->_password ) {
210 $error ||= $new->insert_password_history;
214 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
217 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
225 Checks all fields to make sure this is a valid internal access user. If there is
226 an error, returns the error, otherwise returns false. Called by the insert
231 # the check method should currently be supplied - FS::Record contains some
232 # data checking routines
238 $self->ut_numbern('usernum')
239 || $self->ut_alpha_lower('username')
240 || $self->ut_textn('_password')
241 || $self->ut_textn('last')
242 || $self->ut_textn('first')
243 || $self->ut_foreign_keyn('user_custnum', 'cust_main', 'custnum')
244 || $self->ut_foreign_keyn('report_salesnum', 'sales', 'salesnum')
245 || $self->ut_enum('disabled', [ '', 'Y' ] )
247 return $error if $error;
254 Returns a name string for this user: "Last, First".
260 return $self->username
261 if $self->get('last') eq 'Lastname' && $self->first eq 'Firstname'
262 or $self->get('last') eq '' && $self->first eq '';
263 return $self->get('last'). ', '. $self->first;
268 Returns the FS::cust_main object (see L<FS::cust_main>), if any, for this
275 qsearchs( 'cust_main', { 'custnum' => $self->user_custnum } );
280 Returns the FS::sales object (see L<FS::sales>), if any, for this
287 qsearchs( 'sales', { 'salesnum' => $self->report_salesnum } );
290 =item access_usergroup
292 Returns links to the the groups this user is a part of, as FS::access_usergroup
293 objects (see L<FS::access_usergroup>).
297 Returns the number of agents this user can view (via group membership).
304 'SELECT COUNT(DISTINCT agentnum) FROM access_usergroup
305 JOIN access_groupagent USING ( groupnum )
313 Returns a list of agentnums this user can view (via group membership).
319 my $sth = dbh->prepare(
320 "SELECT DISTINCT agentnum FROM access_usergroup
321 JOIN access_groupagent USING ( groupnum )
323 ) or die dbh->errstr;
324 $sth->execute($self->usernum) or die $sth->errstr;
325 map { $_->[0] } @{ $sth->fetchall_arrayref };
330 Returns a hashref of agentnums this user can view.
336 scalar( { map { $_ => 1 } $self->agentnums } );
339 =item agentnums_sql [ HASHREF | OPTION => VALUE ... ]
341 Returns an sql fragement to select only agentnums this user can view.
343 Options are passed as a hashref or a list. Available options are:
349 The frament will also allow the selection of null agentnums.
353 The fragment will also allow the selection of null agentnums if the current
354 user has the provided access right
358 Optional table name in which agentnum is being checked. Sometimes required to
359 resolve 'column reference "agentnum" is ambiguous' errors.
363 All agents will be viewable if the current user has the provided access right.
364 Defaults to 'View customers of all agents'.
372 my %opt = ref($_[0]) ? %{$_[0]} : @_;
374 my $agentnum = $opt{'table'} ? $opt{'table'}.'.agentnum' : 'agentnum';
378 my $viewall_right = $opt{'viewall_right'} || 'View customers of all agents';
379 if ( $self->access_right($viewall_right) ) {
380 push @or, "$agentnum IS NOT NULL";
382 my @agentnums = $self->agentnums;
383 push @or, "$agentnum IN (". join(',', @agentnums). ')'
387 push @or, "$agentnum IS NULL"
389 || ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) );
391 return ' 1 = 0 ' unless scalar(@or);
392 '( '. join( ' OR ', @or ). ' )';
398 Returns true if the user can view the specified agent.
400 Also accepts optional hashref cache, to avoid redundant database calls.
405 my( $self, $agentnum, $cache ) = @_;
407 return $cache->{$self->usernum}->{$agentnum}
408 if $cache->{$self->usernum}->{$agentnum};
409 my $sth = dbh->prepare(
410 "SELECT COUNT(*) FROM access_usergroup
411 JOIN access_groupagent USING ( groupnum )
412 WHERE usernum = ? AND agentnum = ?"
413 ) or die dbh->errstr;
414 $sth->execute($self->usernum, $agentnum) or die $sth->errstr;
415 $cache->{$self->usernum}->{$agentnum} = $sth->fetchrow_arrayref->[0];
417 return $cache->{$self->usernum}->{$agentnum};
420 =item agents [ HASHREF | OPTION => VALUE ... ]
422 Returns the list of agents this user can view (via group membership), as
423 FS::agent objects. Accepts the same options as the agentnums_sql method.
431 'hashref' => { disabled=>'' },
432 'extra_sql' => ' AND '. $self->agentnums_sql(@_),
433 'order_by' => 'ORDER BY agent',
437 =item access_users [ HASHREF | OPTION => VALUE ... ]
439 Returns an array of FS::access_user objects, one for each non-disabled
440 access_user in the system that shares an agent (via group membership) with
441 the invoking object. Regardless of options and agents, will always at
442 least return the invoking user and any users who have viewall_right.
444 Accepts the following options:
450 Only return users who appear in the usernum field of this table
454 Include disabled users if true (defaults to false)
458 All users will be returned if the current user has the provided
459 access right, regardless of agents (other filters still apply.)
460 Defaults to 'View customers of all agents'
464 #Leaving undocumented until such time as this functionality is actually used
468 #Users with no agents will be returned.
472 #Users with no agents will be returned if the current user has the provided
477 my %opt = ref($_[0]) ? %{$_[0]} : @_;
478 my $table = $opt{'table'};
479 my $search = { 'table' => 'access_user' };
480 $search->{'hashref'} = $opt{'disabled'} ? {} : { 'disabled' => '' };
481 $search->{'addl_from'} = "INNER JOIN $table ON (access_user.usernum = $table.usernum)"
483 my @access_users = qsearch($search);
484 my $viewall_right = $opt{'viewall_right'} || 'View customers of all agents';
485 return @access_users if $self->access_right($viewall_right);
486 #filter for users with agents $self can view
488 my $agentnum_cache = {};
490 foreach my $access_user (@access_users) {
491 # you can always view yourself, regardless of agents,
492 # and you can always view someone who can view you,
493 # since they might have affected your customers
494 if ( ($self->usernum eq $access_user->usernum)
495 || $access_user->access_right($viewall_right)
497 push(@out,$access_user);
500 # if user has no agents, you need null or null_right to view
501 my @agents = $access_user->agents('viewall_right'=>'NONE'); #handled viewall_right above
504 ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) )
506 push(@out,$access_user);
510 # otherwise, you need an agent in common
511 foreach my $agent (@agents) {
512 if ($self->agentnum($agent->agentnum,$agentnum_cache)) {
513 push(@out,$access_user);
521 =item access_users_hashref [ HASHREF | OPTION => VALUE ... ]
523 Accepts same options as L</access_users>. Returns a hashref of
524 users, with keys of usernum and values of username.
528 sub access_users_hashref {
530 my %access_users = map { $_->usernum => $_->username }
531 $self->access_users(@_);
532 return \%access_users;
535 =item access_right RIGHTNAME | LISTREF
537 Given a right name or a list reference of right names, returns true if this
538 user has this right, or, for a list, one of the rights (currently via group
539 membership, eventually also via user overrides).
544 my( $self, $rightname ) = @_;
546 $rightname = [ $rightname ] unless ref($rightname);
548 warn "$me access_right called on ". join(', ', @$rightname). "\n"
551 #some caching of ACL requests for low-hanging fruit perf improvement
552 #since we get a new $CurrentUser object each page view there shouldn't be any
553 #issues with stickiness
554 if ( $self->{_ACLcache} ) {
556 unless ( grep !exists($self->{_ACLcache}{$_}), @$rightname ) {
557 warn "$me ACL cache hit for ". join(', ', @$rightname). "\n"
559 return scalar( grep $self->{_ACLcache}{$_}, @$rightname );
562 warn "$me ACL cache miss for ". join(', ', @$rightname). "\n"
567 warn "initializing ACL cache\n"
569 $self->{_ACLcache} = {};
573 my $has_right = ' rightname IN ('. join(',', map '?', @$rightname ). ') ';
575 my $sth = dbh->prepare("
576 SELECT groupnum FROM access_usergroup
577 LEFT JOIN access_group USING ( groupnum )
578 LEFT JOIN access_right
579 ON ( access_group.groupnum = access_right.rightobjnum )
581 AND righttype = 'FS::access_group'
584 ") or die dbh->errstr;
585 $sth->execute($self->usernum, @$rightname) or die $sth->errstr;
586 my $row = $sth->fetchrow_arrayref;
588 my $return = $row ? $row->[0] : '';
590 #just caching the single-rightname hits should be enough of a win for now
591 if ( scalar(@$rightname) == 1 ) {
592 $self->{_ACLcache}{${$rightname}[0]} = $return;
599 =item refund_rights PAYBY
601 Accepts payment $payby (BILL,CASH,MCRD,MCHK,CARD,CHEK) and returns a
602 list of the refund rights associated with that $payby.
604 Returns empty list if $payby wasn't recognized.
612 push @rights, 'Post refund' if $payby =~ /^(BILL|CASH|MCRD|MCHK)$/;
613 push @rights, 'Post check refund' if $payby eq 'BILL';
614 push @rights, 'Post cash refund ' if $payby eq 'CASH';
615 push @rights, 'Refund payment' if $payby =~ /^(CARD|CHEK)$/;
616 push @rights, 'Refund credit card payment' if $payby eq 'CARD';
617 push @rights, 'Refund Echeck payment' if $payby eq 'CHEK';
621 =item refund_access_right PAYBY
623 Returns true if user has L</access_right> for any L</refund_rights>
624 for the specified payby.
628 sub refund_access_right {
631 my @rights = $self->refund_rights($payby);
632 return '' unless @rights;
633 return $self->access_right(\@rights);
636 =item default_customer_view
638 Returns the default customer view for this user, from the
639 "default_customer_view" user preference, the "cust_main-default_view" config,
640 or the hardcoded default, "basics" (formerly "jumbo" prior to 3.0).
644 sub default_customer_view {
647 $self->option('default_customer_view')
648 || FS::Conf->new->config('cust_main-default_view')
649 || 'basics'; #s/jumbo/basics/ starting with 3.0
653 =item spreadsheet_format [ OVERRIDE ]
655 Returns a hashref of this user's Excel spreadsheet download settings:
656 'extension' (xls or xlsx), 'class' (Spreadsheet::WriteExcel or
657 Excel::Writer::XLSX), and 'mime_type'. If OVERRIDE is 'XLS' or 'XLSX',
658 use that instead of the user's setting.
662 # is there a better place to put this?
666 class => 'Spreadsheet::WriteExcel',
667 mime_type => 'application/vnd.ms-excel',
670 extension => '.xlsx',
671 class => 'Excel::Writer::XLSX',
672 mime_type => # it's on wikipedia, it must be true
673 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet',
677 sub spreadsheet_format {
679 my $override = shift;
682 || $self->option('spreadsheet_format')
683 || FS::Conf->new->config('spreadsheet_format')
691 Returns true if this user has the name of a known system account. These
692 users cannot log into the web interface and can't have passwords set.
698 return grep { $_ eq $self->username } ( qw(
709 =item change_password NEW_PASSWORD
711 Changes the user's password to NEW_PASSWORD. This does not check password
712 policy rules (see C<is_password_allowed>) and will return an error only if
713 editing the user's record fails for some reason.
715 If NEW_PASSWORD is the same as the existing password, this does nothing.
719 sub change_password {
720 #my( $self, $password ) = @_;
721 #FS::Auth->auth_class->change_password( $self, $password );
722 FS::Auth->auth_class->change_password( @_ );
725 =item change_password_fields NEW_PASSWORD
729 sub change_password_fields {
730 #my( $self, $password ) = @_;
731 #FS::Auth->auth_class->change_password_fields( $self, $password );
732 FS::Auth->auth_class->change_password_fields( @_ );
741 return $self->{_locale} if exists($self->{_locale});
742 $self->{_locale} = $self->option('locale');
745 =item get_page_pref PATH, NAME, TABLENUM
747 Returns the user's page preference named NAME for the page at PATH. If the
748 page is a view or edit page or otherwise shows a single record at a time,
749 it should use TABLENUM to tell which record the preference is for.
755 my ($path, $prefname, $tablenum) = @_;
758 my $access_user_page_pref = qsearchs('access_user_page_pref', {
760 usernum => $self->usernum,
761 tablenum => $tablenum,
762 prefname => $prefname,
764 $access_user_page_pref ? $access_user_page_pref->prefvalue : '';
767 =item set_page_pref PATH, NAME, TABLENUM, VALUE
769 Sets the user's page preference named NAME for the page at PATH. Use TABLENUM
770 as for get_page_pref.
776 my ($path, $prefname, $tablenum, $prefvalue) = @_;
780 my $access_user_page_pref = qsearchs('access_user_page_pref', {
782 usernum => $self->usernum,
783 tablenum => $tablenum,
784 prefname => $prefname,
786 if ( $access_user_page_pref ) {
787 if ( $prefvalue eq $access_user_page_pref->get('prefvalue') ) {
790 if ( length($prefvalue) > 0 ) {
791 $access_user_page_pref->set('prefvalue', $prefvalue);
792 $error = $access_user_page_pref->replace;
793 $error .= " (updating $prefname)" if $error;
795 $error = $access_user_page_pref->delete;
796 $error .= " (removing $prefname)" if $error;
799 if ( length($prefvalue) > 0 ) {
800 $access_user_page_pref = FS::access_user_page_pref->new({
802 usernum => $self->usernum,
803 tablenum => $tablenum,
804 prefname => $prefname,
805 prefvalue => $prefvalue,
807 $error = $access_user_page_pref->insert;
808 $error .= " (creating $prefname)" if $error;
823 L<FS::Record>, schema.html from the base documentation.