1 package FS::access_user;
4 use vars qw( @ISA $DEBUG $me $conf $htpasswd_file );
7 use FS::Record qw( qsearch qsearchs dbh );
10 use FS::access_user_pref;
11 use FS::access_usergroup;
14 @ISA = qw( FS::m2m_Common FS::option_Common FS::Record );
15 #@ISA = qw( FS::m2m_Common FS::option_Common );
18 $me = '[FS::access_user]';
20 #kludge htpasswd for now (i hope this bootstraps okay)
21 FS::UID->install_callback( sub {
23 $htpasswd_file = $conf->base_dir. '/htpasswd';
28 FS::access_user - Object methods for access_user records
34 $record = new FS::access_user \%hash;
35 $record = new FS::access_user { 'column' => 'value' };
37 $error = $record->insert;
39 $error = $new_record->replace($old_record);
41 $error = $record->delete;
43 $error = $record->check;
47 An FS::access_user object represents an internal access user. FS::access_user
48 inherits from FS::Record. The following fields are currently supported:
52 =item usernum - primary key
62 =item disabled - empty or 'Y'
72 Creates a new internal access user. To add the user to the database, see L<"insert">.
74 Note that this stores the hash reference, not a distinct copy of the hash it
75 points to. You can ask the object for a copy with the I<hash> method.
79 # the new method can be inherited from FS::Record, if a table method is defined
81 sub table { 'access_user'; }
83 sub _option_table { 'access_user_pref'; }
84 sub _option_namecol { 'prefname'; }
85 sub _option_valuecol { 'prefvalue'; }
89 Adds this record to the database. If there is an error, returns the error,
90 otherwise returns false.
97 my $error = $self->check;
98 return $error if $error;
100 local $SIG{HUP} = 'IGNORE';
101 local $SIG{INT} = 'IGNORE';
102 local $SIG{QUIT} = 'IGNORE';
103 local $SIG{TERM} = 'IGNORE';
104 local $SIG{TSTP} = 'IGNORE';
105 local $SIG{PIPE} = 'IGNORE';
107 my $oldAutoCommit = $FS::UID::AutoCommit;
108 local $FS::UID::AutoCommit = 0;
111 $error = $self->htpasswd_kludge();
113 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
117 $error = $self->SUPER::insert(@_);
120 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
122 #make sure it isn't a dup username? or you could nuke people's passwords
123 #blah. really just should do our own login w/cookies
124 #and auth out of the db in the first place
125 #my $hterror = $self->htpasswd_kludge('-D');
126 #$error .= " - additionally received error cleaning up htpasswd file: $hterror"
130 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
136 sub htpasswd_kludge {
139 #awful kludge to skip setting htpasswd for fs_* users
140 return '' if $self->username =~ /^fs_/;
142 unshift @_, '-c' unless -e $htpasswd_file;
144 system('htpasswd', '-b', @_,
153 return 'htpasswd exited unsucessfully';
159 Delete this record from the database.
166 local $SIG{HUP} = 'IGNORE';
167 local $SIG{INT} = 'IGNORE';
168 local $SIG{QUIT} = 'IGNORE';
169 local $SIG{TERM} = 'IGNORE';
170 local $SIG{TSTP} = 'IGNORE';
171 local $SIG{PIPE} = 'IGNORE';
173 my $oldAutoCommit = $FS::UID::AutoCommit;
174 local $FS::UID::AutoCommit = 0;
178 $self->SUPER::delete(@_)
179 || $self->htpasswd_kludge('-D')
183 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
186 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
192 =item replace OLD_RECORD
194 Replaces the OLD_RECORD with this one in the database. If there is an error,
195 returns the error, otherwise returns false.
202 my $old = ( ref($_[0]) eq ref($new) )
206 local $SIG{HUP} = 'IGNORE';
207 local $SIG{INT} = 'IGNORE';
208 local $SIG{QUIT} = 'IGNORE';
209 local $SIG{TERM} = 'IGNORE';
210 local $SIG{TSTP} = 'IGNORE';
211 local $SIG{PIPE} = 'IGNORE';
213 my $oldAutoCommit = $FS::UID::AutoCommit;
214 local $FS::UID::AutoCommit = 0;
217 if ( $new->_password ne $old->_password ) {
218 my $error = $new->htpasswd_kludge();
220 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
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_enum('disabled', [ '', 'Y' ] )
259 return $error if $error;
266 Returns a name string for this user: "Last, First".
272 $self->get('last'). ', '. $self->first;
275 =item access_usergroup
277 Returns links to the the groups this user is a part of, as FS::access_usergroup
278 objects (see L<FS::access_usergroup>).
282 sub access_usergroup {
284 qsearch( 'access_usergroup', { 'usernum' => $self->usernum } );
295 #=item access_groupnames
299 #sub access_groupnames {
305 Returns a list of agentnums this user can view (via group membership).
311 my $sth = dbh->prepare(
312 "SELECT DISTINCT agentnum FROM access_usergroup
313 JOIN access_groupagent USING ( groupnum )
315 ) or die dbh->errstr;
316 $sth->execute($self->usernum) or die $sth->errstr;
317 map { $_->[0] } @{ $sth->fetchall_arrayref };
322 Returns a hashref of agentnums this user can view.
328 scalar( { map { $_ => 1 } $self->agentnums } );
331 =item agentnums_sql [ HASHREF | OPTION => VALUE ... ]
333 Returns an sql fragement to select only agentnums this user can view.
335 Options are passed as a hashref or a list. Available options are:
341 The frament will also allow the selection of null agentnums.
345 The fragment will also allow the selection of null agentnums if the current
346 user has the provided access right
350 Optional table name in which agentnum is being checked. Sometimes required to
351 resolve 'column reference "agentnum" is ambiguous' errors.
359 my %opt = ref($_[0]) ? %{$_[0]} : @_;
361 my $agentnum = $opt{'table'} ? $opt{'table'}.'.agentnum' : 'agentnum';
363 # my @agentnums = map { "$agentnum = $_" } $self->agentnums;
365 push @agentnums, "$agentnum IN (". join(',', $self->agentnums). ')';
367 push @agentnums, "$agentnum IS NULL"
369 || ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) );
371 return ' 1 = 0 ' unless scalar(@agentnums);
372 '( '. join( ' OR ', @agentnums ). ' )';
378 Returns true if the user can view the specified agent.
383 my( $self, $agentnum ) = @_;
384 my $sth = dbh->prepare(
385 "SELECT COUNT(*) FROM access_usergroup
386 JOIN access_groupagent USING ( groupnum )
387 WHERE usernum = ? AND agentnum = ?"
388 ) or die dbh->errstr;
389 $sth->execute($self->usernum, $agentnum) or die $sth->errstr;
390 $sth->fetchrow_arrayref->[0];
395 Returns the list of agents this user can view (via group membership), as
404 'hashref' => { disabled=>'' },
405 'extra_sql' => ' AND '. $self->agentnums_sql,
409 =item access_right RIGHTNAME | LISTREF
411 Given a right name or a list reference of right names, returns true if this
412 user has this right, or, for a list, one of the rights (currently via group
413 membership, eventually also via user overrides).
418 my( $self, $rightname ) = @_;
420 $rightname = [ $rightname ] unless ref($rightname);
422 warn "$me access_right called on ". join(', ', @$rightname). "\n"
425 #some caching of ACL requests for low-hanging fruit perf improvement
426 #since we get a new $CurrentUser object each page view there shouldn't be any
427 #issues with stickiness
428 if ( $self->{_ACLcache} ) {
430 unless ( grep !exists($self->{_ACLcache}{$_}), @$rightname ) {
431 warn "$me ACL cache hit for ". join(', ', @$rightname). "\n"
433 return grep $self->{_ACLcache}{$_}, @$rightname
436 warn "$me ACL cache miss for ". join(', ', @$rightname). "\n"
441 warn "initializing ACL cache\n"
443 $self->{_ACLcache} = {};
447 my $has_right = ' rightname IN ('. join(',', map '?', @$rightname ). ') ';
449 my $sth = dbh->prepare("
450 SELECT groupnum FROM access_usergroup
451 LEFT JOIN access_group USING ( groupnum )
452 LEFT JOIN access_right
453 ON ( access_group.groupnum = access_right.rightobjnum )
455 AND righttype = 'FS::access_group'
458 ") or die dbh->errstr;
459 $sth->execute($self->usernum, @$rightname) or die $sth->errstr;
460 my $row = $sth->fetchrow_arrayref;
462 my $return = $row ? $row->[0] : '';
464 #just caching the single-rightname hits should be enough of a win for now
465 if ( scalar(@$rightname) == 1 ) {
466 $self->{_ACLcache}{${$rightname}[0]} = $return;
473 =item default_customer_view
475 Returns the default customer view for this user, from the
476 "default_customer_view" user preference, the "cust_main-default_view" config,
477 or the hardcoded default, "jumbo" (may change to "basics" in the near future).
481 sub default_customer_view {
484 $self->option('default_customer_view')
485 || $conf->config('cust_main-default_view')
486 || 'jumbo'; #'basics' in 1.9.1?
496 L<FS::Record>, schema.html from the base documentation.