fix 'Can't call method "setup" on an undefined value' error when using into rates...

[freeside.git] / FS / FS / access_user.pm

diff --git a/FS/FS/access_user.pm b/FS/FS/access_user.pm
index a755daf..075733a 100644 (file)
--- a/FS/FS/access_user.pm
+++ b/FS/FS/access_user.pm
@@ -1,21 +1,22 @@
 package FS::access_user;
 
 use strict;
 package FS::access_user;
 
 use strict;

-use vars qw( @ISA $htpasswd_file );
+use base qw( FS::m2m_Common FS::option_Common ); 
+use vars qw( $DEBUG $me $conf $htpasswd_file );

 use FS::UID;
 use FS::Conf;
 use FS::Record qw( qsearch qsearchs dbh );
 use FS::UID;
 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;
 use FS::access_usergroup;
 use FS::agent;

+use FS::cust_main;

 
 

-@ISA = qw( FS::m2m_Common FS::option_Common FS::Record );
-#@ISA = qw( FS::m2m_Common FS::option_Common );
+$DEBUG = 0;
+$me = '[FS::access_user]';

 
 #kludge htpasswd for now (i hope this bootstraps okay)
 FS::UID->install_callback( sub {
 
 #kludge htpasswd for now (i hope this bootstraps okay)
 FS::UID->install_callback( sub {

-  my $conf = new FS::Conf;
+  $conf = new FS::Conf;

   $htpasswd_file = $conf->base_dir. '/htpasswd';
 } );
 
   $htpasswd_file = $conf->base_dir. '/htpasswd';
 } );
 


@@ -40,8 +41,8 @@ FS::access_user - Object methods for access_user records
 
 =head1 DESCRIPTION
 
 
 =head1 DESCRIPTION
 

-An FS::access_user object represents an internal access user.  FS::access_user inherits from
-FS::Record.  The following fields are currently supported:
+An FS::access_user object represents an internal access user.  FS::access_user
+inherits from FS::Record.  The following fields are currently supported:

 
 =over 4
 
 
 =over 4
 


@@ -131,9 +132,8 @@ sub insert {
 
 sub htpasswd_kludge {
   my $self = shift;
 
 sub htpasswd_kludge {
   my $self = shift;

-  
-  #awful kludge to skip setting htpasswd for fs_* users
-  return '' if $self->username =~ /^fs_/;
+
+  return '' if $self->is_system_user;

 
   unshift @_, '-c' unless -e $htpasswd_file;
   if ( 
 
   unshift @_, '-c' unless -e $htpasswd_file;
   if ( 


@@ -216,6 +216,9 @@ sub replace {
       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
       return $error;
     }
       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
       return $error;
     }

+  } elsif ( $old->disabled && !$new->disabled
+              && $new->_password =~ /changeme/i ) {
+    return "Must change password when enabling this account";

   }
 
   my $error = $new->SUPER::replace($old, @_);
   }
 
   my $error = $new->SUPER::replace($old, @_);


@@ -250,6 +253,7 @@ sub check {
     || $self->ut_text('_password')
     || $self->ut_text('last')
     || $self->ut_text('first')
     || $self->ut_text('_password')
     || $self->ut_text('last')
     || $self->ut_text('first')

+    || $self->ut_foreign_keyn('user_custnum', 'cust_main', 'custnum')

     || $self->ut_enum('disabled', [ '', 'Y' ] )
   ;
   return $error if $error;
     || $self->ut_enum('disabled', [ '', 'Y' ] )
   ;
   return $error if $error;


@@ -265,11 +269,28 @@ Returns a name string for this user: "Last, First".
 
 sub name {
   my $self = shift;
 
 sub name {
   my $self = shift;

-  $self->get('last'). ', '. $self->first;
+  return $self->username
+    if $self->get('last') eq 'Lastname' && $self->first eq 'Firstname';
+  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 access_usergroup
 
 }
 
 =item access_usergroup
 

+Returns links to the the groups this user is a part of, as FS::access_usergroup
+objects (see L<FS::access_usergroup>).
+

 =cut
 
 sub access_usergroup {
 =cut
 
 sub access_usergroup {


@@ -343,6 +364,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.
 
 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
 =back
 
 =cut


@@ -353,14 +379,22 @@ sub agentnums_sql {
 
   my $agentnum = $opt{'table'} ? $opt{'table'}.'.agentnum' : 'agentnum';
 
 
   my $agentnum = $opt{'table'} ? $opt{'table'}.'.agentnum' : 'agentnum';
 

-  my @agentnums = map { "$agentnum = $_" } $self->agentnums;
+  my @or = ();

 
 

-  push @agentnums, "$agentnum IS NULL"
+  my $viewall_right = $opt{'viewall_right'} || 'View customers of all agents';
+  if ( $self->access_right($viewall_right) ) {
+    push @or, "$agentnum IS NOT NULL";
+  } else {
+    push @or, "$agentnum IN (". join(',', $self->agentnums). ')';
+  }
+
+  push @or, "$agentnum IS NULL"

     if $opt{'null'}
     || ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) );
 
     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 ). ' )';
+

 }
 
 =item agentnum
 }
 
 =item agentnum


@@ -380,10 +414,10 @@ sub agentnum {
   $sth->fetchrow_arrayref->[0];
 }
 
   $sth->fetchrow_arrayref->[0];
 }
 

-=item agents
+=item agents [ HASHREF | OPTION => VALUE ... ]

 
 Returns the list of agents this user can view (via group membership), as
 
 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
 
 
 =cut
 


@@ -392,19 +426,50 @@ sub agents {
   qsearch({
     'table'     => 'agent',
     'hashref'   => { disabled=>'' },
   qsearch({
     'table'     => 'agent',
     'hashref'   => { disabled=>'' },

-    'extra_sql' => ' AND '. $self->agentnums_sql,
+    'extra_sql' => ' AND '. $self->agentnums_sql(@_),

   });
 }
 
   });
 }
 

