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->SUPER::delete(@_);
167 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
170 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
176 =item replace OLD_RECORD
178 Replaces the OLD_RECORD with this one in the database. If there is an error,
179 returns the error, otherwise returns false.
186 my $old = ( ref($_[0]) eq ref($new) )
190 local $SIG{HUP} = 'IGNORE';
191 local $SIG{INT} = 'IGNORE';
192 local $SIG{QUIT} = 'IGNORE';
193 local $SIG{TERM} = 'IGNORE';
194 local $SIG{TSTP} = 'IGNORE';
195 local $SIG{PIPE} = 'IGNORE';
197 my $oldAutoCommit = $FS::UID::AutoCommit;
198 local $FS::UID::AutoCommit = 0;
201 return "Must change password when enabling this account"
202 if $old->disabled && !$new->disabled
203 && ( $new->_password =~ /changeme/i
204 || $new->_password eq 'notyet'
207 my $error = $new->SUPER::replace($old, @_);
208 if ( $old->_password ne $new->_password ) {
209 $error ||= $new->insert_password_history;
213 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
216 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
224 Checks all fields to make sure this is a valid internal access user. If there is
225 an error, returns the error, otherwise returns false. Called by the insert
230 # the check method should currently be supplied - FS::Record contains some
231 # data checking routines
237 $self->ut_numbern('usernum')
238 || $self->ut_alpha_lower('username')
239 || $self->ut_textn('_password')
240 || $self->ut_textn('last')
241 || $self->ut_textn('first')
242 || $self->ut_foreign_keyn('user_custnum', 'cust_main', 'custnum')
243 || $self->ut_foreign_keyn('report_salesnum', 'sales', 'salesnum')
244 || $self->ut_enum('disabled', [ '', 'Y' ] )
246 return $error if $error;
253 Returns a name string for this user: "Last, First".
259 return $self->username
260 if $self->get('last') eq 'Lastname' && $self->first eq 'Firstname'
261 or $self->get('last') eq '' && $self->first eq '';
262 return $self->get('last'). ', '. $self->first;
267 Returns the FS::cust_main object (see L<FS::cust_main>), if any, for this
274 qsearchs( 'cust_main', { 'custnum' => $self->user_custnum } );
279 Returns the FS::sales object (see L<FS::sales>), if any, for this
286 qsearchs( 'sales', { 'salesnum' => $self->report_salesnum } );
289 =item access_usergroup
291 Returns links to the the groups this user is a part of, as FS::access_usergroup
292 objects (see L<FS::access_usergroup>).
296 Returns the number of agents this user can view (via group membership).
303 'SELECT COUNT(DISTINCT agentnum) FROM access_usergroup
304 JOIN access_groupagent USING ( groupnum )
312 Returns a list of agentnums this user can view (via group membership).
318 my $sth = dbh->prepare(
319 "SELECT DISTINCT agentnum FROM access_usergroup
320 JOIN access_groupagent USING ( groupnum )
322 ) or die dbh->errstr;
323 $sth->execute($self->usernum) or die $sth->errstr;
324 map { $_->[0] } @{ $sth->fetchall_arrayref };
329 Returns a hashref of agentnums this user can view.
335 scalar( { map { $_ => 1 } $self->agentnums } );
338 =item agentnums_sql [ HASHREF | OPTION => VALUE ... ]
340 Returns an sql fragement to select only agentnums this user can view.
342 Options are passed as a hashref or a list. Available options are:
348 The frament will also allow the selection of null agentnums.
352 The fragment will also allow the selection of null agentnums if the current
353 user has the provided access right
357 Optional table name in which agentnum is being checked. Sometimes required to
358 resolve 'column reference "agentnum" is ambiguous' errors.
362 All agents will be viewable if the current user has the provided access right.
363 Defaults to 'View customers of all agents'.
371 my %opt = ref($_[0]) ? %{$_[0]} : @_;
373 my $agentnum = $opt{'table'} ? $opt{'table'}.'.agentnum' : 'agentnum';
377 my $viewall_right = $opt{'viewall_right'} || 'View customers of all agents';
378 if ( $self->access_right($viewall_right) ) {
379 push @or, "$agentnum IS NOT NULL";
381 my @agentnums = $self->agentnums;
382 push @or, "$agentnum IN (". join(',', @agentnums). ')'
386 push @or, "$agentnum IS NULL"
388 || ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) );
390 return ' 1 = 0 ' unless scalar(@or);
391 '( '. join( ' OR ', @or ). ' )';
397 Returns true if the user can view the specified agent.
399 Also accepts optional hashref cache, to avoid redundant database calls.
404 my( $self, $agentnum, $cache ) = @_;
406 return $cache->{$self->usernum}->{$agentnum}
407 if $cache->{$self->usernum}->{$agentnum};
408 my $sth = dbh->prepare(
409 "SELECT COUNT(*) FROM access_usergroup
410 JOIN access_groupagent USING ( groupnum )
411 WHERE usernum = ? AND agentnum = ?"
412 ) or die dbh->errstr;
413 $sth->execute($self->usernum, $agentnum) or die $sth->errstr;
414 $cache->{$self->usernum}->{$agentnum} = $sth->fetchrow_arrayref->[0];
416 return $cache->{$self->usernum}->{$agentnum};
419 =item agents [ HASHREF | OPTION => VALUE ... ]
421 Returns the list of agents this user can view (via group membership), as
422 FS::agent objects. Accepts the same options as the agentnums_sql method.
430 'hashref' => { disabled=>'' },
431 'extra_sql' => ' AND '. $self->agentnums_sql(@_),
432 'order_by' => 'ORDER BY agent',
436 =item access_users [ HASHREF | OPTION => VALUE ... ]
438 Returns an array of FS::access_user objects, one for each non-disabled
439 access_user in the system that shares an agent (via group membership) with
440 the invoking object. Regardless of options and agents, will always at
441 least return the invoking user and any users who have viewall_right.
443 Accepts the following options:
449 Only return users who appear in the usernum field of this table
453 Include disabled users if true (defaults to false)
457 All users will be returned if the current user has the provided
458 access right, regardless of agents (other filters still apply.)
459 Defaults to 'View customers of all agents'
463 #Leaving undocumented until such time as this functionality is actually used
467 #Users with no agents will be returned.
471 #Users with no agents will be returned if the current user has the provided
476 my %opt = ref($_[0]) ? %{$_[0]} : @_;
477 my $table = $opt{'table'};
478 my $search = { 'table' => 'access_user' };
479 $search->{'hashref'} = $opt{'disabled'} ? {} : { 'disabled' => '' };
480 $search->{'addl_from'} = "INNER JOIN $table ON (access_user.usernum = $table.usernum)"
482 my @access_users = qsearch($search);
483 my $viewall_right = $opt{'viewall_right'} || 'View customers of all agents';
484 return @access_users if $self->access_right($viewall_right);
485 #filter for users with agents $self can view
487 my $agentnum_cache = {};
489 foreach my $access_user (@access_users) {
490 # you can always view yourself, regardless of agents,
491 # and you can always view someone who can view you,
492 # since they might have affected your customers
493 if ( ($self->usernum eq $access_user->usernum)
494 || $access_user->access_right($viewall_right)
496 push(@out,$access_user);
499 # if user has no agents, you need null or null_right to view
500 my @agents = $access_user->agents('viewall_right'=>'NONE'); #handled viewall_right above
503 ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) )
505 push(@out,$access_user);
509 # otherwise, you need an agent in common
510 foreach my $agent (@agents) {
511 if ($self->agentnum($agent->agentnum,$agentnum_cache)) {
512 push(@out,$access_user);
520 =item access_users_hashref [ HASHREF | OPTION => VALUE ... ]
522 Accepts same options as L</access_users>. Returns a hashref of
523 users, with keys of usernum and values of username.
527 sub access_users_hashref {
529 my %access_users = map { $_->usernum => $_->username }
530 $self->access_users(@_);
531 return \%access_users;
534 =item access_right RIGHTNAME | LISTREF
536 Given a right name or a list reference of right names, returns true if this
537 user has this right, or, for a list, one of the rights (currently via group
538 membership, eventually also via user overrides).
543 my( $self, $rightname ) = @_;
545 $rightname = [ $rightname ] unless ref($rightname);
547 warn "$me access_right called on ". join(', ', @$rightname). "\n"
550 #some caching of ACL requests for low-hanging fruit perf improvement
551 #since we get a new $CurrentUser object each page view there shouldn't be any
552 #issues with stickiness
553 if ( $self->{_ACLcache} ) {
555 unless ( grep !exists($self->{_ACLcache}{$_}), @$rightname ) {
556 warn "$me ACL cache hit for ". join(', ', @$rightname). "\n"
558 return scalar( grep $self->{_ACLcache}{$_}, @$rightname );
561 warn "$me ACL cache miss for ". join(', ', @$rightname). "\n"
566 warn "initializing ACL cache\n"
568 $self->{_ACLcache} = {};
572 my $has_right = ' rightname IN ('. join(',', map '?', @$rightname ). ') ';
574 my $sth = dbh->prepare("
575 SELECT groupnum FROM access_usergroup
576 LEFT JOIN access_group USING ( groupnum )
577 LEFT JOIN access_right
578 ON ( access_group.groupnum = access_right.rightobjnum )
580 AND righttype = 'FS::access_group'
583 ") or die dbh->errstr;
584 $sth->execute($self->usernum, @$rightname) or die $sth->errstr;
585 my $row = $sth->fetchrow_arrayref;
587 my $return = $row ? $row->[0] : '';
589 #just caching the single-rightname hits should be enough of a win for now
590 if ( scalar(@$rightname) == 1 ) {
591 $self->{_ACLcache}{${$rightname}[0]} = $return;
598 =item refund_rights PAYBY
600 Accepts payment $payby (BILL,CASH,MCRD,MCHK,CARD,CHEK) and returns a
601 list of the refund rights associated with that $payby.
603 Returns empty list if $payby wasn't recognized.
611 push @rights, 'Post refund' if $payby =~ /^(BILL|CASH|MCRD|MCHK)$/;
612 push @rights, 'Post check refund' if $payby eq 'BILL';
613 push @rights, 'Post cash refund ' if $payby eq 'CASH';
614 push @rights, 'Refund payment' if $payby =~ /^(CARD|CHEK)$/;
615 push @rights, 'Refund credit card payment' if $payby eq 'CARD';
616 push @rights, 'Refund Echeck payment' if $payby eq 'CHEK';
620 =item refund_access_right PAYBY
622 Returns true if user has L</access_right> for any L</refund_rights>
623 for the specified payby.
627 sub refund_access_right {
630 my @rights = $self->refund_rights($payby);
631 return '' unless @rights;
632 return $self->access_right(\@rights);
635 =item default_customer_view
637 Returns the default customer view for this user, from the
638 "default_customer_view" user preference, the "cust_main-default_view" config,
639 or the hardcoded default, "basics" (formerly "jumbo" prior to 3.0).
643 sub default_customer_view {
646 $self->option('default_customer_view')
647 || FS::Conf->new->config('cust_main-default_view')
648 || 'basics'; #s/jumbo/basics/ starting with 3.0
652 =item spreadsheet_format [ OVERRIDE ]
654 Returns a hashref of this user's Excel spreadsheet download settings:
655 'extension' (xls or xlsx), 'class' (Spreadsheet::WriteExcel or
656 Excel::Writer::XLSX), and 'mime_type'. If OVERRIDE is 'XLS' or 'XLSX',
657 use that instead of the user's setting.
661 # is there a better place to put this?
665 class => 'Spreadsheet::WriteExcel',
666 mime_type => 'application/vnd.ms-excel',
669 extension => '.xlsx',
670 class => 'Excel::Writer::XLSX',
671 mime_type => # it's on wikipedia, it must be true
672 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet',
676 sub spreadsheet_format {
678 my $override = shift;
681 || $self->option('spreadsheet_format')
682 || FS::Conf->new->config('spreadsheet_format')
690 Returns true if this user has the name of a known system account. These
691 users cannot log into the web interface and can't have passwords set.
697 return grep { $_ eq $self->username } ( qw(
708 =item change_password NEW_PASSWORD
710 Changes the user's password to NEW_PASSWORD. This does not check password
711 policy rules (see C<is_password_allowed>) and will return an error only if
712 editing the user's record fails for some reason.
714 If NEW_PASSWORD is the same as the existing password, this does nothing.
718 sub change_password {
719 #my( $self, $password ) = @_;
720 #FS::Auth->auth_class->change_password( $self, $password );
721 FS::Auth->auth_class->change_password( @_ );
724 =item change_password_fields NEW_PASSWORD
728 sub change_password_fields {
729 #my( $self, $password ) = @_;
730 #FS::Auth->auth_class->change_password_fields( $self, $password );
731 FS::Auth->auth_class->change_password_fields( @_ );
740 return $self->{_locale} if exists($self->{_locale});
741 $self->{_locale} = $self->option('locale');
750 L<FS::Record>, schema.html from the base documentation.