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;
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 return '' if $self->is_system_user;
141 unshift @_, '-c' unless -e $htpasswd_file;
143 system('htpasswd', '-b', @_,
152 return 'htpasswd exited unsucessfully';
158 Delete this record from the database.
165 local $SIG{HUP} = 'IGNORE';
166 local $SIG{INT} = 'IGNORE';
167 local $SIG{QUIT} = 'IGNORE';
168 local $SIG{TERM} = 'IGNORE';
169 local $SIG{TSTP} = 'IGNORE';
170 local $SIG{PIPE} = 'IGNORE';
172 my $oldAutoCommit = $FS::UID::AutoCommit;
173 local $FS::UID::AutoCommit = 0;
177 $self->delete_password_history
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;
223 } elsif ( $old->disabled && !$new->disabled
224 && $new->_password =~ /changeme/i ) {
225 return "Must change password when enabling this account";
228 my $error = $new->SUPER::replace($old, @_);
231 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
234 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
242 Checks all fields to make sure this is a valid internal access user. If there is
243 an error, returns the error, otherwise returns false. Called by the insert
248 # the check method should currently be supplied - FS::Record contains some
249 # data checking routines
255 $self->ut_numbern('usernum')
256 || $self->ut_alpha_lower('username')
257 || $self->ut_text('_password')
258 || $self->ut_text('last')
259 || $self->ut_text('first')
260 || $self->ut_foreign_keyn('user_custnum', 'cust_main', 'custnum')
261 || $self->ut_foreign_keyn('report_salesnum', 'sales', 'salesnum')
262 || $self->ut_enum('disabled', [ '', 'Y' ] )
264 return $error if $error;
271 Returns a name string for this user: "Last, First".
277 return $self->username
278 if $self->get('last') eq 'Lastname' && $self->first eq 'Firstname';
279 return $self->get('last'). ', '. $self->first;
284 Returns the FS::cust_main object (see L<FS::cust_main>), if any, for this
291 qsearchs( 'cust_main', { 'custnum' => $self->user_custnum } );
296 Returns the FS::sales object (see L<FS::sales>), if any, for this
303 qsearchs( 'sales', { 'salesnum' => $self->report_salesnum } );
306 =item access_usergroup
308 Returns links to the the groups this user is a part of, as FS::access_usergroup
309 objects (see L<FS::access_usergroup>).
313 sub access_usergroup {
315 qsearch( 'access_usergroup', { 'usernum' => $self->usernum } );
326 #=item access_groupnames
330 #sub access_groupnames {
336 Returns the number of agents this user can view (via group membership).
343 'SELECT COUNT(DISTINCT agentnum) FROM access_usergroup
344 JOIN access_groupagent USING ( groupnum )
352 Returns a list of agentnums this user can view (via group membership).
358 my $sth = dbh->prepare(
359 "SELECT DISTINCT agentnum FROM access_usergroup
360 JOIN access_groupagent USING ( groupnum )
362 ) or die dbh->errstr;
363 $sth->execute($self->usernum) or die $sth->errstr;
364 map { $_->[0] } @{ $sth->fetchall_arrayref };
369 Returns a hashref of agentnums this user can view.
375 scalar( { map { $_ => 1 } $self->agentnums } );
378 =item agentnums_sql [ HASHREF | OPTION => VALUE ... ]
380 Returns an sql fragement to select only agentnums this user can view.
382 Options are passed as a hashref or a list. Available options are:
388 The frament will also allow the selection of null agentnums.
392 The fragment will also allow the selection of null agentnums if the current
393 user has the provided access right
397 Optional table name in which agentnum is being checked. Sometimes required to
398 resolve 'column reference "agentnum" is ambiguous' errors.
402 All agents will be viewable if the current user has the provided access right.
403 Defaults to 'View customers of all agents'.
411 my %opt = ref($_[0]) ? %{$_[0]} : @_;
413 my $agentnum = $opt{'table'} ? $opt{'table'}.'.agentnum' : 'agentnum';
417 my $viewall_right = $opt{'viewall_right'} || 'View customers of all agents';
418 if ( $self->access_right($viewall_right) ) {
419 push @or, "$agentnum IS NOT NULL";
421 my @agentnums = $self->agentnums;
422 push @or, "$agentnum IN (". join(',', @agentnums). ')'
426 push @or, "$agentnum IS NULL"
428 || ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) );
430 return ' 1 = 0 ' unless scalar(@or);
431 '( '. join( ' OR ', @or ). ' )';
437 Returns true if the user can view the specified agent.
439 Also accepts optional hashref cache, to avoid redundant database calls.
444 my( $self, $agentnum, $cache ) = @_;
446 return $cache->{$self->usernum}->{$agentnum}
447 if $cache->{$self->usernum}->{$agentnum};
448 my $sth = dbh->prepare(
449 "SELECT COUNT(*) FROM access_usergroup
450 JOIN access_groupagent USING ( groupnum )
451 WHERE usernum = ? AND agentnum = ?"
452 ) or die dbh->errstr;
453 $sth->execute($self->usernum, $agentnum) or die $sth->errstr;
454 $cache->{$self->usernum}->{$agentnum} = $sth->fetchrow_arrayref->[0];
456 return $cache->{$self->usernum}->{$agentnum};
459 =item agents [ HASHREF | OPTION => VALUE ... ]
461 Returns the list of agents this user can view (via group membership), as
462 FS::agent objects. Accepts the same options as the agentnums_sql method.
470 'hashref' => { disabled=>'' },
471 'extra_sql' => ' AND '. $self->agentnums_sql(@_),
472 'order_by' => 'ORDER BY agent',
476 =item access_users [ HASHREF | OPTION => VALUE ... ]
478 Returns an array of FS::access_user objects, one for each non-disabled
479 access_user in the system that shares an agent (via group membership) with
480 the invoking object. Regardless of options and agents, will always at
481 least return the invoking user and any users who have viewall_right.
483 Accepts the following options:
489 Only return users who appear in the usernum field of this table
493 Include disabled users if true (defaults to false)
497 All users will be returned if the current user has the provided
498 access right, regardless of agents (other filters still apply.)
499 Defaults to 'View customers of all agents'
503 #Leaving undocumented until such time as this functionality is actually used
507 #Users with no agents will be returned.
511 #Users with no agents will be returned if the current user has the provided
516 my %opt = ref($_[0]) ? %{$_[0]} : @_;
517 my $table = $opt{'table'};
518 my $search = { 'table' => 'access_user' };
519 $search->{'hashref'} = $opt{'disabled'} ? {} : { 'disabled' => '' };
520 $search->{'addl_from'} = "INNER JOIN $table ON (access_user.usernum = $table.usernum)"
522 my @access_users = qsearch($search);
523 my $viewall_right = $opt{'viewall_right'} || 'View customers of all agents';
524 return @access_users if $self->access_right($viewall_right);
525 #filter for users with agents $self can view
527 my $agentnum_cache = {};
529 foreach my $access_user (@access_users) {
530 # you can always view yourself, regardless of agents,
531 # and you can always view someone who can view you,
532 # since they might have affected your customers
533 if ( ($self->usernum eq $access_user->usernum)
534 || $access_user->access_right($viewall_right)
536 push(@out,$access_user);
539 # if user has no agents, you need null or null_right to view
540 my @agents = $access_user->agents('viewall_right'=>'NONE'); #handled viewall_right above
543 ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) )
545 push(@out,$access_user);
549 # otherwise, you need an agent in common
550 foreach my $agent (@agents) {
551 if ($self->agentnum($agent->agentnum,$agentnum_cache)) {
552 push(@out,$access_user);
560 =item access_users_hashref [ HASHREF | OPTION => VALUE ... ]
562 Accepts same options as L</access_users>. Returns a hashref of
563 users, with keys of usernum and values of username.
567 sub access_users_hashref {
569 my %access_users = map { $_->usernum => $_->username }
570 $self->access_users(@_);
571 return \%access_users;
574 =item access_right RIGHTNAME | LISTREF
576 Given a right name or a list reference of right names, returns true if this
577 user has this right, or, for a list, one of the rights (currently via group
578 membership, eventually also via user overrides).
583 my( $self, $rightname ) = @_;
585 $rightname = [ $rightname ] unless ref($rightname);
587 warn "$me access_right called on ". join(', ', @$rightname). "\n"
590 #some caching of ACL requests for low-hanging fruit perf improvement
591 #since we get a new $CurrentUser object each page view there shouldn't be any
592 #issues with stickiness
593 if ( $self->{_ACLcache} ) {
595 unless ( grep !exists($self->{_ACLcache}{$_}), @$rightname ) {
596 warn "$me ACL cache hit for ". join(', ', @$rightname). "\n"
598 return scalar( grep $self->{_ACLcache}{$_}, @$rightname );
601 warn "$me ACL cache miss for ". join(', ', @$rightname). "\n"
606 warn "initializing ACL cache\n"
608 $self->{_ACLcache} = {};
612 my $has_right = ' rightname IN ('. join(',', map '?', @$rightname ). ') ';
614 my $sth = dbh->prepare("
615 SELECT groupnum FROM access_usergroup
616 LEFT JOIN access_group USING ( groupnum )
617 LEFT JOIN access_right
618 ON ( access_group.groupnum = access_right.rightobjnum )
620 AND righttype = 'FS::access_group'
623 ") or die dbh->errstr;
624 $sth->execute($self->usernum, @$rightname) or die $sth->errstr;
625 my $row = $sth->fetchrow_arrayref;
627 my $return = $row ? $row->[0] : '';
629 #just caching the single-rightname hits should be enough of a win for now
630 if ( scalar(@$rightname) == 1 ) {
631 $self->{_ACLcache}{${$rightname}[0]} = $return;
638 =item refund_rights PAYBY
640 Accepts payment $payby (BILL,CASH,MCRD,MCHK,CARD,CHEK) and returns a
641 list of the refund rights associated with that $payby.
643 Returns empty list if $payby wasn't recognized.
651 push @rights, 'Post refund' if $payby =~ /^(BILL|CASH|MCRD|MCHK)$/;
652 push @rights, 'Post check refund' if $payby eq 'BILL';
653 push @rights, 'Post cash refund ' if $payby eq 'CASH';
654 push @rights, 'Refund payment' if $payby =~ /^(CARD|CHEK)$/;
655 push @rights, 'Refund credit card payment' if $payby eq 'CARD';
656 push @rights, 'Refund Echeck payment' if $payby eq 'CHEK';
660 =item refund_access_right PAYBY
662 Returns true if user has L</access_right> for any L</refund_rights>
663 for the specified payby.
667 sub refund_access_right {
670 my @rights = $self->refund_rights($payby);
671 return '' unless @rights;
672 return $self->access_right(\@rights);
675 =item default_customer_view
677 Returns the default customer view for this user, from the
678 "default_customer_view" user preference, the "cust_main-default_view" config,
679 or the hardcoded default, "basics" (formerly "jumbo" prior to 3.0).
683 sub default_customer_view {
686 $self->option('default_customer_view')
687 || $conf->config('cust_main-default_view')
688 || 'basics'; #s/jumbo/basics/ starting with 3.0
692 =item spreadsheet_format [ OVERRIDE ]
694 Returns a hashref of this user's Excel spreadsheet download settings:
695 'extension' (xls or xlsx), 'class' (Spreadsheet::WriteExcel or
696 Excel::Writer::XLSX), and 'mime_type'. If OVERRIDE is 'XLS' or 'XLSX',
697 use that instead of the user's setting.
701 # is there a better place to put this?
705 class => 'Spreadsheet::WriteExcel',
706 mime_type => 'application/vnd.ms-excel',
709 extension => '.xlsx',
710 class => 'Excel::Writer::XLSX',
711 mime_type => # it's on wikipedia, it must be true
712 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet',
716 sub spreadsheet_format {
718 my $override = shift;
721 || $self->option('spreadsheet_format')
722 || $conf->config('spreadsheet_format')
730 Returns true if this user has the name of a known system account. These
731 users will not appear in the htpasswd file and can't have passwords set.
737 return grep { $_ eq $self->username } ( qw(
750 qsearch( 'sched_item', { 'usernum' => $self->usernum } );
759 return $self->{_locale} if exists($self->{_locale});
760 $self->{_locale} = $self->option('locale');
763 =item get_page_pref PATH, NAME, TABLENUM
765 Returns the user's page preference named NAME for the page at PATH. If the
766 page is a view or edit page or otherwise shows a single record at a time,
767 it should use TABLENUM to tell which record the preference is for.
773 my ($path, $prefname, $tablenum) = @_;
776 my $access_user_page_pref = qsearchs('access_user_page_pref', {
778 usernum => $self->usernum,
779 tablenum => $tablenum,
780 prefname => $prefname,
782 $access_user_page_pref ? $access_user_page_pref->prefvalue : '';
785 =item set_page_pref PATH, NAME, TABLENUM, VALUE
787 Sets the user's page preference named NAME for the page at PATH. Use TABLENUM
788 as for get_page_pref.
794 my ($path, $prefname, $tablenum, $prefvalue) = @_;
798 my $access_user_page_pref = qsearchs('access_user_page_pref', {
800 usernum => $self->usernum,
801 tablenum => $tablenum,
802 prefname => $prefname,
804 if ( $access_user_page_pref ) {
805 if ( $prefvalue eq $access_user_page_pref->get('prefvalue') ) {
808 if ( length($prefvalue) > 0 ) {
809 $access_user_page_pref->set('prefvalue', $prefvalue);
810 $error = $access_user_page_pref->replace;
811 $error .= " (updating $prefname)" if $error;
813 $error = $access_user_page_pref->delete;
814 $error .= " (removing $prefname)" if $error;
817 if ( length($prefvalue) > 0 ) {
818 $access_user_page_pref = FS::access_user_page_pref->new({
820 usernum => $self->usernum,
821 tablenum => $tablenum,
822 prefname => $prefname,
823 prefvalue => $prefvalue,
825 $error = $access_user_page_pref->insert;
826 $error .= " (creating $prefname)" if $error;
839 qsearch('saved_search', { 'usernum' => $self->usernum });
844 Fetch the prefvalue column from L<FS::access_user_pref> for prefname NAME
846 Returns undef when no value has been saved, or when record has expired
851 my ( $self, $prefname ) = @_;
852 croak 'prefname parameter requrired' unless $prefname;
854 my $pref_row = $self->get_pref_row( $prefname )
858 if $pref_row->expiration
859 && $pref_row->expiration < time();
861 $pref_row->prefvalue;
864 =item get_pref_row NAME
866 Fetch the row object from L<FS::access_user_pref> for prefname NAME
868 returns undef when no row has been created
873 my ( $self, $prefname ) = @_;
874 croak 'prefname parameter required' unless $prefname;
877 access_user_pref => {
878 usernum => $self->usernum,
879 prefname => $prefname,
884 =item set_pref NAME, VALUE, [EXPIRATION_EPOCH]
886 Add or update user preference in L<FS::access_user_pref> table
888 Passing an undefined VALUE will delete the user preference
896 my ( $prefname, $prefvalue, $expiration ) = @_;
898 return $self->delete_pref( $prefname )
899 unless defined $prefvalue;
901 if ( my $pref_row = $self->get_pref_row( $prefname )) {
903 if $pref_row->prefvalue eq $prefvalue;
905 $pref_row->prefvalue( $prefvalue );
906 $pref_row->expiration( $expiration || '');
908 if ( my $error = $pref_row->replace ) { croak $error }
913 my $pref_row = FS::access_user_pref->new({
914 usernum => $self->usernum,
915 prefname => $prefname,
916 prefvalue => $prefvalue,
917 expiration => $expiration,
919 if ( my $error = $pref_row->insert ) { croak $error }
924 =item delete_pref NAME
926 Delete user preference from L<FS::access_user_pref> table
931 my ( $self, $prefname ) = @_;
933 my $pref_row = $self->get_pref_row( $prefname )
936 if ( my $error = $pref_row->delete ) { croak $error }
945 L<FS::Record>, schema.html from the base documentation.