1 package FS::access_user;
4 use base qw( FS::m2m_Common FS::option_Common );
5 use vars qw( $DEBUG $me $conf );
9 use FS::Record qw( qsearch qsearchs dbh );
10 use FS::access_user_pref;
11 use FS::access_usergroup;
17 $me = '[FS::access_user]';
21 FS::access_user - Object methods for access_user records
27 $record = new FS::access_user \%hash;
28 $record = new FS::access_user { 'column' => 'value' };
30 $error = $record->insert;
32 $error = $new_record->replace($old_record);
34 $error = $record->delete;
36 $error = $record->check;
40 An FS::access_user object represents an internal access user. FS::access_user
41 inherits from FS::Record. The following fields are currently supported:
45 =item usernum - primary key
55 =item disabled - empty or 'Y'
65 Creates a new internal access user. To add the user to the database, see L<"insert">.
67 Note that this stores the hash reference, not a distinct copy of the hash it
68 points to. You can ask the object for a copy with the I<hash> method.
72 # the new method can be inherited from FS::Record, if a table method is defined
74 sub table { 'access_user'; }
76 sub _option_table { 'access_user_pref'; }
77 sub _option_namecol { 'prefname'; }
78 sub _option_valuecol { 'prefvalue'; }
82 Adds this record to the database. If there is an error, returns the error,
83 otherwise returns false.
90 my $error = $self->check;
91 return $error if $error;
93 local $SIG{HUP} = 'IGNORE';
94 local $SIG{INT} = 'IGNORE';
95 local $SIG{QUIT} = 'IGNORE';
96 local $SIG{TERM} = 'IGNORE';
97 local $SIG{TSTP} = 'IGNORE';
98 local $SIG{PIPE} = 'IGNORE';
100 my $oldAutoCommit = $FS::UID::AutoCommit;
101 local $FS::UID::AutoCommit = 0;
105 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
109 $error = $self->SUPER::insert(@_);
112 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
115 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
123 Delete this record from the database.
130 local $SIG{HUP} = 'IGNORE';
131 local $SIG{INT} = 'IGNORE';
132 local $SIG{QUIT} = 'IGNORE';
133 local $SIG{TERM} = 'IGNORE';
134 local $SIG{TSTP} = 'IGNORE';
135 local $SIG{PIPE} = 'IGNORE';
137 my $oldAutoCommit = $FS::UID::AutoCommit;
138 local $FS::UID::AutoCommit = 0;
141 my $error = $self->SUPER::delete(@_);
144 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
147 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
153 =item replace OLD_RECORD
155 Replaces the OLD_RECORD with this one in the database. If there is an error,
156 returns the error, otherwise returns false.
163 my $old = ( ref($_[0]) eq ref($new) )
167 local $SIG{HUP} = 'IGNORE';
168 local $SIG{INT} = 'IGNORE';
169 local $SIG{QUIT} = 'IGNORE';
170 local $SIG{TERM} = 'IGNORE';
171 local $SIG{TSTP} = 'IGNORE';
172 local $SIG{PIPE} = 'IGNORE';
174 my $oldAutoCommit = $FS::UID::AutoCommit;
175 local $FS::UID::AutoCommit = 0;
178 return "Must change password when enabling this account"
179 if $old->disabled && !$new->disabled
180 && ( $new->_password =~ /changeme/i
181 || $new->_password eq 'notyet'
184 my $error = $new->SUPER::replace($old, @_);
187 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
190 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
198 Checks all fields to make sure this is a valid internal access user. If there is
199 an error, returns the error, otherwise returns false. Called by the insert
204 # the check method should currently be supplied - FS::Record contains some
205 # data checking routines
211 $self->ut_numbern('usernum')
212 || $self->ut_alpha_lower('username')
213 || $self->ut_textn('_password')
214 || $self->ut_textn('last')
215 || $self->ut_textn('first')
216 || $self->ut_foreign_keyn('user_custnum', 'cust_main', 'custnum')
217 || $self->ut_foreign_keyn('report_salesnum', 'sales', 'salesnum')
218 || $self->ut_enum('disabled', [ '', 'Y' ] )
220 return $error if $error;
227 Returns a name string for this user: "Last, First".
233 return $self->username
234 if $self->get('last') eq 'Lastname' && $self->first eq 'Firstname'
235 or $self->get('last') eq '' && $self->first eq '';
236 return $self->get('last'). ', '. $self->first;
241 Returns the FS::cust_main object (see L<FS::cust_main>), if any, for this
248 qsearchs( 'cust_main', { 'custnum' => $self->user_custnum } );
253 Returns the FS::sales object (see L<FS::sales>), if any, for this
260 qsearchs( 'sales', { 'salesnum' => $self->report_salesnum } );
263 =item access_usergroup
265 Returns links to the the groups this user is a part of, as FS::access_usergroup
266 objects (see L<FS::access_usergroup>).
270 sub access_usergroup {
272 qsearch( 'access_usergroup', { 'usernum' => $self->usernum } );
283 #=item access_groupnames
287 #sub access_groupnames {
293 Returns a list of agentnums this user can view (via group membership).
299 my $sth = dbh->prepare(
300 "SELECT DISTINCT agentnum FROM access_usergroup
301 JOIN access_groupagent USING ( groupnum )
303 ) or die dbh->errstr;
304 $sth->execute($self->usernum) or die $sth->errstr;
305 map { $_->[0] } @{ $sth->fetchall_arrayref };
310 Returns a hashref of agentnums this user can view.
316 scalar( { map { $_ => 1 } $self->agentnums } );
319 =item agentnums_sql [ HASHREF | OPTION => VALUE ... ]
321 Returns an sql fragement to select only agentnums this user can view.
323 Options are passed as a hashref or a list. Available options are:
329 The frament will also allow the selection of null agentnums.
333 The fragment will also allow the selection of null agentnums if the current
334 user has the provided access right
338 Optional table name in which agentnum is being checked. Sometimes required to
339 resolve 'column reference "agentnum" is ambiguous' errors.
343 All agents will be viewable if the current user has the provided access right.
344 Defaults to 'View customers of all agents'.
352 my %opt = ref($_[0]) ? %{$_[0]} : @_;
354 my $agentnum = $opt{'table'} ? $opt{'table'}.'.agentnum' : 'agentnum';
358 my $viewall_right = $opt{'viewall_right'} || 'View customers of all agents';
359 if ( $self->access_right($viewall_right) ) {
360 push @or, "$agentnum IS NOT NULL";
362 push @or, "$agentnum IN (". join(',', $self->agentnums). ')';
365 push @or, "$agentnum IS NULL"
367 || ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) );
369 return ' 1 = 0 ' unless scalar(@or);
370 '( '. join( ' OR ', @or ). ' )';
376 Returns true if the user can view the specified agent.
381 my( $self, $agentnum ) = @_;
382 my $sth = dbh->prepare(
383 "SELECT COUNT(*) FROM access_usergroup
384 JOIN access_groupagent USING ( groupnum )
385 WHERE usernum = ? AND agentnum = ?"
386 ) or die dbh->errstr;
387 $sth->execute($self->usernum, $agentnum) or die $sth->errstr;
388 $sth->fetchrow_arrayref->[0];
391 =item agents [ HASHREF | OPTION => VALUE ... ]
393 Returns the list of agents this user can view (via group membership), as
394 FS::agent objects. Accepts the same options as the agentnums_sql method.
402 'hashref' => { disabled=>'' },
403 'extra_sql' => ' AND '. $self->agentnums_sql(@_),
407 =item access_right RIGHTNAME | LISTREF
409 Given a right name or a list reference of right names, returns true if this
410 user has this right, or, for a list, one of the rights (currently via group
411 membership, eventually also via user overrides).
416 my( $self, $rightname ) = @_;
418 $rightname = [ $rightname ] unless ref($rightname);
420 warn "$me access_right called on ". join(', ', @$rightname). "\n"
423 #some caching of ACL requests for low-hanging fruit perf improvement
424 #since we get a new $CurrentUser object each page view there shouldn't be any
425 #issues with stickiness
426 if ( $self->{_ACLcache} ) {
428 unless ( grep !exists($self->{_ACLcache}{$_}), @$rightname ) {
429 warn "$me ACL cache hit for ". join(', ', @$rightname). "\n"
431 return grep $self->{_ACLcache}{$_}, @$rightname
434 warn "$me ACL cache miss for ". join(', ', @$rightname). "\n"
439 warn "initializing ACL cache\n"
441 $self->{_ACLcache} = {};
445 my $has_right = ' rightname IN ('. join(',', map '?', @$rightname ). ') ';
447 my $sth = dbh->prepare("
448 SELECT groupnum FROM access_usergroup
449 LEFT JOIN access_group USING ( groupnum )
450 LEFT JOIN access_right
451 ON ( access_group.groupnum = access_right.rightobjnum )
453 AND righttype = 'FS::access_group'
456 ") or die dbh->errstr;
457 $sth->execute($self->usernum, @$rightname) or die $sth->errstr;
458 my $row = $sth->fetchrow_arrayref;
460 my $return = $row ? $row->[0] : '';
462 #just caching the single-rightname hits should be enough of a win for now
463 if ( scalar(@$rightname) == 1 ) {
464 $self->{_ACLcache}{${$rightname}[0]} = $return;
471 =item default_customer_view
473 Returns the default customer view for this user, from the
474 "default_customer_view" user preference, the "cust_main-default_view" config,
475 or the hardcoded default, "basics" (formerly "jumbo" prior to 3.0).
479 sub default_customer_view {
482 $self->option('default_customer_view')
483 || $conf->config('cust_main-default_view')
484 || 'basics'; #s/jumbo/basics/ starting with 3.0
488 =item spreadsheet_format [ OVERRIDE ]
490 Returns a hashref of this user's Excel spreadsheet download settings:
491 'extension' (xls or xlsx), 'class' (Spreadsheet::WriteExcel or
492 Excel::Writer::XLSX), and 'mime_type'. If OVERRIDE is 'XLS' or 'XLSX',
493 use that instead of the user's setting.
497 # is there a better place to put this?
501 class => 'Spreadsheet::WriteExcel',
502 mime_type => 'application/vnd.ms-excel',
505 extension => '.xlsx',
506 class => 'Excel::Writer::XLSX',
507 mime_type => # it's on wikipedia, it must be true
508 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet',
512 sub spreadsheet_format {
514 my $override = shift;
517 || $self->option('spreadsheet_format')
518 || $conf->config('spreadsheet_format')
526 Returns true if this user has the name of a known system account. These
527 users cannot log into the web interface and can't have passwords set.
533 return grep { $_ eq $self->username } ( qw(
543 =item change_password NEW_PASSWORD
547 sub change_password {
548 #my( $self, $password ) = @_;
549 #FS::Auth->auth_class->change_password( $self, $password );
550 FS::Auth->auth_class->change_password( @_ );
553 =item change_password_fields NEW_PASSWORD
557 sub change_password_fields {
558 #my( $self, $password ) = @_;
559 #FS::Auth->auth_class->change_password_fields( $self, $password );
560 FS::Auth->auth_class->change_password_fields( @_ );
569 L<FS::Record>, schema.html from the base documentation.