-=item access_right
+=item access_right RIGHTNAME | LISTREF

 
 

-Given a right name, returns true if this user has this right (currently via
-group membership, eventually also via user overrides).
+Given a right name or a list reference of right names, returns true if this
+user has this right, or, for a list, one of the rights (currently via group
+membership, eventually also via user overrides).

 
 =cut
 
 sub access_right {
   my( $self, $rightname ) = @_;
 
 =cut
 
 sub access_right {
   my( $self, $rightname ) = @_;

+
+  $rightname = [ $rightname ] unless ref($rightname);
+
+  warn "$me access_right called on ". join(', ', @$rightname). "\n"
+    if $DEBUG;
+
+  #some caching of ACL requests for low-hanging fruit perf improvement
+  #since we get a new $CurrentUser object each page view there shouldn't be any
+  #issues with stickiness
+  if ( $self->{_ACLcache} ) {
+
+    unless ( grep !exists($self->{_ACLcache}{$_}), @$rightname ) {
+      warn "$me ACL cache hit for ". join(', ', @$rightname). "\n"
+        if $DEBUG;
+      return grep $self->{_ACLcache}{$_}, @$rightname
+    }
+
+    warn "$me ACL cache miss for ". join(', ', @$rightname). "\n"
+      if $DEBUG;
+
+  } else {
+
+    warn "initializing ACL cache\n"
+      if $DEBUG;
+    $self->{_ACLcache} = {};
+
+  }
+
+  my $has_right = ' rightname IN ('. join(',', map '?', @$rightname ). ') ';
+

   my $sth = dbh->prepare("
     SELECT groupnum FROM access_usergroup
                     LEFT JOIN access_group USING ( groupnum )
   my $sth = dbh->prepare("
     SELECT groupnum FROM access_usergroup
                     LEFT JOIN access_group USING ( groupnum )


@@ -412,11 +477,57 @@ sub access_right {
                          ON ( access_group.groupnum = access_right.rightobjnum )
       WHERE usernum = ?
         AND righttype = 'FS::access_group'
                          ON ( access_group.groupnum = access_right.rightobjnum )
       WHERE usernum = ?
         AND righttype = 'FS::access_group'

-        AND rightname = ?
+        AND $has_right
+      LIMIT 1

   ") or die dbh->errstr;
   ") or die dbh->errstr;

-  $sth->execute($self->usernum, $rightname) or die $sth->errstr;
+  $sth->execute($self->usernum, @$rightname) or die $sth->errstr;

   my $row = $sth->fetchrow_arrayref;
   my $row = $sth->fetchrow_arrayref;

-  $row ? $row->[0] : '';
+
+  my $return = $row ? $row->[0] : '';
+
+  #just caching the single-rightname hits should be enough of a win for now
+  if ( scalar(@$rightname) == 1 ) {
+    $self->{_ACLcache}{${$rightname}[0]} = $return;
+  }
+
+  $return;
+
+}
+
+=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).
+
+=cut
+
+sub default_customer_view {
+  my $self = shift;
+
+  $self->option('default_customer_view')
+    || $conf->config('cust_main-default_view')
+    || 'jumbo'; #'basics' in 1.9.1?
+
+}
+
+=item is_system_user
+
+Returns true if this user has the name of a known system account.  These 
+users will not appear in the htpasswd file 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
+) );

 }
 
 =back
 }
 
 =back