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->SUPER::delete(@_)
177 || $self->htpasswd_kludge('-D')
181 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
184 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
190 =item replace OLD_RECORD
192 Replaces the OLD_RECORD with this one in the database. If there is an error,
193 returns the error, otherwise returns false.
200 my $old = ( ref($_[0]) eq ref($new) )
204 local $SIG{HUP} = 'IGNORE';
205 local $SIG{INT} = 'IGNORE';
206 local $SIG{QUIT} = 'IGNORE';
207 local $SIG{TERM} = 'IGNORE';
208 local $SIG{TSTP} = 'IGNORE';
209 local $SIG{PIPE} = 'IGNORE';
211 my $oldAutoCommit = $FS::UID::AutoCommit;
212 local $FS::UID::AutoCommit = 0;
215 if ( $new->_password ne $old->_password ) {
216 my $error = $new->htpasswd_kludge();
218 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
221 } elsif ( $old->disabled && !$new->disabled
222 && $new->_password =~ /changeme/i ) {
223 return "Must change password when enabling this account";
226 my $error = $new->SUPER::replace($old, @_);
229 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
232 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
240 Checks all fields to make sure this is a valid internal access user. If there is
241 an error, returns the error, otherwise returns false. Called by the insert
246 # the check method should currently be supplied - FS::Record contains some
247 # data checking routines
253 $self->ut_numbern('usernum')
254 || $self->ut_alpha_lower('username')
255 || $self->ut_text('_password')
256 || $self->ut_text('last')
257 || $self->ut_text('first')
258 || $self->ut_foreign_keyn('user_custnum', 'cust_main', 'custnum')
259 || $self->ut_foreign_keyn('report_salesnum', 'sales', 'salesnum')
260 || $self->ut_enum('disabled', [ '', 'Y' ] )
262 return $error if $error;
269 Returns a name string for this user: "Last, First".
275 return $self->username
276 if $self->get('last') eq 'Lastname' && $self->first eq 'Firstname';
277 return $self->get('last'). ', '. $self->first;
282 Returns the FS::cust_main object (see L<FS::cust_main>), if any, for this
289 qsearchs( 'cust_main', { 'custnum' => $self->user_custnum } );
294 Returns the FS::sales object (see L<FS::sales>), if any, for this
301 qsearchs( 'sales', { 'salesnum' => $self->report_salesnum } );
304 =item access_usergroup
306 Returns links to the the groups this user is a part of, as FS::access_usergroup
307 objects (see L<FS::access_usergroup>).
311 sub access_usergroup {
313 qsearch( 'access_usergroup', { 'usernum' => $self->usernum } );
324 #=item access_groupnames
328 #sub access_groupnames {
334 Returns the number of agents this user can view (via group membership).
341 'SELECT COUNT(DISTINCT agentnum) FROM access_usergroup
342 JOIN access_groupagent USING ( groupnum )
350 Returns a list of agentnums this user can view (via group membership).
356 my $sth = dbh->prepare(
357 "SELECT DISTINCT agentnum FROM access_usergroup
358 JOIN access_groupagent USING ( groupnum )
360 ) or die dbh->errstr;
361 $sth->execute($self->usernum) or die $sth->errstr;
362 map { $_->[0] } @{ $sth->fetchall_arrayref };
367 Returns a hashref of agentnums this user can view.
373 scalar( { map { $_ => 1 } $self->agentnums } );
376 =item agentnums_sql [ HASHREF | OPTION => VALUE ... ]
378 Returns an sql fragement to select only agentnums this user can view.
380 Options are passed as a hashref or a list. Available options are:
386 The frament will also allow the selection of null agentnums.
390 The fragment will also allow the selection of null agentnums if the current
391 user has the provided access right
395 Optional table name in which agentnum is being checked. Sometimes required to
396 resolve 'column reference "agentnum" is ambiguous' errors.
400 All agents will be viewable if the current user has the provided access right.
401 Defaults to 'View customers of all agents'.
409 my %opt = ref($_[0]) ? %{$_[0]} : @_;
411 my $agentnum = $opt{'table'} ? $opt{'table'}.'.agentnum' : 'agentnum';
415 my $viewall_right = $opt{'viewall_right'} || 'View customers of all agents';
416 if ( $self->access_right($viewall_right) ) {
417 push @or, "$agentnum IS NOT NULL";
419 my @agentnums = $self->agentnums;
420 push @or, "$agentnum IN (". join(',', @agentnums). ')'
424 push @or, "$agentnum IS NULL"
426 || ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) );
428 return ' 1 = 0 ' unless scalar(@or);
429 '( '. join( ' OR ', @or ). ' )';
435 Returns true if the user can view the specified agent.
437 Also accepts optional hashref cache, to avoid redundant database calls.
442 my( $self, $agentnum, $cache ) = @_;
444 return $cache->{$self->usernum}->{$agentnum}
445 if $cache->{$self->usernum}->{$agentnum};
446 my $sth = dbh->prepare(
447 "SELECT COUNT(*) FROM access_usergroup
448 JOIN access_groupagent USING ( groupnum )
449 WHERE usernum = ? AND agentnum = ?"
450 ) or die dbh->errstr;
451 $sth->execute($self->usernum, $agentnum) or die $sth->errstr;
452 $cache->{$self->usernum}->{$agentnum} = $sth->fetchrow_arrayref->[0];
454 return $cache->{$self->usernum}->{$agentnum};
457 =item agents [ HASHREF | OPTION => VALUE ... ]
459 Returns the list of agents this user can view (via group membership), as
460 FS::agent objects. Accepts the same options as the agentnums_sql method.
468 'hashref' => { disabled=>'' },
469 'extra_sql' => ' AND '. $self->agentnums_sql(@_),
470 'order_by' => 'ORDER BY agent',
474 =item access_users [ HASHREF | OPTION => VALUE ... ]
476 Returns an array of FS::access_user objects, one for each non-disabled
477 access_user in the system that shares an agent (via group membership) with
478 the invoking object. Regardless of options and agents, will always at
479 least return the invoking user and any users who have viewall_right.
481 Accepts the following options:
487 Only return users who appear in the usernum field of this table
491 Include disabled users if true (defaults to false)
495 All users will be returned if the current user has the provided
496 access right, regardless of agents (other filters still apply.)
497 Defaults to 'View customers of all agents'
501 #Leaving undocumented until such time as this functionality is actually used
505 #Users with no agents will be returned.
509 #Users with no agents will be returned if the current user has the provided
514 my %opt = ref($_[0]) ? %{$_[0]} : @_;
515 my $table = $opt{'table'};
516 my $search = { 'table' => 'access_user' };
517 $search->{'hashref'} = $opt{'disabled'} ? {} : { 'disabled' => '' };
518 $search->{'addl_from'} = "INNER JOIN $table ON (access_user.usernum = $table.usernum)"
520 my @access_users = qsearch($search);
521 my $viewall_right = $opt{'viewall_right'} || 'View customers of all agents';
522 return @access_users if $self->access_right($viewall_right);
523 #filter for users with agents $self can view
525 my $agentnum_cache = {};
527 foreach my $access_user (@access_users) {
528 # you can always view yourself, regardless of agents,
529 # and you can always view someone who can view you,
530 # since they might have affected your customers
531 if ( ($self->usernum eq $access_user->usernum)
532 || $access_user->access_right($viewall_right)
534 push(@out,$access_user);
537 # if user has no agents, you need null or null_right to view
538 my @agents = $access_user->agents('viewall_right'=>'NONE'); #handled viewall_right above
541 ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) )
543 push(@out,$access_user);
547 # otherwise, you need an agent in common
548 foreach my $agent (@agents) {
549 if ($self->agentnum($agent->agentnum,$agentnum_cache)) {
550 push(@out,$access_user);
558 =item access_users_hashref [ HASHREF | OPTION => VALUE ... ]
560 Accepts same options as L</access_users>. Returns a hashref of
561 users, with keys of usernum and values of username.
565 sub access_users_hashref {
567 my %access_users = map { $_->usernum => $_->username }
568 $self->access_users(@_);
569 return \%access_users;
572 =item access_right RIGHTNAME | LISTREF
574 Given a right name or a list reference of right names, returns true if this
575 user has this right, or, for a list, one of the rights (currently via group
576 membership, eventually also via user overrides).
581 my( $self, $rightname ) = @_;
583 $rightname = [ $rightname ] unless ref($rightname);
585 warn "$me access_right called on ". join(', ', @$rightname). "\n"
588 #some caching of ACL requests for low-hanging fruit perf improvement
589 #since we get a new $CurrentUser object each page view there shouldn't be any
590 #issues with stickiness
591 if ( $self->{_ACLcache} ) {
593 unless ( grep !exists($self->{_ACLcache}{$_}), @$rightname ) {
594 warn "$me ACL cache hit for ". join(', ', @$rightname). "\n"
596 return scalar( grep $self->{_ACLcache}{$_}, @$rightname );
599 warn "$me ACL cache miss for ". join(', ', @$rightname). "\n"
604 warn "initializing ACL cache\n"
606 $self->{_ACLcache} = {};
610 my $has_right = ' rightname IN ('. join(',', map '?', @$rightname ). ') ';
612 my $sth = dbh->prepare("
613 SELECT groupnum FROM access_usergroup
614 LEFT JOIN access_group USING ( groupnum )
615 LEFT JOIN access_right
616 ON ( access_group.groupnum = access_right.rightobjnum )
618 AND righttype = 'FS::access_group'
621 ") or die dbh->errstr;
622 $sth->execute($self->usernum, @$rightname) or die $sth->errstr;
623 my $row = $sth->fetchrow_arrayref;
625 my $return = $row ? $row->[0] : '';
627 #just caching the single-rightname hits should be enough of a win for now
628 if ( scalar(@$rightname) == 1 ) {
629 $self->{_ACLcache}{${$rightname}[0]} = $return;
636 =item refund_rights PAYBY
638 Accepts payment $payby (BILL,CASH,MCRD,MCHK,CARD,CHEK) and returns a
639 list of the refund rights associated with that $payby.
641 Returns empty list if $payby wasn't recognized.
649 push @rights, 'Post refund' if $payby =~ /^(BILL|CASH|MCRD|MCHK)$/;
650 push @rights, 'Post check refund' if $payby eq 'BILL';
651 push @rights, 'Post cash refund ' if $payby eq 'CASH';
652 push @rights, 'Refund payment' if $payby =~ /^(CARD|CHEK)$/;
653 push @rights, 'Refund credit card payment' if $payby eq 'CARD';
654 push @rights, 'Refund Echeck payment' if $payby eq 'CHEK';
658 =item refund_access_right PAYBY
660 Returns true if user has L</access_right> for any L</refund_rights>
661 for the specified payby.
665 sub refund_access_right {
668 my @rights = $self->refund_rights($payby);
669 return '' unless @rights;
670 return $self->access_right(\@rights);
673 =item default_customer_view
675 Returns the default customer view for this user, from the
676 "default_customer_view" user preference, the "cust_main-default_view" config,
677 or the hardcoded default, "basics" (formerly "jumbo" prior to 3.0).
681 sub default_customer_view {
684 $self->option('default_customer_view')
685 || $conf->config('cust_main-default_view')
686 || 'basics'; #s/jumbo/basics/ starting with 3.0
690 =item spreadsheet_format [ OVERRIDE ]
692 Returns a hashref of this user's Excel spreadsheet download settings:
693 'extension' (xls or xlsx), 'class' (Spreadsheet::WriteExcel or
694 Excel::Writer::XLSX), and 'mime_type'. If OVERRIDE is 'XLS' or 'XLSX',
695 use that instead of the user's setting.
699 # is there a better place to put this?
703 class => 'Spreadsheet::WriteExcel',
704 mime_type => 'application/vnd.ms-excel',
707 extension => '.xlsx',
708 class => 'Excel::Writer::XLSX',
709 mime_type => # it's on wikipedia, it must be true
710 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet',
714 sub spreadsheet_format {
716 my $override = shift;
719 || $self->option('spreadsheet_format')
720 || $conf->config('spreadsheet_format')
728 Returns true if this user has the name of a known system account. These
729 users will not appear in the htpasswd file and can't have passwords set.
735 return grep { $_ eq $self->username } ( qw(
748 qsearch( 'sched_item', { 'usernum' => $self->usernum } );
757 L<FS::Record>, schema.html from the base documentation.