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 Optional column name in which agentnum is being checked.
404 e.g: column => 'COALESCE ( cust_main.agentnum, prospect_main.agentnum )'
408 All agents will be viewable if the current user has the provided access right.
409 Defaults to 'View customers of all agents'.
417 my %opt = ref($_[0]) ? %{$_[0]} : @_;
420 if ( $opt{column} ) {
421 $agentnum = $opt{column};
422 } elsif ( $opt{table} ) {
423 $agentnum = "$opt{table}.agentnum"
425 $agentnum = 'agentnum';
430 my $viewall_right = $opt{'viewall_right'} || 'View customers of all agents';
431 if ( $self->access_right($viewall_right) ) {
432 push @or, "$agentnum IS NOT NULL";
434 my @agentnums = $self->agentnums;
435 push @or, "$agentnum IN (". join(',', @agentnums). ')'
439 push @or, "$agentnum IS NULL"
441 || ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) );
443 return ' 1 = 0 ' unless scalar(@or);
444 '( '. join( ' OR ', @or ). ' )';
450 Returns true if the user can view the specified agent.
452 Also accepts optional hashref cache, to avoid redundant database calls.
457 my( $self, $agentnum, $cache ) = @_;
459 return $cache->{$self->usernum}->{$agentnum}
460 if $cache->{$self->usernum}->{$agentnum};
461 my $sth = dbh->prepare(
462 "SELECT COUNT(*) FROM access_usergroup
463 JOIN access_groupagent USING ( groupnum )
464 WHERE usernum = ? AND agentnum = ?"
465 ) or die dbh->errstr;
466 $sth->execute($self->usernum, $agentnum) or die $sth->errstr;
467 $cache->{$self->usernum}->{$agentnum} = $sth->fetchrow_arrayref->[0];
469 return $cache->{$self->usernum}->{$agentnum};
472 =item agents [ HASHREF | OPTION => VALUE ... ]
474 Returns the list of agents this user can view (via group membership), as
475 FS::agent objects. Accepts the same options as the agentnums_sql method.
483 'hashref' => { disabled=>'' },
484 'extra_sql' => ' AND '. $self->agentnums_sql(@_),
485 'order_by' => 'ORDER BY agent',
489 =item access_users [ HASHREF | OPTION => VALUE ... ]
491 Returns an array of FS::access_user objects, one for each non-disabled
492 access_user in the system that shares an agent (via group membership) with
493 the invoking object. Regardless of options and agents, will always at
494 least return the invoking user and any users who have viewall_right.
496 Accepts the following options:
502 Only return users who appear in the usernum field of this table
506 Include disabled users if true (defaults to false)
510 All users will be returned if the current user has the provided
511 access right, regardless of agents (other filters still apply.)
512 Defaults to 'View customers of all agents'
516 #Leaving undocumented until such time as this functionality is actually used
520 #Users with no agents will be returned.
524 #Users with no agents will be returned if the current user has the provided
529 my %opt = ref($_[0]) ? %{$_[0]} : @_;
530 my $table = $opt{'table'};
531 my $search = { 'table' => 'access_user' };
532 $search->{'hashref'} = $opt{'disabled'} ? {} : { 'disabled' => '' };
533 $search->{'addl_from'} = "INNER JOIN $table ON (access_user.usernum = $table.usernum)"
535 my @access_users = qsearch($search);
536 my $viewall_right = $opt{'viewall_right'} || 'View customers of all agents';
537 return @access_users if $self->access_right($viewall_right);
538 #filter for users with agents $self can view
540 my $agentnum_cache = {};
542 foreach my $access_user (@access_users) {
543 # you can always view yourself, regardless of agents,
544 # and you can always view someone who can view you,
545 # since they might have affected your customers
546 if ( ($self->usernum eq $access_user->usernum)
547 || $access_user->access_right($viewall_right)
549 push(@out,$access_user);
552 # if user has no agents, you need null or null_right to view
553 my @agents = $access_user->agents('viewall_right'=>'NONE'); #handled viewall_right above
556 ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) )
558 push(@out,$access_user);
562 # otherwise, you need an agent in common
563 foreach my $agent (@agents) {
564 if ($self->agentnum($agent->agentnum,$agentnum_cache)) {
565 push(@out,$access_user);
573 =item access_users_hashref [ HASHREF | OPTION => VALUE ... ]
575 Accepts same options as L</access_users>. Returns a hashref of
576 users, with keys of usernum and values of username.
580 sub access_users_hashref {
582 my %access_users = map { $_->usernum => $_->username }
583 $self->access_users(@_);
584 return \%access_users;
587 =item access_right RIGHTNAME | LISTREF
589 Given a right name or a list reference of right names, returns true if this
590 user has this right, or, for a list, one of the rights (currently via group
591 membership, eventually also via user overrides).
596 my( $self, $rightname ) = @_;
598 $rightname = [ $rightname ] unless ref($rightname);
600 warn "$me access_right called on ". join(', ', @$rightname). "\n"
603 #some caching of ACL requests for low-hanging fruit perf improvement
604 #since we get a new $CurrentUser object each page view there shouldn't be any
605 #issues with stickiness
606 if ( $self->{_ACLcache} ) {
608 unless ( grep !exists($self->{_ACLcache}{$_}), @$rightname ) {
609 warn "$me ACL cache hit for ". join(', ', @$rightname). "\n"
611 return scalar( grep $self->{_ACLcache}{$_}, @$rightname );
614 warn "$me ACL cache miss for ". join(', ', @$rightname). "\n"
619 warn "initializing ACL cache\n"
621 $self->{_ACLcache} = {};
625 my $has_right = ' rightname IN ('. join(',', map '?', @$rightname ). ') ';
627 my $sth = dbh->prepare("
628 SELECT groupnum FROM access_usergroup
629 LEFT JOIN access_group USING ( groupnum )
630 LEFT JOIN access_right
631 ON ( access_group.groupnum = access_right.rightobjnum )
633 AND righttype = 'FS::access_group'
636 ") or die dbh->errstr;
637 $sth->execute($self->usernum, @$rightname) or die $sth->errstr;
638 my $row = $sth->fetchrow_arrayref;
640 my $return = $row ? $row->[0] : '';
642 #just caching the single-rightname hits should be enough of a win for now
643 if ( scalar(@$rightname) == 1 ) {
644 $self->{_ACLcache}{${$rightname}[0]} = $return;
651 =item refund_rights PAYBY
653 Accepts payment $payby (BILL,CASH,MCRD,MCHK,CARD,CHEK) and returns a
654 list of the refund rights associated with that $payby.
656 Returns empty list if $payby wasn't recognized.
664 push @rights, 'Post refund' if $payby =~ /^(BILL|CASH|MCRD|MCHK)$/;
665 push @rights, 'Post check refund' if $payby eq 'BILL';
666 push @rights, 'Post cash refund ' if $payby eq 'CASH';
667 push @rights, 'Refund payment' if $payby =~ /^(CARD|CHEK)$/;
668 push @rights, 'Refund credit card payment' if $payby eq 'CARD';
669 push @rights, 'Refund Echeck payment' if $payby eq 'CHEK';
673 =item refund_access_right PAYBY
675 Returns true if user has L</access_right> for any L</refund_rights>
676 for the specified payby.
680 sub refund_access_right {
683 my @rights = $self->refund_rights($payby);
684 return '' unless @rights;
685 return $self->access_right(\@rights);
688 =item default_customer_view
690 Returns the default customer view for this user, from the
691 "default_customer_view" user preference, the "cust_main-default_view" config,
692 or the hardcoded default, "basics" (formerly "jumbo" prior to 3.0).
696 sub default_customer_view {
699 $self->option('default_customer_view')
700 || $conf->config('cust_main-default_view')
701 || 'basics'; #s/jumbo/basics/ starting with 3.0
705 =item spreadsheet_format [ OVERRIDE ]
707 Returns a hashref of this user's Excel spreadsheet download settings:
708 'extension' (xls or xlsx), 'class' (Spreadsheet::WriteExcel or
709 Excel::Writer::XLSX), and 'mime_type'. If OVERRIDE is 'XLS' or 'XLSX',
710 use that instead of the user's setting.
714 # is there a better place to put this?
718 class => 'Spreadsheet::WriteExcel',
719 mime_type => 'application/vnd.ms-excel',
722 extension => '.xlsx',
723 class => 'Excel::Writer::XLSX',
724 mime_type => # it's on wikipedia, it must be true
725 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet',
729 sub spreadsheet_format {
731 my $override = shift;
734 || $self->option('spreadsheet_format')
735 || $conf->config('spreadsheet_format')
743 Returns true if this user has the name of a known system account. These
744 users will not appear in the htpasswd file and can't have passwords set.
750 return grep { $_ eq $self->username } ( qw(
763 qsearch( 'sched_item', { 'usernum' => $self->usernum } );
772 return $self->{_locale} if exists($self->{_locale});
773 $self->{_locale} = $self->option('locale');
776 =item get_page_pref PATH, NAME, TABLENUM
778 Returns the user's page preference named NAME for the page at PATH. If the
779 page is a view or edit page or otherwise shows a single record at a time,
780 it should use TABLENUM to tell which record the preference is for.
786 my ($path, $prefname, $tablenum) = @_;
789 my $access_user_page_pref = qsearchs('access_user_page_pref', {
791 usernum => $self->usernum,
792 tablenum => $tablenum,
793 prefname => $prefname,
795 $access_user_page_pref ? $access_user_page_pref->prefvalue : '';
798 =item set_page_pref PATH, NAME, TABLENUM, VALUE
800 Sets the user's page preference named NAME for the page at PATH. Use TABLENUM
801 as for get_page_pref.
807 my ($path, $prefname, $tablenum, $prefvalue) = @_;
811 my $access_user_page_pref = qsearchs('access_user_page_pref', {
813 usernum => $self->usernum,
814 tablenum => $tablenum,
815 prefname => $prefname,
817 if ( $access_user_page_pref ) {
818 if ( $prefvalue eq $access_user_page_pref->get('prefvalue') ) {
821 if ( length($prefvalue) > 0 ) {
822 $access_user_page_pref->set('prefvalue', $prefvalue);
823 $error = $access_user_page_pref->replace;
824 $error .= " (updating $prefname)" if $error;
826 $error = $access_user_page_pref->delete;
827 $error .= " (removing $prefname)" if $error;
830 if ( length($prefvalue) > 0 ) {
831 $access_user_page_pref = FS::access_user_page_pref->new({
833 usernum => $self->usernum,
834 tablenum => $tablenum,
835 prefname => $prefname,
836 prefvalue => $prefvalue,
838 $error = $access_user_page_pref->insert;
839 $error .= " (creating $prefname)" if $error;
852 qsearch('saved_search', { 'usernum' => $self->usernum });
857 Fetch the prefvalue column from L<FS::access_user_pref> for prefname NAME
859 Returns undef when no value has been saved, or when record has expired
864 my ( $self, $prefname ) = @_;
865 croak 'prefname parameter requrired' unless $prefname;
867 my $pref_row = $self->get_pref_row( $prefname )
871 if $pref_row->expiration
872 && $pref_row->expiration < time();
874 $pref_row->prefvalue;
877 =item get_pref_row NAME
879 Fetch the row object from L<FS::access_user_pref> for prefname NAME
881 returns undef when no row has been created
886 my ( $self, $prefname ) = @_;
887 croak 'prefname parameter required' unless $prefname;
890 access_user_pref => {
891 usernum => $self->usernum,
892 prefname => $prefname,
897 =item set_pref NAME, VALUE, [EXPIRATION_EPOCH]
899 Add or update user preference in L<FS::access_user_pref> table
901 Passing an undefined VALUE will delete the user preference
909 my ( $prefname, $prefvalue, $expiration ) = @_;
911 return $self->delete_pref( $prefname )
912 unless defined $prefvalue;
914 if ( my $pref_row = $self->get_pref_row( $prefname )) {
916 if $pref_row->prefvalue eq $prefvalue;
918 $pref_row->prefvalue( $prefvalue );
919 $pref_row->expiration( $expiration || '');
921 if ( my $error = $pref_row->replace ) { croak $error }
926 my $pref_row = FS::access_user_pref->new({
927 usernum => $self->usernum,
928 prefname => $prefname,
929 prefvalue => $prefvalue,
930 expiration => $expiration,
932 if ( my $error = $pref_row->insert ) { croak $error }
937 =item delete_pref NAME
939 Delete user preference from L<FS::access_user_pref> table
944 my ( $self, $prefname ) = @_;
946 my $pref_row = $self->get_pref_row( $prefname )
949 if ( my $error = $pref_row->delete ) { croak $error }
958 L<FS::Record>, schema.html from the base documentation.