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 );
19 $me = '[FS::access_user]';
23 FS::access_user - Object methods for access_user records
29 $record = new FS::access_user \%hash;
30 $record = new FS::access_user { 'column' => 'value' };
32 $error = $record->insert;
34 $error = $new_record->replace($old_record);
36 $error = $record->delete;
38 $error = $record->check;
42 An FS::access_user object represents an internal access user. FS::access_user
43 inherits from FS::Record. The following fields are currently supported:
55 =item _password_encoding
69 Master customer for this employee (for commissions)
73 Default sales person for this employee (for reports)
87 Creates a new internal access user. To add the user to the database, see L<"insert">.
89 Note that this stores the hash reference, not a distinct copy of the hash it
90 points to. You can ask the object for a copy with the I<hash> method.
94 # the new method can be inherited from FS::Record, if a table method is defined
96 sub table { 'access_user'; }
98 sub _option_table { 'access_user_pref'; }
99 sub _option_namecol { 'prefname'; }
100 sub _option_valuecol { 'prefvalue'; }
104 Adds this record to the database. If there is an error, returns the error,
105 otherwise returns false.
112 my $error = $self->check;
113 return $error if $error;
115 local $SIG{HUP} = 'IGNORE';
116 local $SIG{INT} = 'IGNORE';
117 local $SIG{QUIT} = 'IGNORE';
118 local $SIG{TERM} = 'IGNORE';
119 local $SIG{TSTP} = 'IGNORE';
120 local $SIG{PIPE} = 'IGNORE';
122 my $oldAutoCommit = $FS::UID::AutoCommit;
123 local $FS::UID::AutoCommit = 0;
127 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
131 $error = $self->SUPER::insert(@_);
132 if ( $self->_password ) {
133 $error ||= $self->insert_password_history;
137 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
140 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
148 Delete this record from the database.
155 local $SIG{HUP} = 'IGNORE';
156 local $SIG{INT} = 'IGNORE';
157 local $SIG{QUIT} = 'IGNORE';
158 local $SIG{TERM} = 'IGNORE';
159 local $SIG{TSTP} = 'IGNORE';
160 local $SIG{PIPE} = 'IGNORE';
162 my $oldAutoCommit = $FS::UID::AutoCommit;
163 local $FS::UID::AutoCommit = 0;
166 my $error = $self->delete_password_history
167 || $self->SUPER::delete(@_);
170 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
173 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
179 =item replace OLD_RECORD
181 Replaces the OLD_RECORD with this one in the database. If there is an error,
182 returns the error, otherwise returns false.
189 my $old = ( ref($_[0]) eq ref($new) )
193 local $SIG{HUP} = 'IGNORE';
194 local $SIG{INT} = 'IGNORE';
195 local $SIG{QUIT} = 'IGNORE';
196 local $SIG{TERM} = 'IGNORE';
197 local $SIG{TSTP} = 'IGNORE';
198 local $SIG{PIPE} = 'IGNORE';
200 my $oldAutoCommit = $FS::UID::AutoCommit;
201 local $FS::UID::AutoCommit = 0;
204 return "Must change password when enabling this account"
205 if $old->disabled && !$new->disabled
206 && ( $new->_password =~ /changeme/i
207 || $new->_password eq 'notyet'
210 my $error = $new->SUPER::replace($old, @_);
211 if ( $old->_password ne $new->_password ) {
212 $error ||= $new->insert_password_history;
216 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
219 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
227 Checks all fields to make sure this is a valid internal access user. If there is
228 an error, returns the error, otherwise returns false. Called by the insert
233 # the check method should currently be supplied - FS::Record contains some
234 # data checking routines
240 $self->ut_numbern('usernum')
241 || $self->ut_alpha_lower('username')
242 || $self->ut_textn('_password')
243 || $self->ut_alphan('totp_secret32')
244 || $self->ut_textn('last')
245 || $self->ut_textn('first')
246 || $self->ut_foreign_keyn('user_custnum', 'cust_main', 'custnum')
247 || $self->ut_foreign_keyn('report_salesnum', 'sales', 'salesnum')
248 || $self->ut_enum('disabled', [ '', 'Y' ] )
250 return $error if $error;
257 Returns a name string for this user: "Last, First".
263 return $self->username
264 if $self->get('last') eq 'Lastname' && $self->first eq 'Firstname'
265 or $self->get('last') eq '' && $self->first eq '';
266 return $self->get('last'). ', '. $self->first;
271 Returns the FS::cust_main object (see L<FS::cust_main>), if any, for this
278 qsearchs( 'cust_main', { 'custnum' => $self->user_custnum } );
283 Returns the FS::sales object (see L<FS::sales>), if any, for this
290 qsearchs( 'sales', { 'salesnum' => $self->report_salesnum } );
293 =item access_usergroup
295 Returns links to the the groups this user is a part of, as FS::access_usergroup
296 objects (see L<FS::access_usergroup>).
300 Returns the number of agents this user can view (via group membership).
307 'SELECT COUNT(DISTINCT agentnum) FROM access_usergroup
308 JOIN access_groupagent USING ( groupnum )
316 Returns a list of agentnums this user can view (via group membership).
322 my $sth = dbh->prepare(
323 "SELECT DISTINCT agentnum FROM access_usergroup
324 JOIN access_groupagent USING ( groupnum )
326 ) or die dbh->errstr;
327 $sth->execute($self->usernum) or die $sth->errstr;
328 map { $_->[0] } @{ $sth->fetchall_arrayref };
333 Returns a hashref of agentnums this user can view.
339 scalar( { map { $_ => 1 } $self->agentnums } );
342 =item agentnums_sql [ HASHREF | OPTION => VALUE ... ]
344 Returns an sql fragement to select only agentnums this user can view.
346 Options are passed as a hashref or a list. Available options are:
352 The frament will also allow the selection of null agentnums.
356 The fragment will also allow the selection of null agentnums if the current
357 user has the provided access right
361 Optional table name in which agentnum is being checked. Sometimes required to
362 resolve 'column reference "agentnum" is ambiguous' errors.
366 All agents will be viewable if the current user has the provided access right.
367 Defaults to 'View customers of all agents'.
375 my %opt = ref($_[0]) ? %{$_[0]} : @_;
377 my $agentnum = $opt{'table'} ? $opt{'table'}.'.agentnum' : 'agentnum';
381 my $viewall_right = $opt{'viewall_right'} || 'View customers of all agents';
382 if ( $self->access_right($viewall_right) ) {
383 push @or, "$agentnum IS NOT NULL";
385 my @agentnums = $self->agentnums;
386 push @or, "$agentnum IN (". join(',', @agentnums). ')'
390 push @or, "$agentnum IS NULL"
392 || ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) );
394 return ' 1 = 0 ' unless scalar(@or);
395 '( '. join( ' OR ', @or ). ' )';
401 Returns true if the user can view the specified agent.
403 Also accepts optional hashref cache, to avoid redundant database calls.
408 my( $self, $agentnum, $cache ) = @_;
410 return $cache->{$self->usernum}->{$agentnum}
411 if $cache->{$self->usernum}->{$agentnum};
412 my $sth = dbh->prepare(
413 "SELECT COUNT(*) FROM access_usergroup
414 JOIN access_groupagent USING ( groupnum )
415 WHERE usernum = ? AND agentnum = ?"
416 ) or die dbh->errstr;
417 $sth->execute($self->usernum, $agentnum) or die $sth->errstr;
418 $cache->{$self->usernum}->{$agentnum} = $sth->fetchrow_arrayref->[0];
420 return $cache->{$self->usernum}->{$agentnum};
423 =item agents [ HASHREF | OPTION => VALUE ... ]
425 Returns the list of agents this user can view (via group membership), as
426 FS::agent objects. Accepts the same options as the agentnums_sql method.
434 'hashref' => { disabled=>'' },
435 'extra_sql' => ' AND '. $self->agentnums_sql(@_),
436 'order_by' => 'ORDER BY agent',
440 =item access_users [ HASHREF | OPTION => VALUE ... ]
442 Returns an array of FS::access_user objects, one for each non-disabled
443 access_user in the system that shares an agent (via group membership) with
444 the invoking object. Regardless of options and agents, will always at
445 least return the invoking user and any users who have viewall_right.
447 Accepts the following options:
453 Only return users who appear in the usernum field of this table
457 Include disabled users if true (defaults to false)
461 All users will be returned if the current user has the provided
462 access right, regardless of agents (other filters still apply.)
463 Defaults to 'View customers of all agents'
467 #Leaving undocumented until such time as this functionality is actually used
471 #Users with no agents will be returned.
475 #Users with no agents will be returned if the current user has the provided
480 my %opt = ref($_[0]) ? %{$_[0]} : @_;
481 my $table = $opt{'table'};
482 my $search = { 'table' => 'access_user' };
483 $search->{'hashref'} = $opt{'disabled'} ? {} : { 'disabled' => '' };
484 $search->{'addl_from'} = "INNER JOIN $table ON (access_user.usernum = $table.usernum)"
486 my @access_users = qsearch($search);
487 my $viewall_right = $opt{'viewall_right'} || 'View customers of all agents';
488 return @access_users if $self->access_right($viewall_right);
489 #filter for users with agents $self can view
491 my $agentnum_cache = {};
493 foreach my $access_user (@access_users) {
494 # you can always view yourself, regardless of agents,
495 # and you can always view someone who can view you,
496 # since they might have affected your customers
497 if ( ($self->usernum eq $access_user->usernum)
498 || $access_user->access_right($viewall_right)
500 push(@out,$access_user);
503 # if user has no agents, you need null or null_right to view
504 my @agents = $access_user->agents('viewall_right'=>'NONE'); #handled viewall_right above
507 ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) )
509 push(@out,$access_user);
513 # otherwise, you need an agent in common
514 foreach my $agent (@agents) {
515 if ($self->agentnum($agent->agentnum,$agentnum_cache)) {
516 push(@out,$access_user);
524 =item access_users_hashref [ HASHREF | OPTION => VALUE ... ]
526 Accepts same options as L</access_users>. Returns a hashref of
527 users, with keys of usernum and values of username.
531 sub access_users_hashref {
533 my %access_users = map { $_->usernum => $_->username }
534 $self->access_users(@_);
535 return \%access_users;
538 =item access_right RIGHTNAME | LISTREF
540 Given a right name or a list reference of right names, returns true if this
541 user has this right, or, for a list, one of the rights (currently via group
542 membership, eventually also via user overrides).
547 my( $self, $rightname ) = @_;
549 $rightname = [ $rightname ] unless ref($rightname);
551 warn "$me access_right called on ". join(', ', @$rightname). "\n"
554 #some caching of ACL requests for low-hanging fruit perf improvement
555 #since we get a new $CurrentUser object each page view there shouldn't be any
556 #issues with stickiness
557 if ( $self->{_ACLcache} ) {
559 unless ( grep !exists($self->{_ACLcache}{$_}), @$rightname ) {
560 warn "$me ACL cache hit for ". join(', ', @$rightname). "\n"
562 return scalar( grep $self->{_ACLcache}{$_}, @$rightname );
565 warn "$me ACL cache miss for ". join(', ', @$rightname). "\n"
570 warn "initializing ACL cache\n"
572 $self->{_ACLcache} = {};
576 my $has_right = ' rightname IN ('. join(',', map '?', @$rightname ). ') ';
578 my $sth = dbh->prepare("
579 SELECT groupnum FROM access_usergroup
580 LEFT JOIN access_group USING ( groupnum )
581 LEFT JOIN access_right
582 ON ( access_group.groupnum = access_right.rightobjnum )
584 AND righttype = 'FS::access_group'
587 ") or die dbh->errstr;
588 $sth->execute($self->usernum, @$rightname) or die $sth->errstr;
589 my $row = $sth->fetchrow_arrayref;
591 my $return = $row ? $row->[0] : '';
593 #just caching the single-rightname hits should be enough of a win for now
594 if ( scalar(@$rightname) == 1 ) {
595 $self->{_ACLcache}{${$rightname}[0]} = $return;
602 =item refund_rights PAYBY
604 Accepts payment $payby (BILL,CASH,MCRD,MCHK,CARD,CHEK) and returns a
605 list of the refund rights associated with that $payby.
607 Returns empty list if $payby wasn't recognized.
615 push @rights, 'Post refund' if $payby =~ /^(BILL|CASH|MCRD|MCHK)$/;
616 push @rights, 'Post check refund' if $payby eq 'BILL';
617 push @rights, 'Post cash refund ' if $payby eq 'CASH';
618 push @rights, 'Refund payment' if $payby =~ /^(CARD|CHEK)$/;
619 push @rights, 'Refund credit card payment' if $payby eq 'CARD';
620 push @rights, 'Refund Echeck payment' if $payby eq 'CHEK';
624 =item refund_access_right PAYBY
626 Returns true if user has L</access_right> for any L</refund_rights>
627 for the specified payby.
631 sub refund_access_right {
634 my @rights = $self->refund_rights($payby);
635 return '' unless @rights;
636 return $self->access_right(\@rights);
639 =item default_customer_view
641 Returns the default customer view for this user, from the
642 "default_customer_view" user preference, the "cust_main-default_view" config,
643 or the hardcoded default, "basics" (formerly "jumbo" prior to 3.0).
647 sub default_customer_view {
650 $self->option('default_customer_view')
651 || FS::Conf->new->config('cust_main-default_view')
652 || 'basics'; #s/jumbo/basics/ starting with 3.0
656 =item spreadsheet_format [ OVERRIDE ]
658 Returns a hashref of this user's Excel spreadsheet download settings:
659 'extension' (xls or xlsx), 'class' (Spreadsheet::WriteExcel or
660 Excel::Writer::XLSX), and 'mime_type'. If OVERRIDE is 'XLS' or 'XLSX',
661 use that instead of the user's setting.
665 # is there a better place to put this?
669 class => 'Spreadsheet::WriteExcel',
670 mime_type => 'application/vnd.ms-excel',
673 extension => '.xlsx',
674 class => 'Excel::Writer::XLSX',
675 mime_type => # it's on wikipedia, it must be true
676 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet',
680 sub spreadsheet_format {
682 my $override = shift;
685 || $self->option('spreadsheet_format')
686 || FS::Conf->new->config('spreadsheet_format')
694 Returns true if this user has the name of a known system account. These
695 users cannot log into the web interface and can't have passwords set.
701 return grep { $_ eq $self->username } ( qw(
712 =item change_password NEW_PASSWORD
714 Changes the user's password to NEW_PASSWORD. This does not check password
715 policy rules (see C<is_password_allowed>) and will return an error only if
716 editing the user's record fails for some reason.
718 If NEW_PASSWORD is the same as the existing password, this does nothing.
722 sub change_password {
723 #my( $self, $password ) = @_;
724 #FS::Auth->auth_class->change_password( $self, $password );
725 FS::Auth->auth_class->change_password( @_ );
728 =item change_password_fields NEW_PASSWORD
732 sub change_password_fields {
733 #my( $self, $password ) = @_;
734 #FS::Auth->auth_class->change_password_fields( $self, $password );
735 FS::Auth->auth_class->change_password_fields( @_ );
744 my $issuer = FS::Conf->new->config('company_name'). ' Freeside';
745 my $label = $issuer. ':'. $self->username;
747 Auth::GoogleAuth->new({
748 secret => $self->totp_secret32,
755 =item set_totp_secret32
759 sub set_totp_secret32 {
762 $self->totp_secret32( $self->google_auth->generate_secret32 );
766 =item totp_qr_code_url
770 sub totp_qr_code_url {
773 $self->google_auth->qr_code;
782 return $self->{_locale} if exists($self->{_locale});
783 $self->{_locale} = $self->option('locale');
786 =item get_page_pref PATH, NAME, TABLENUM
788 Returns the user's page preference named NAME for the page at PATH. If the
789 page is a view or edit page or otherwise shows a single record at a time,
790 it should use TABLENUM to tell which record the preference is for.
796 my ($path, $prefname, $tablenum) = @_;
799 my $access_user_page_pref = qsearchs('access_user_page_pref', {
801 usernum => $self->usernum,
802 tablenum => $tablenum,
803 prefname => $prefname,
805 $access_user_page_pref ? $access_user_page_pref->prefvalue : '';
808 =item set_page_pref PATH, NAME, TABLENUM, VALUE
810 Sets the user's page preference named NAME for the page at PATH. Use TABLENUM
811 as for get_page_pref.
817 my ($path, $prefname, $tablenum, $prefvalue) = @_;
821 my $access_user_page_pref = qsearchs('access_user_page_pref', {
823 usernum => $self->usernum,
824 tablenum => $tablenum,
825 prefname => $prefname,
827 if ( $access_user_page_pref ) {
828 if ( $prefvalue eq $access_user_page_pref->get('prefvalue') ) {
831 if ( length($prefvalue) > 0 ) {
832 $access_user_page_pref->set('prefvalue', $prefvalue);
833 $error = $access_user_page_pref->replace;
834 $error .= " (updating $prefname)" if $error;
836 $error = $access_user_page_pref->delete;
837 $error .= " (removing $prefname)" if $error;
840 if ( length($prefvalue) > 0 ) {
841 $access_user_page_pref = FS::access_user_page_pref->new({
843 usernum => $self->usernum,
844 tablenum => $tablenum,
845 prefname => $prefname,
846 prefvalue => $prefvalue,
848 $error = $access_user_page_pref->insert;
849 $error .= " (creating $prefname)" if $error;
860 Fetch the prefvalue column from L<FS::access_user_pref> for prefname NAME
862 Returns undef when no value has been saved, or when record has expired
867 my ( $self, $prefname ) = @_;
868 croak 'prefname parameter requrired' unless $prefname;
870 my $pref_row = $self->get_pref_row( $prefname )
874 if $pref_row->expiration
875 && $pref_row->expiration < time();
877 $pref_row->prefvalue;
880 =item get_pref_row NAME
882 Fetch the row object from L<FS::access_user_pref> for prefname NAME
884 returns undef when no row has been created
889 my ( $self, $prefname ) = @_;
890 croak 'prefname parameter required' unless $prefname;
893 access_user_pref => {
894 usernum => $self->usernum,
895 prefname => $prefname,
900 =item set_pref NAME, VALUE, [EXPIRATION_EPOCH]
902 Add or update user preference in L<FS::access_user_pref> table
904 Passing an undefined VALUE will delete the user preference
912 my ( $prefname, $prefvalue, $expiration ) = @_;
914 return $self->delete_pref( $prefname )
915 unless defined $prefvalue;
917 if ( my $pref_row = $self->get_pref_row( $prefname )) {
919 if $pref_row->prefvalue eq $prefvalue;
921 $pref_row->prefvalue( $prefvalue );
922 $pref_row->expiration( $expiration || '');
924 if ( my $error = $pref_row->replace ) { croak $error }
929 my $pref_row = FS::access_user_pref->new({
930 usernum => $self->usernum,
931 prefname => $prefname,
932 prefvalue => $prefvalue,
933 expiration => $expiration,
935 if ( my $error = $pref_row->insert ) { croak $error }
940 =item delete_pref NAME
942 Delete user preference from L<FS::access_user_pref> table
947 my ( $self, $prefname ) = @_;
949 my $pref_row = $self->get_pref_row( $prefname )
952 if ( my $error = $pref_row->delete ) { croak $error }
961 L<FS::Record>, schema.html from the base documentation.