1 package FS::access_user;
4 use base qw( FS::m2m_Common FS::option_Common );
5 use vars qw( $DEBUG $me $conf $htpasswd_file );
8 use FS::Record qw( qsearch qsearchs dbh );
9 use FS::access_user_pref;
10 use FS::access_usergroup;
17 $me = '[FS::access_user]';
19 #kludge htpasswd for now (i hope this bootstraps okay)
20 FS::UID->install_callback( sub {
22 $htpasswd_file = $conf->base_dir. '/htpasswd';
27 FS::access_user - Object methods for access_user records
33 $record = new FS::access_user \%hash;
34 $record = new FS::access_user { 'column' => 'value' };
36 $error = $record->insert;
38 $error = $new_record->replace($old_record);
40 $error = $record->delete;
42 $error = $record->check;
46 An FS::access_user object represents an internal access user. FS::access_user
47 inherits from FS::Record. The following fields are currently supported:
51 =item usernum - primary key
61 =item disabled - empty or 'Y'
71 Creates a new internal access user. To add the user to the database, see L<"insert">.
73 Note that this stores the hash reference, not a distinct copy of the hash it
74 points to. You can ask the object for a copy with the I<hash> method.
78 # the new method can be inherited from FS::Record, if a table method is defined
80 sub table { 'access_user'; }
82 sub _option_table { 'access_user_pref'; }
83 sub _option_namecol { 'prefname'; }
84 sub _option_valuecol { 'prefvalue'; }
88 Adds this record to the database. If there is an error, returns the error,
89 otherwise returns false.
96 my $error = $self->check;
97 return $error if $error;
99 local $SIG{HUP} = 'IGNORE';
100 local $SIG{INT} = 'IGNORE';
101 local $SIG{QUIT} = 'IGNORE';
102 local $SIG{TERM} = 'IGNORE';
103 local $SIG{TSTP} = 'IGNORE';
104 local $SIG{PIPE} = 'IGNORE';
106 my $oldAutoCommit = $FS::UID::AutoCommit;
107 local $FS::UID::AutoCommit = 0;
110 $error = $self->htpasswd_kludge();
112 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
116 $error = $self->SUPER::insert(@_);
119 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
121 #make sure it isn't a dup username? or you could nuke people's passwords
122 #blah. really just should do our own login w/cookies
123 #and auth out of the db in the first place
124 #my $hterror = $self->htpasswd_kludge('-D');
125 #$error .= " - additionally received error cleaning up htpasswd file: $hterror"
129 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
135 sub htpasswd_kludge {
138 return '' if $self->is_system_user;
140 unshift @_, '-c' unless -e $htpasswd_file;
142 system('htpasswd', '-b', @_,
151 return 'htpasswd exited unsucessfully';
157 Delete this record from the database.
164 local $SIG{HUP} = 'IGNORE';
165 local $SIG{INT} = 'IGNORE';
166 local $SIG{QUIT} = 'IGNORE';
167 local $SIG{TERM} = 'IGNORE';
168 local $SIG{TSTP} = 'IGNORE';
169 local $SIG{PIPE} = 'IGNORE';
171 my $oldAutoCommit = $FS::UID::AutoCommit;
172 local $FS::UID::AutoCommit = 0;
176 $self->delete_password_history
177 || $self->SUPER::delete(@_)
178 || $self->htpasswd_kludge('-D')
182 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
185 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
191 =item replace OLD_RECORD
193 Replaces the OLD_RECORD with this one in the database. If there is an error,
194 returns the error, otherwise returns false.
201 my $old = ( ref($_[0]) eq ref($new) )
205 local $SIG{HUP} = 'IGNORE';
206 local $SIG{INT} = 'IGNORE';
207 local $SIG{QUIT} = 'IGNORE';
208 local $SIG{TERM} = 'IGNORE';
209 local $SIG{TSTP} = 'IGNORE';
210 local $SIG{PIPE} = 'IGNORE';
212 my $oldAutoCommit = $FS::UID::AutoCommit;
213 local $FS::UID::AutoCommit = 0;
216 if ( $new->_password ne $old->_password ) {
217 my $error = $new->htpasswd_kludge();
219 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
222 } elsif ( $old->disabled && !$new->disabled
223 && $new->_password =~ /changeme/i ) {
224 return "Must change password when enabling this account";
227 my $error = $new->SUPER::replace($old, @_);
230 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
233 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
241 Checks all fields to make sure this is a valid internal access user. If there is
242 an error, returns the error, otherwise returns false. Called by the insert
247 # the check method should currently be supplied - FS::Record contains some
248 # data checking routines
254 $self->ut_numbern('usernum')
255 || $self->ut_alpha_lower('username')
256 || $self->ut_text('_password')
257 || $self->ut_text('last')
258 || $self->ut_text('first')
259 || $self->ut_foreign_keyn('user_custnum', 'cust_main', 'custnum')
260 || $self->ut_foreign_keyn('report_salesnum', 'sales', 'salesnum')
261 || $self->ut_enum('disabled', [ '', 'Y' ] )
263 return $error if $error;
270 Returns a name string for this user: "Last, First".
276 return $self->username
277 if $self->get('last') eq 'Lastname' && $self->first eq 'Firstname';
278 return $self->get('last'). ', '. $self->first;
283 Returns the FS::cust_main object (see L<FS::cust_main>), if any, for this
290 qsearchs( 'cust_main', { 'custnum' => $self->user_custnum } );
295 Returns the FS::sales object (see L<FS::sales>), if any, for this
302 qsearchs( 'sales', { 'salesnum' => $self->report_salesnum } );
305 =item access_usergroup
307 Returns links to the the groups this user is a part of, as FS::access_usergroup
308 objects (see L<FS::access_usergroup>).
312 sub access_usergroup {
314 qsearch( 'access_usergroup', { 'usernum' => $self->usernum } );
325 #=item access_groupnames
329 #sub access_groupnames {
335 Returns the number of agents this user can view (via group membership).
342 'SELECT COUNT(DISTINCT agentnum) FROM access_usergroup
343 JOIN access_groupagent USING ( groupnum )
351 Returns a list of agentnums this user can view (via group membership).
357 my $sth = dbh->prepare(
358 "SELECT DISTINCT agentnum FROM access_usergroup
359 JOIN access_groupagent USING ( groupnum )
361 ) or die dbh->errstr;
362 $sth->execute($self->usernum) or die $sth->errstr;
363 map { $_->[0] } @{ $sth->fetchall_arrayref };
368 Returns a hashref of agentnums this user can view.
374 scalar( { map { $_ => 1 } $self->agentnums } );
377 =item agentnums_sql [ HASHREF | OPTION => VALUE ... ]
379 Returns an sql fragement to select only agentnums this user can view.
381 Options are passed as a hashref or a list. Available options are:
387 The frament will also allow the selection of null agentnums.
391 The fragment will also allow the selection of null agentnums if the current
392 user has the provided access right
396 Optional table name in which agentnum is being checked. Sometimes required to
397 resolve 'column reference "agentnum" is ambiguous' errors.
401 All agents will be viewable if the current user has the provided access right.
402 Defaults to 'View customers of all agents'.
410 my %opt = ref($_[0]) ? %{$_[0]} : @_;
412 my $agentnum = $opt{'table'} ? $opt{'table'}.'.agentnum' : 'agentnum';
416 my $viewall_right = $opt{'viewall_right'} || 'View customers of all agents';
417 if ( $self->access_right($viewall_right) ) {
418 push @or, "$agentnum IS NOT NULL";
420 my @agentnums = $self->agentnums;
421 push @or, "$agentnum IN (". join(',', @agentnums). ')'
425 push @or, "$agentnum IS NULL"
427 || ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) );
429 return ' 1 = 0 ' unless scalar(@or);
430 '( '. join( ' OR ', @or ). ' )';
436 Returns true if the user can view the specified agent.
438 Also accepts optional hashref cache, to avoid redundant database calls.
443 my( $self, $agentnum, $cache ) = @_;
445 return $cache->{$self->usernum}->{$agentnum}
446 if $cache->{$self->usernum}->{$agentnum};
447 my $sth = dbh->prepare(
448 "SELECT COUNT(*) FROM access_usergroup
449 JOIN access_groupagent USING ( groupnum )
450 WHERE usernum = ? AND agentnum = ?"
451 ) or die dbh->errstr;
452 $sth->execute($self->usernum, $agentnum) or die $sth->errstr;
453 $cache->{$self->usernum}->{$agentnum} = $sth->fetchrow_arrayref->[0];
455 return $cache->{$self->usernum}->{$agentnum};
458 =item agents [ HASHREF | OPTION => VALUE ... ]
460 Returns the list of agents this user can view (via group membership), as
461 FS::agent objects. Accepts the same options as the agentnums_sql method.
469 'hashref' => { disabled=>'' },
470 'extra_sql' => ' AND '. $self->agentnums_sql(@_),
471 'order_by' => 'ORDER BY agent',
475 =item access_users [ HASHREF | OPTION => VALUE ... ]
477 Returns an array of FS::access_user objects, one for each non-disabled
478 access_user in the system that shares an agent (via group membership) with
479 the invoking object. Regardless of options and agents, will always at
480 least return the invoking user and any users who have viewall_right.
482 Accepts the following options:
488 Only return users who appear in the usernum field of this table
492 Include disabled users if true (defaults to false)
496 All users will be returned if the current user has the provided
497 access right, regardless of agents (other filters still apply.)
498 Defaults to 'View customers of all agents'
502 #Leaving undocumented until such time as this functionality is actually used
506 #Users with no agents will be returned.
510 #Users with no agents will be returned if the current user has the provided
515 my %opt = ref($_[0]) ? %{$_[0]} : @_;
516 my $table = $opt{'table'};
517 my $search = { 'table' => 'access_user' };
518 $search->{'hashref'} = $opt{'disabled'} ? {} : { 'disabled' => '' };
519 $search->{'addl_from'} = "INNER JOIN $table ON (access_user.usernum = $table.usernum)"
521 my @access_users = qsearch($search);
522 my $viewall_right = $opt{'viewall_right'} || 'View customers of all agents';
523 return @access_users if $self->access_right($viewall_right);
524 #filter for users with agents $self can view
526 my $agentnum_cache = {};
528 foreach my $access_user (@access_users) {
529 # you can always view yourself, regardless of agents,
530 # and you can always view someone who can view you,
531 # since they might have affected your customers
532 if ( ($self->usernum eq $access_user->usernum)
533 || $access_user->access_right($viewall_right)
535 push(@out,$access_user);
538 # if user has no agents, you need null or null_right to view
539 my @agents = $access_user->agents('viewall_right'=>'NONE'); #handled viewall_right above
542 ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) )
544 push(@out,$access_user);
548 # otherwise, you need an agent in common
549 foreach my $agent (@agents) {
550 if ($self->agentnum($agent->agentnum,$agentnum_cache)) {
551 push(@out,$access_user);
559 =item access_users_hashref [ HASHREF | OPTION => VALUE ... ]
561 Accepts same options as L</access_users>. Returns a hashref of
562 users, with keys of usernum and values of username.
566 sub access_users_hashref {
568 my %access_users = map { $_->usernum => $_->username }
569 $self->access_users(@_);
570 return \%access_users;
573 =item access_right RIGHTNAME | LISTREF
575 Given a right name or a list reference of right names, returns true if this
576 user has this right, or, for a list, one of the rights (currently via group
577 membership, eventually also via user overrides).
582 my( $self, $rightname ) = @_;
584 $rightname = [ $rightname ] unless ref($rightname);
586 warn "$me access_right called on ". join(', ', @$rightname). "\n"
589 #some caching of ACL requests for low-hanging fruit perf improvement
590 #since we get a new $CurrentUser object each page view there shouldn't be any
591 #issues with stickiness
592 if ( $self->{_ACLcache} ) {
594 unless ( grep !exists($self->{_ACLcache}{$_}), @$rightname ) {
595 warn "$me ACL cache hit for ". join(', ', @$rightname). "\n"
597 return scalar( grep $self->{_ACLcache}{$_}, @$rightname );
600 warn "$me ACL cache miss for ". join(', ', @$rightname). "\n"
605 warn "initializing ACL cache\n"
607 $self->{_ACLcache} = {};
611 my $has_right = ' rightname IN ('. join(',', map '?', @$rightname ). ') ';
613 my $sth = dbh->prepare("
614 SELECT groupnum FROM access_usergroup
615 LEFT JOIN access_group USING ( groupnum )
616 LEFT JOIN access_right
617 ON ( access_group.groupnum = access_right.rightobjnum )
619 AND righttype = 'FS::access_group'
622 ") or die dbh->errstr;
623 $sth->execute($self->usernum, @$rightname) or die $sth->errstr;
624 my $row = $sth->fetchrow_arrayref;
626 my $return = $row ? $row->[0] : '';
628 #just caching the single-rightname hits should be enough of a win for now
629 if ( scalar(@$rightname) == 1 ) {
630 $self->{_ACLcache}{${$rightname}[0]} = $return;
637 =item refund_rights PAYBY
639 Accepts payment $payby (BILL,CASH,MCRD,MCHK,CARD,CHEK) and returns a
640 list of the refund rights associated with that $payby.
642 Returns empty list if $payby wasn't recognized.
650 push @rights, 'Post refund' if $payby =~ /^(BILL|CASH|MCRD|MCHK)$/;
651 push @rights, 'Post check refund' if $payby eq 'BILL';
652 push @rights, 'Post cash refund ' if $payby eq 'CASH';
653 push @rights, 'Refund payment' if $payby =~ /^(CARD|CHEK)$/;
654 push @rights, 'Refund credit card payment' if $payby eq 'CARD';
655 push @rights, 'Refund Echeck payment' if $payby eq 'CHEK';
659 =item refund_access_right PAYBY
661 Returns true if user has L</access_right> for any L</refund_rights>
662 for the specified payby.
666 sub refund_access_right {
669 my @rights = $self->refund_rights($payby);
670 return '' unless @rights;
671 return $self->access_right(\@rights);
674 =item default_customer_view
676 Returns the default customer view for this user, from the
677 "default_customer_view" user preference, the "cust_main-default_view" config,
678 or the hardcoded default, "basics" (formerly "jumbo" prior to 3.0).
682 sub default_customer_view {
685 $self->option('default_customer_view')
686 || $conf->config('cust_main-default_view')
687 || 'basics'; #s/jumbo/basics/ starting with 3.0
691 =item spreadsheet_format [ OVERRIDE ]
693 Returns a hashref of this user's Excel spreadsheet download settings:
694 'extension' (xls or xlsx), 'class' (Spreadsheet::WriteExcel or
695 Excel::Writer::XLSX), and 'mime_type'. If OVERRIDE is 'XLS' or 'XLSX',
696 use that instead of the user's setting.
700 # is there a better place to put this?
704 class => 'Spreadsheet::WriteExcel',
705 mime_type => 'application/vnd.ms-excel',
708 extension => '.xlsx',
709 class => 'Excel::Writer::XLSX',
710 mime_type => # it's on wikipedia, it must be true
711 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet',
715 sub spreadsheet_format {
717 my $override = shift;
720 || $self->option('spreadsheet_format')
721 || $conf->config('spreadsheet_format')
729 Returns true if this user has the name of a known system account. These
730 users will not appear in the htpasswd file and can't have passwords set.
736 return grep { $_ eq $self->username } ( qw(
749 qsearch( 'sched_item', { 'usernum' => $self->usernum } );
758 return $self->{_locale} if exists($self->{_locale});
759 $self->{_locale} = $self->option('locale');
762 =item get_page_pref PATH, NAME, TABLENUM
764 Returns the user's page preference named NAME for the page at PATH. If the
765 page is a view or edit page or otherwise shows a single record at a time,
766 it should use TABLENUM to tell which record the preference is for.
772 my ($path, $prefname, $tablenum) = @_;
775 my $access_user_page_pref = qsearchs('access_user_page_pref', {
777 usernum => $self->usernum,
778 tablenum => $tablenum,
779 prefname => $prefname,
781 $access_user_page_pref ? $access_user_page_pref->prefvalue : '';
784 =item set_page_pref PATH, NAME, TABLENUM, VALUE
786 Sets the user's page preference named NAME for the page at PATH. Use TABLENUM
787 as for get_page_pref.
793 my ($path, $prefname, $tablenum, $prefvalue) = @_;
797 my $access_user_page_pref = qsearchs('access_user_page_pref', {
799 usernum => $self->usernum,
800 tablenum => $tablenum,
801 prefname => $prefname,
803 if ( $access_user_page_pref ) {
804 if ( $prefvalue eq $access_user_page_pref->get('prefvalue') ) {
807 if ( length($prefvalue) > 0 ) {
808 $access_user_page_pref->set('prefvalue', $prefvalue);
809 $error = $access_user_page_pref->replace;
810 $error .= " (updating $prefname)" if $error;
812 $error = $access_user_page_pref->delete;
813 $error .= " (removing $prefname)" if $error;
816 if ( length($prefvalue) > 0 ) {
817 $access_user_page_pref = FS::access_user_page_pref->new({
819 usernum => $self->usernum,
820 tablenum => $tablenum,
821 prefname => $prefname,
822 prefvalue => $prefvalue,
824 $error = $access_user_page_pref->insert;
825 $error .= " (creating $prefname)" if $error;
838 qsearch('saved_search', { 'usernum' => $self->usernum });
847 L<FS::Record>, schema.html from the base documentation.