delete fees, RT#81713
[freeside.git] / FS / FS / access_user.pm
index 8cc8b64..f23aa77 100644 (file)
@@ -1,28 +1,22 @@
 package FS::access_user;
+use base qw( FS::Password_Mixin
+             FS::m2m_Common
+             FS::option_Common ); 
 
 use strict;
-use vars qw( @ISA $DEBUG $me $conf $htpasswd_file );
+use vars qw( $DEBUG $me );
 use FS::UID;
+use FS::Auth;
 use FS::Conf;
 use FS::Record qw( qsearch qsearchs dbh );
-use FS::m2m_Common;
-use FS::option_Common;
-use FS::access_user_pref;
-use FS::access_usergroup;
 use FS::agent;
-
-@ISA = qw( FS::m2m_Common FS::option_Common FS::Record );
-#@ISA = qw( FS::m2m_Common FS::option_Common );
+use FS::cust_main;
+use FS::sales;
+use Carp qw( croak );
 
 $DEBUG = 0;
 $me = '[FS::access_user]';
 
-#kludge htpasswd for now (i hope this bootstraps okay)
-FS::UID->install_callback( sub {
-  $conf = new FS::Conf;
-  $htpasswd_file = $conf->base_dir. '/htpasswd';
-} );
-
 =head1 NAME
 
 FS::access_user - Object methods for access_user records
@@ -49,17 +43,37 @@ inherits from FS::Record.  The following fields are currently supported:
 
 =over 4
 
-=item usernum - primary key
+=item usernum
+
+primary key
+
+=item username
+
+=item _password
+
+=item _password_encoding
+
+Empty or bcrypt
 
-=item username - 
+=item last
 
-=item _password - 
+Last name
 
-=item last -
+=item first
 
-=item first -
+First name
 
-=item disabled - empty or 'Y'
+=item user_custnum
+
+Master customer for this employee (for commissions)
+
+=item report_salesnum
+
+Default sales person for this employee (for reports)
+
+=item disabled
+
+Empty or 'Y'
 
 =back
 
