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;
16 $me = '[FS::access_user]';
18 #kludge htpasswd for now (i hope this bootstraps okay)
19 FS::UID->install_callback( sub {
21 $htpasswd_file = $conf->base_dir. '/htpasswd';
26 FS::access_user - Object methods for access_user records
32 $record = new FS::access_user \%hash;
33 $record = new FS::access_user { 'column' => 'value' };
35 $error = $record->insert;
37 $error = $new_record->replace($old_record);
39 $error = $record->delete;
41 $error = $record->check;
45 An FS::access_user object represents an internal access user. FS::access_user
46 inherits from FS::Record. The following fields are currently supported:
50 =item usernum - primary key
60 =item disabled - empty or 'Y'
70 Creates a new internal access user. To add the user to the database, see L<"insert">.
72 Note that this stores the hash reference, not a distinct copy of the hash it
73 points to. You can ask the object for a copy with the I<hash> method.
77 # the new method can be inherited from FS::Record, if a table method is defined
79 sub table { 'access_user'; }
81 sub _option_table { 'access_user_pref'; }
82 sub _option_namecol { 'prefname'; }
83 sub _option_valuecol { 'prefvalue'; }
87 Adds this record to the database. If there is an error, returns the error,
88 otherwise returns false.
95 my $error = $self->check;
96 return $error if $error;
98 local $SIG{HUP} = 'IGNORE';
99 local $SIG{INT} = 'IGNORE';
100 local $SIG{QUIT} = 'IGNORE';
101 local $SIG{TERM} = 'IGNORE';
102 local $SIG{TSTP} = 'IGNORE';
103 local $SIG{PIPE} = 'IGNORE';
105 my $oldAutoCommit = $FS::UID::AutoCommit;
106 local $FS::UID::AutoCommit = 0;
109 $error = $self->htpasswd_kludge();
111 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
115 $error = $self->SUPER::insert(@_);
118 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
120 #make sure it isn't a dup username? or you could nuke people's passwords
121 #blah. really just should do our own login w/cookies
122 #and auth out of the db in the first place
123 #my $hterror = $self->htpasswd_kludge('-D');
124 #$error .= " - additionally received error cleaning up htpasswd file: $hterror"
128 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
134 sub htpasswd_kludge {
137 return '' if $self->is_system_user;
139 unshift @_, '-c' unless -e $htpasswd_file;
141 system('htpasswd', '-b', @_,
150 return 'htpasswd exited unsucessfully';
156 Delete this record from the database.
163 local $SIG{HUP} = 'IGNORE';
164 local $SIG{INT} = 'IGNORE';
165 local $SIG{QUIT} = 'IGNORE';
166 local $SIG{TERM} = 'IGNORE';
167 local $SIG{TSTP} = 'IGNORE';
168 local $SIG{PIPE} = 'IGNORE';
170 my $oldAutoCommit = $FS::UID::AutoCommit;
171 local $FS::UID::AutoCommit = 0;
175 $self->SUPER::delete(@_)
176 || $self->htpasswd_kludge('-D')
180 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
183 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
189 =item replace OLD_RECORD
191 Replaces the OLD_RECORD with this one in the database. If there is an error,
192 returns the error, otherwise returns false.
199 my $old = ( ref($_[0]) eq ref($new) )
203 local $SIG{HUP} = 'IGNORE';
204 local $SIG{INT} = 'IGNORE';
205 local $SIG{QUIT} = 'IGNORE';
206 local $SIG{TERM} = 'IGNORE';
207 local $SIG{TSTP} = 'IGNORE';
208 local $SIG{PIPE} = 'IGNORE';
210 my $oldAutoCommit = $FS::UID::AutoCommit;
211 local $FS::UID::AutoCommit = 0;
214 if ( $new->_password ne $old->_password ) {
215 my $error = $new->htpasswd_kludge();
217 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
220 } elsif ( $old->disabled && !$new->disabled
221 && $new->_password =~ /changeme/i ) {
222 return "Must change password when enabling this account";
225 my $error = $new->SUPER::replace($old, @_);
228 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
231 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
239 Checks all fields to make sure this is a valid internal access user. If there is
240 an error, returns the error, otherwise returns false. Called by the insert
245 # the check method should currently be supplied - FS::Record contains some
246 # data checking routines
252 $self->ut_numbern('usernum')
253 || $self->ut_alpha_lower('username')
254 || $self->ut_text('_password')
255 || $self->ut_text('last')
256 || $self->ut_text('first')
257 || $self->ut_foreign_keyn('user_custnum', 'cust_main', 'custnum')
258 || $self->ut_foreign_keyn('report_salesnum', 'sales', 'salesnum')
259 || $self->ut_enum('disabled', [ '', 'Y' ] )
261 return $error if $error;
268 Returns a name string for this user: "Last, First".
274 return $self->username
275 if $self->get('last') eq 'Lastname' && $self->first eq 'Firstname';
276 return $self->get('last'). ', '. $self->first;
281 Returns the FS::cust_main object (see L<FS::cust_main>), if any, for this
288 qsearchs( 'cust_main', { 'custnum' => $self->user_custnum } );
293 Returns the FS::sales object (see L<FS::sales>), if any, for this
300 qsearchs( 'sales', { 'salesnum' => $self->report_salesnum } );
303 =item access_usergroup
305 Returns links to the the groups this user is a part of, as FS::access_usergroup
306 objects (see L<FS::access_usergroup>).
310 sub access_usergroup {
312 qsearch( 'access_usergroup', { 'usernum' => $self->usernum } );
323 #=item access_groupnames
327 #sub access_groupnames {
333 Returns a list of agentnums this user can view (via group membership).
339 my $sth = dbh->prepare(
340 "SELECT DISTINCT agentnum FROM access_usergroup
341 JOIN access_groupagent USING ( groupnum )
343 ) or die dbh->errstr;
344 $sth->execute($self->usernum) or die $sth->errstr;
345 map { $_->[0] } @{ $sth->fetchall_arrayref };
350 Returns a hashref of agentnums this user can view.
356 scalar( { map { $_ => 1 } $self->agentnums } );
359 =item agentnums_sql [ HASHREF | OPTION => VALUE ... ]
361 Returns an sql fragement to select only agentnums this user can view.
363 Options are passed as a hashref or a list. Available options are:
369 The frament will also allow the selection of null agentnums.
373 The fragment will also allow the selection of null agentnums if the current
374 user has the provided access right
378 Optional table name in which agentnum is being checked. Sometimes required to
379 resolve 'column reference "agentnum" is ambiguous' errors.
383 All agents will be viewable if the current user has the provided access right.
384 Defaults to 'View customers of all agents'.
392 my %opt = ref($_[0]) ? %{$_[0]} : @_;
394 my $agentnum = $opt{'table'} ? $opt{'table'}.'.agentnum' : 'agentnum';
398 my $viewall_right = $opt{'viewall_right'} || 'View customers of all agents';
399 if ( $self->access_right($viewall_right) ) {
400 push @or, "$agentnum IS NOT NULL";
402 push @or, "$agentnum IN (". join(',', $self->agentnums). ')';
405 push @or, "$agentnum IS NULL"
407 || ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) );
409 return ' 1 = 0 ' unless scalar(@or);
410 '( '. join( ' OR ', @or ). ' )';
416 Returns true if the user can view the specified agent.
421 my( $self, $agentnum ) = @_;
422 my $sth = dbh->prepare(
423 "SELECT COUNT(*) FROM access_usergroup
424 JOIN access_groupagent USING ( groupnum )
425 WHERE usernum = ? AND agentnum = ?"
426 ) or die dbh->errstr;
427 $sth->execute($self->usernum, $agentnum) or die $sth->errstr;
428 $sth->fetchrow_arrayref->[0];
431 =item agents [ HASHREF | OPTION => VALUE ... ]
433 Returns the list of agents this user can view (via group membership), as
434 FS::agent objects. Accepts the same options as the agentnums_sql method.
442 'hashref' => { disabled=>'' },
443 'extra_sql' => ' AND '. $self->agentnums_sql(@_),
444 'order_by' => 'ORDER BY agent',
448 =item access_right RIGHTNAME | LISTREF
450 Given a right name or a list reference of right names, returns true if this
451 user has this right, or, for a list, one of the rights (currently via group
452 membership, eventually also via user overrides).
457 my( $self, $rightname ) = @_;
459 $rightname = [ $rightname ] unless ref($rightname);
461 warn "$me access_right called on ". join(', ', @$rightname). "\n"
464 #some caching of ACL requests for low-hanging fruit perf improvement
465 #since we get a new $CurrentUser object each page view there shouldn't be any
466 #issues with stickiness
467 if ( $self->{_ACLcache} ) {
469 unless ( grep !exists($self->{_ACLcache}{$_}), @$rightname ) {
470 warn "$me ACL cache hit for ". join(', ', @$rightname). "\n"
472 return grep $self->{_ACLcache}{$_}, @$rightname
475 warn "$me ACL cache miss for ". join(', ', @$rightname). "\n"
480 warn "initializing ACL cache\n"
482 $self->{_ACLcache} = {};
486 my $has_right = ' rightname IN ('. join(',', map '?', @$rightname ). ') ';
488 my $sth = dbh->prepare("
489 SELECT groupnum FROM access_usergroup
490 LEFT JOIN access_group USING ( groupnum )
491 LEFT JOIN access_right
492 ON ( access_group.groupnum = access_right.rightobjnum )
494 AND righttype = 'FS::access_group'
497 ") or die dbh->errstr;
498 $sth->execute($self->usernum, @$rightname) or die $sth->errstr;
499 my $row = $sth->fetchrow_arrayref;
501 my $return = $row ? $row->[0] : '';
503 #just caching the single-rightname hits should be enough of a win for now
504 if ( scalar(@$rightname) == 1 ) {
505 $self->{_ACLcache}{${$rightname}[0]} = $return;
512 =item default_customer_view
514 Returns the default customer view for this user, from the
515 "default_customer_view" user preference, the "cust_main-default_view" config,
516 or the hardcoded default, "basics" (formerly "jumbo" prior to 3.0).
520 sub default_customer_view {
523 $self->option('default_customer_view')
524 || $conf->config('cust_main-default_view')
525 || 'basics'; #s/jumbo/basics/ starting with 3.0
529 =item spreadsheet_format [ OVERRIDE ]
531 Returns a hashref of this user's Excel spreadsheet download settings:
532 'extension' (xls or xlsx), 'class' (Spreadsheet::WriteExcel or
533 Excel::Writer::XLSX), and 'mime_type'. If OVERRIDE is 'XLS' or 'XLSX',
534 use that instead of the user's setting.
538 # is there a better place to put this?
542 class => 'Spreadsheet::WriteExcel',
543 mime_type => 'application/vnd.ms-excel',
546 extension => '.xlsx',
547 class => 'Excel::Writer::XLSX',
548 mime_type => # it's on wikipedia, it must be true
549 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet',
553 sub spreadsheet_format {
555 my $override = shift;
558 || $self->option('spreadsheet_format')
559 || $conf->config('spreadsheet_format')
567 Returns true if this user has the name of a known system account. These
568 users will not appear in the htpasswd file and can't have passwords set.
574 return grep { $_ eq $self->username } ( qw(
590 L<FS::Record>, schema.html from the base documentation.