@@ -108,24 +122,19 @@ sub insert {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
-  $error = $self->htpasswd_kludge();
   if ( $error ) {
     $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
     return $error;
   }
 
   $error = $self->SUPER::insert(@_);
+  if ( $self->_password ) {
+    $error ||= $self->insert_password_history;
+  }
 
   if ( $error ) {
     $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
-
-    #make sure it isn't a dup username?  or you could nuke people's passwords
-    #blah.  really just should do our own login w/cookies
-    #and auth out of the db in the first place
-    #my $hterror = $self->htpasswd_kludge('-D');
-    #$error .= " - additionally received error cleaning up htpasswd file: $hterror"
     return $error;
-
   } else {
     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
     '';
@@ -133,27 +142,6 @@ sub insert {
 
 }
 
-sub htpasswd_kludge {
-  my $self = shift;
-  
-  #awful kludge to skip setting htpasswd for fs_* users
-  return '' if $self->username =~ /^fs_/;
-
-  unshift @_, '-c' unless -e $htpasswd_file;
-  if ( 
-       system('htpasswd', '-b', @_,
-                          $htpasswd_file,
-                          $self->username,
-                          $self->_password,
-             ) == 0
-     )
-  {
-    return '';
-  } else {
-    return 'htpasswd exited unsucessfully';
-  }
-}
-
 =item delete
 
 Delete this record from the database.
@@ -174,10 +162,8 @@ sub delete {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
-  my $error =
-       $self->SUPER::delete(@_)
-    || $self->htpasswd_kludge('-D')
-  ;
+  my $error = $self->delete_password_history
+           || $self->SUPER::delete(@_);
 
   if ( $error ) {
     $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
@@ -214,15 +200,16 @@ sub replace {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
-  if ( $new->_password ne $old->_password ) {
-    my $error = $new->htpasswd_kludge();
-    if ( $error ) {
-      $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
-      return $error;
-    }
-  }
+  return "Must change password when enabling this account"
+    if $old->disabled && !$new->disabled
+    && (      $new->_password =~ /changeme/i
+           || $new->_password eq 'notyet'
+       );
 
   my $error = $new->SUPER::replace($old, @_);
+  if ( $old->_password ne $new->_password ) {
+    $error ||= $new->insert_password_history;
+  }
 
   if ( $error ) {
     $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
@@ -251,9 +238,11 @@ sub check {
   my $error = 
     $self->ut_numbern('usernum')
     || $self->ut_alpha_lower('username')
-    || $self->ut_text('_password')
-    || $self->ut_text('last')
-    || $self->ut_text('first')
+    || $self->ut_textn('_password')
+    || $self->ut_textn('last')
+    || $self->ut_textn('first')
+    || $self->ut_foreign_keyn('user_custnum', 'cust_main', 'custnum')
+    || $self->ut_foreign_keyn('report_salesnum', 'sales', 'salesnum')
     || $self->ut_enum('disabled', [ '', 'Y' ] )
   ;
   return $error if $error;
@@ -269,7 +258,34 @@ Returns a name string for this user: "Last, First".
 
 sub name {
   my $self = shift;
-  $self->get('last'). ', '. $self->first;
+  return $self->username
+    if $self->get('last') eq 'Lastname' && $self->first eq 'Firstname'
+    or $self->get('last') eq ''         && $self->first eq '';
+  return $self->get('last'). ', '. $self->first;
+}
+
+=item user_cust_main
+
+Returns the FS::cust_main object (see L<FS::cust_main>), if any, for this
+user.
+
+=cut
+
+sub user_cust_main {
+  my $self = shift;
+  qsearchs( 'cust_main', { 'custnum' => $self->user_custnum } );
+}
+
+=item report_sales
+
+Returns the FS::sales object (see L<FS::sales>), if any, for this
+user.
+
+=cut
+
+sub report_sales {
+  my $self = shift;
+  qsearchs( 'sales', { 'salesnum' => $self->report_salesnum } );
 }
 
 =item access_usergroup
@@ -277,29 +293,22 @@ sub name {
 Returns links to the the groups this user is a part of, as FS::access_usergroup
 objects (see L<FS::access_usergroup>).
 
+=item num_agents
+
+Returns the number of agents this user can view (via group membership).
+
 =cut
 
-sub access_usergroup {
+sub num_agents {
   my $self = shift;
-  qsearch( 'access_usergroup', { 'usernum' => $self->usernum } );
+  $self->scalar_sql(
+    'SELECT COUNT(DISTINCT agentnum) FROM access_usergroup
+                                     JOIN access_groupagent USING ( groupnum )
+       WHERE usernum = ?',
+    $self->usernum,
+  );
 }
 
-#=item access_groups
-#
-#=cut
-#
-#sub access_groups {
-#
-#}
-#
-#=item access_groupnames
-#
-#=cut
-#
-#sub access_groupnames {
-#
-#}
-
 =item agentnums 
 
 Returns a list of agentnums this user can view (via group membership).
@@ -350,6 +359,11 @@ user has the provided access right
 Optional table name in which agentnum is being checked.  Sometimes required to
 resolve 'column reference "agentnum" is ambiguous' errors.
 
+=item viewall_right
+
+All agents will be viewable if the current user has the provided access right.
+Defaults to 'View customers of all agents'.
+
 =back
 
 =cut
@@ -360,16 +374,23 @@ sub agentnums_sql {
 
   my $agentnum = $opt{'table'} ? $opt{'table'}.'.agentnum' : 'agentnum';
 
-#  my @agentnums = map { "$agentnum = $_" } $self->agentnums;
-  my @agentnums = ();
-  push @agentnums, "$agentnum IN (". join(',', $self->agentnums). ')';
+  my @or = ();
+
+  my $viewall_right = $opt{'viewall_right'} || 'View customers of all agents';
+  if ( $self->access_right($viewall_right) ) {
+    push @or, "$agentnum IS NOT NULL";
+  } else {
+    my @agentnums = $self->agentnums;
+    push @or, "$agentnum IN (". join(',', @agentnums). ')'
+      if @agentnums;
+  }
 
-  push @agentnums, "$agentnum IS NULL"
+  push @or, "$agentnum IS NULL"
     if $opt{'null'}
     || ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) );
 
-  return ' 1 = 0 ' unless scalar(@agentnums);
-  '( '. join( ' OR ', @agentnums ). ' )';
+  return ' 1 = 0 ' unless scalar(@or);
+  '( '. join( ' OR ', @or ). ' )';
 
 }
 
@@ -377,23 +398,30 @@ sub agentnums_sql {
 
 Returns true if the user can view the specified agent.
 
+Also accepts optional hashref cache, to avoid redundant database calls.
+
 =cut
 
 sub agentnum {
-  my( $self, $agentnum ) = @_;
+  my( $self, $agentnum, $cache ) = @_;
+  $cache ||= {};
+  return $cache->{$self->usernum}->{$agentnum}
+    if $cache->{$self->usernum}->{$agentnum};
   my $sth = dbh->prepare(
     "SELECT COUNT(*) FROM access_usergroup
                      JOIN access_groupagent USING ( groupnum )
        WHERE usernum = ? AND agentnum = ?"
   ) or die dbh->errstr;
   $sth->execute($self->usernum, $agentnum) or die $sth->errstr;
-  $sth->fetchrow_arrayref->[0];
+  $cache->{$self->usernum}->{$agentnum} = $sth->fetchrow_arrayref->[0];
+  $sth->finish;
+  return $cache->{$self->usernum}->{$agentnum};
 }
 
-=item agents
+=item agents [ HASHREF | OPTION => VALUE ... ]
 
 Returns the list of agents this user can view (via group membership), as
-FS::agent objects.
+FS::agent objects.  Accepts the same options as the agentnums_sql method.
 
 =cut
 
@@ -402,10 +430,109 @@ sub agents {
   qsearch({
     'table'     => 'agent',
     'hashref'   => { disabled=>'' },
-    'extra_sql' => ' AND '. $self->agentnums_sql,
+    'extra_sql' => ' AND '. $self->agentnums_sql(@_),
+    'order_by'  => 'ORDER BY agent',
   });
 }
 
+=item access_users [ HASHREF | OPTION => VALUE ... ]
+
+Returns an array of FS::access_user objects, one for each non-disabled 
+access_user in the system that shares an agent (via group membership) with 
+the invoking object.  Regardless of options and agents, will always at
+least return the invoking user and any users who have viewall_right.
+
+Accepts the following options:
+
+=over 4
+
+=item table
+
+Only return users who appear in the usernum field of this table
+
+=item disabled
+
+Include disabled users if true (defaults to false)
+
+=item viewall_right
+
+All users will be returned if the current user has the provided 
+access right, regardless of agents (other filters still apply.)  
+Defaults to 'View customers of all agents'
+
+=cut
+
+#Leaving undocumented until such time as this functionality is actually used
+#
+#=item null
+#
+#Users with no agents will be returned.
+#
+#=item null_right
+#
+#Users with no agents will be returned if the current user has the provided
+#access right.
+
+sub access_users {
+  my $self = shift;
+  my %opt = ref($_[0]) ? %{$_[0]} : @_;
+  my $table = $opt{'table'};
+  my $search = { 'table' => 'access_user' };
+  $search->{'hashref'} = $opt{'disabled'} ? {} : { 'disabled' => '' };
+  $search->{'addl_from'} = "INNER JOIN $table ON (access_user.usernum = $table.usernum)"
+    if $table;
+  my @access_users = qsearch($search);
+  my $viewall_right = $opt{'viewall_right'} || 'View customers of all agents';
+  return @access_users if $self->access_right($viewall_right);
+  #filter for users with agents $self can view
+  my @out;
+  my $agentnum_cache = {};
+ACCESS_USER:
+  foreach my $access_user (@access_users) {
+    # you can always view yourself, regardless of agents,
+    # and you can always view someone who can view you, 
+    # since they might have affected your customers
+    if ( ($self->usernum eq $access_user->usernum) 
+         || $access_user->access_right($viewall_right)
+    ) {
+      push(@out,$access_user);
+      next;
+    }
+    # if user has no agents, you need null or null_right to view
+    my @agents = $access_user->agents('viewall_right'=>'NONE'); #handled viewall_right above
+    if (!@agents) {
+      if ( $opt{'null'} ||
+           ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) )
+      ) {
+        push(@out,$access_user);
+      }
+      next;
+    }
+    # otherwise, you need an agent in common
+    foreach my $agent (@agents) {
+      if ($self->agentnum($agent->agentnum,$agentnum_cache)) {
+        push(@out,$access_user);
+        next ACCESS_USER;
+      }
+    }
+  }
+  return @out;
+}
+
+=item access_users_hashref  [ HASHREF | OPTION => VALUE ... ]
+
+Accepts same options as L</access_users>.  Returns a hashref of
+users, with keys of usernum and values of username.
+
+=cut
+
+sub access_users_hashref {
+  my $self = shift;
+  my %access_users = map { $_->usernum => $_->username } 
+                       $self->access_users(@_);
+  return \%access_users;
+}
+
 =item access_right RIGHTNAME | LISTREF
 
 Given a right name or a list reference of right names, returns true if this
@@ -430,7 +557,7 @@ sub access_right {
     unless ( grep !exists($self->{_ACLcache}{$_}), @$rightname ) {
       warn "$me ACL cache hit for ". join(', ', @$rightname). "\n"
         if $DEBUG;
-      return grep $self->{_ACLcache}{$_}, @$rightname
+      return scalar( grep $self->{_ACLcache}{$_}, @$rightname );
     }
 
     warn "$me ACL cache miss for ". join(', ', @$rightname). "\n"
@@ -470,11 +597,48 @@ sub access_right {
 
 }
 
+=item refund_rights PAYBY
+
+Accepts payment $payby (BILL,CASH,MCRD,MCHK,CARD,CHEK) and returns a
+list of the refund rights associated with that $payby.
+
+Returns empty list if $payby wasn't recognized.
+
+=cut
+
+sub refund_rights {
+  my $self = shift;
+  my $payby = shift;
+  my @rights = ();
+  push @rights, 'Post refund'                if $payby =~ /^(BILL|CASH|MCRD|MCHK)$/;
+  push @rights, 'Post check refund'          if $payby eq 'BILL';
+  push @rights, 'Post cash refund '          if $payby eq 'CASH';
+  push @rights, 'Refund payment'             if $payby =~ /^(CARD|CHEK)$/;
+  push @rights, 'Refund credit card payment' if $payby eq 'CARD';
+  push @rights, 'Refund Echeck payment'      if $payby eq 'CHEK';
+  return @rights;
+}
+
+=item refund_access_right PAYBY
+
+Returns true if user has L</access_right> for any L</refund_rights>
+for the specified payby.
+
+=cut
+
+sub refund_access_right {
+  my $self = shift;
+  my $payby = shift;
+  my @rights = $self->refund_rights($payby);
+  return '' unless @rights;
+  return $self->access_right(\@rights);
+}
+
 =item default_customer_view
 
 Returns the default customer view for this user, from the 
 "default_customer_view" user preference, the "cust_main-default_view" config,
-or the hardcoded default, "jumbo" (may change to "basics" in the near future).
+or the hardcoded default, "basics" (formerly "jumbo" prior to 3.0).
 
 =cut
 
@@ -482,9 +646,270 @@ sub default_customer_view {
   my $self = shift;
 
   $self->option('default_customer_view')
-    || $conf->config('cust_main-default_view')
-    || 'jumbo'; #'basics' in 1.9.1?
+    || FS::Conf->new->config('cust_main-default_view')
+    || 'basics'; #s/jumbo/basics/ starting with 3.0
+
+}
+
+=item spreadsheet_format [ OVERRIDE ]
+
+Returns a hashref of this user's Excel spreadsheet download settings:
+'extension' (xls or xlsx), 'class' (Spreadsheet::WriteExcel or
+Excel::Writer::XLSX), and 'mime_type'.  If OVERRIDE is 'XLS' or 'XLSX',
+use that instead of the user's setting.
+
+=cut
+
+# is there a better place to put this?
+my %formats = (
+  XLS => {
+    extension => '.xls',
+    class => 'Spreadsheet::WriteExcel',
+    mime_type => 'application/vnd.ms-excel',
+  },
+  XLSX => {
+    extension => '.xlsx',
+    class => 'Excel::Writer::XLSX',
+    mime_type => # it's on wikipedia, it must be true
+      'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet',
+  }
+);
+
+sub spreadsheet_format {
+  my $self = shift;
+  my $override = shift;
+
+  my $f =  $override
+        || $self->option('spreadsheet_format') 
+        || FS::Conf->new->config('spreadsheet_format')
+        || 'XLS';
+
+  $formats{$f};
+}
+
+=item is_system_user
+
+Returns true if this user has the name of a known system account.  These 
+users cannot log into the web interface and can't have passwords set.
+
+=cut
+
+sub is_system_user {
+  my $self = shift;
+  return grep { $_ eq $self->username } ( qw(
+    fs_queue
+    fs_daily
+    fs_selfservice
+    fs_signup
+    fs_bootstrap
+    fs_selfserv
+    fs_api
+  ) );
+}
+
+=item change_password NEW_PASSWORD
+
+Changes the user's password to NEW_PASSWORD. This does not check password
+policy rules (see C<is_password_allowed>) and will return an error only if
+editing the user's record fails for some reason.
+
+If NEW_PASSWORD is the same as the existing password, this does nothing.
+
+=cut
+
+sub change_password {
+  #my( $self, $password ) = @_;
+  #FS::Auth->auth_class->change_password( $self, $password );
+  FS::Auth->auth_class->change_password( @_ );
+}
+
+=item change_password_fields NEW_PASSWORD
+
+=cut
+
+sub change_password_fields {
+  #my( $self, $password ) = @_;
+  #FS::Auth->auth_class->change_password_fields( $self, $password );
+  FS::Auth->auth_class->change_password_fields( @_ );
+}
+
+=item locale
+
+=cut
+
+sub locale {
+  my $self = shift;
+  return $self->{_locale} if exists($self->{_locale});
+  $self->{_locale} = $self->option('locale');
+}
+
+=item get_page_pref PATH, NAME, TABLENUM
+
+Returns the user's page preference named NAME for the page at PATH. If the
+page is a view or edit page or otherwise shows a single record at a time,
+it should use TABLENUM to tell which record the preference is for.
+
+=cut
+
+sub get_page_pref {
+  my $self = shift;
+  my ($path, $prefname, $tablenum) = @_;
+  $tablenum ||= '';
+  
+  my $access_user_page_pref = qsearchs('access_user_page_pref', {
+      path      => $path,
+      usernum   => $self->usernum,
+      tablenum  => $tablenum,
+      prefname  => $prefname,
+  }); 
+  $access_user_page_pref ? $access_user_page_pref->prefvalue : '';
+} 
+
+=item set_page_pref PATH, NAME, TABLENUM, VALUE
+
+Sets the user's page preference named NAME for the page at PATH. Use TABLENUM
+as for get_page_pref.
+
+=cut
+
+sub set_page_pref {
+  my $self = shift;
+  my ($path, $prefname, $tablenum, $prefvalue) = @_;
+  $tablenum ||= '';
+  
+  my $error;
+  my $access_user_page_pref = qsearchs('access_user_page_pref', {
+      path      => $path,
+      usernum   => $self->usernum,
+      tablenum  => $tablenum,
+      prefname  => $prefname,
+  });
+  if ( $access_user_page_pref ) { 
+    if ( $prefvalue eq $access_user_page_pref->get('prefvalue') ) {
+      return '';
+    }
+    if ( length($prefvalue) > 0 ) {
+      $access_user_page_pref->set('prefvalue', $prefvalue);
+      $error = $access_user_page_pref->replace;
+      $error .= " (updating $prefname)" if $error;
+    } else { 
+      $error = $access_user_page_pref->delete;
+      $error .= " (removing $prefname)" if $error;
+    }
+  } else {
+    if ( length($prefvalue) > 0 ) {
+      $access_user_page_pref = FS::access_user_page_pref->new({
+          path      => $path,
+          usernum   => $self->usernum,
+          tablenum  => $tablenum,
+          prefname  => $prefname,
+          prefvalue => $prefvalue,
+      });
+      $error = $access_user_page_pref->insert;
+      $error .= " (creating $prefname)" if $error;
+    } else { 
+      return '';
+    }
+  }
+
+  return $error;
+}
+
+=item get_pref NAME
+
+Fetch the prefvalue column from L<FS::access_user_pref> for prefname NAME
+
+Returns undef when no value has been saved, or when record has expired
+
+=cut
+
+sub get_pref {
+  my ( $self, $prefname ) = @_;
+  croak 'prefname parameter requrired' unless $prefname;
+
+  my $pref_row = $self->get_pref_row( $prefname )
+    or return undef;
+
+  return undef
+    if $pref_row->expiration
+    && $pref_row->expiration < time();
+
+  $pref_row->prefvalue;
+}
+
+=item get_pref_row NAME
+
+Fetch the row object from L<FS::access_user_pref> for prefname NAME
+
+returns undef when no row has been created
+
+=cut
+
+sub get_pref_row {
+  my ( $self, $prefname ) = @_;
+  croak 'prefname parameter required' unless $prefname;
+
+  qsearchs(
+    access_user_pref => {
+      usernum    => $self->usernum,
+      prefname   => $prefname,
+    }
+  );
+}
+
+=item set_pref NAME, VALUE, [EXPIRATION_EPOCH]
+
+Add or update user preference in L<FS::access_user_pref> table
+
+Passing an undefined VALUE will delete the user preference
+
+Returns VALUE
+
+=cut
+
+sub set_pref {
+  my $self = shift;
+  my ( $prefname, $prefvalue, $expiration ) = @_;
+
+  return $self->delete_pref( $prefname )
+    unless defined $prefvalue;
+
+  if ( my $pref_row = $self->get_pref_row( $prefname )) {
+    return $prefvalue
+      if $pref_row->prefvalue eq $prefvalue;
+
+    $pref_row->prefvalue( $prefvalue );
+    $pref_row->expiration( $expiration || '');
+
+    if ( my $error = $pref_row->replace ) { croak $error }
+
+    return $prefvalue;
+  }
+
+  my $pref_row = FS::access_user_pref->new({
+    usernum    => $self->usernum,
+    prefname   => $prefname,
+    prefvalue  => $prefvalue,
+    expiration => $expiration,
+  });
+  if ( my $error = $pref_row->insert ) { croak $error }
+
+  $prefvalue;
+}
+
+=item delete_pref NAME
+
+Delete user preference from L<FS::access_user_pref> table
+
+=cut
+
+sub delete_pref {
+  my ( $self, $prefname ) = @_;
+
+  my $pref_row = $self->get_pref_row( $prefname )
+    or return;
 
+  if ( my $error = $pref_row->delete ) { croak $error }
 }
 
 =back