virtualize referrals on customer addition
[freeside.git] / FS / FS / access_user.pm
index ca311d3..830d7f8 100644 (file)
@@ -1,13 +1,17 @@
 package FS::access_user;
 
 use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs );
+use vars qw( @ISA $htpasswd_file );
+use FS::Record qw( qsearch qsearchs dbh );
 use FS::m2m_Common;
 use FS::access_usergroup;
+use FS::agent;
 
 @ISA = qw( FS::m2m_Common FS::Record );
 
+#kludge htpasswd for now
+$htpasswd_file = '/usr/local/etc/freeside/htpasswd';
+
 =head1 NAME
 
 FS::access_user - Object methods for access_user records
@@ -29,7 +33,7 @@ FS::access_user - Object methods for access_user records
 
 =head1 DESCRIPTION
 
-An FS::access_user object represents an example.  FS::access_user inherits from
+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
@@ -44,6 +48,8 @@ FS::Record.  The following fields are currently supported:
 
 =item first -
 
+=item disabled - empty or 'Y'
+
 =back
 
 =head1 METHODS
@@ -52,7 +58,7 @@ FS::Record.  The following fields are currently supported:
 
 =item new HASHREF
 
-Creates a new example.  To add the example to the database, see L<"insert">.
+Creates a new internal access user.  To add the user to the database, see L<"insert">.
 
 Note that this stores the hash reference, not a distinct copy of the hash it
 points to.  You can ask the object for a copy with the I<hash> method.
@@ -70,7 +76,56 @@ otherwise returns false.
 
 =cut
 
-# the insert method can be inherited from FS::Record
+sub insert {
+  my $self = shift;
+
+  local $SIG{HUP} = 'IGNORE';
+  local $SIG{INT} = 'IGNORE';
+  local $SIG{QUIT} = 'IGNORE';
+  local $SIG{TERM} = 'IGNORE';
+  local $SIG{TSTP} = 'IGNORE';
+  local $SIG{PIPE} = 'IGNORE';
+
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
+  my $error =
+       $self->SUPER::insert(@_)
+    || $self->htpasswd_kludge()
+  ;
+
+  if ( $error ) {
+    $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
+    return $error;
+  } else {
+    $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+    '';
+  }
+
+}
+
+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
 
@@ -78,7 +133,34 @@ Delete this record from the database.
 
 =cut
 
-# the delete method can be inherited from FS::Record
+sub delete {
+  my $self = shift;
+
+  local $SIG{HUP} = 'IGNORE';
+  local $SIG{INT} = 'IGNORE';
+  local $SIG{QUIT} = 'IGNORE';
+  local $SIG{TERM} = 'IGNORE';
+  local $SIG{TSTP} = 'IGNORE';
+  local $SIG{PIPE} = 'IGNORE';
+
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
+  my $error =
+       $self->SUPER::delete(@_)
+    || $self->htpasswd_kludge('-D')
+  ;
+
+  if ( $error ) {
+    $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
+    return $error;
+  } else {
+    $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+    '';
+  }
+
+}
 
 =item replace OLD_RECORD
 
@@ -87,11 +169,38 @@ returns the error, otherwise returns false.
 
 =cut
 
-# the replace method can be inherited from FS::Record
+sub replace {
+  my($new, $old) = ( shift, shift );
+
+  local $SIG{HUP} = 'IGNORE';
+  local $SIG{INT} = 'IGNORE';
+  local $SIG{QUIT} = 'IGNORE';
+  local $SIG{TERM} = 'IGNORE';
+  local $SIG{TSTP} = 'IGNORE';
+  local $SIG{PIPE} = 'IGNORE';
+
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
+  my $error =
+       $new->SUPER::replace($old, @_)
+    || $new->htpasswd_kludge()
+  ;
+
+  if ( $error ) {
+    $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
+    return $error;
+  } else {
+    $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+    '';
+  }
+
+}
 
 =item check
 
-Checks all fields to make sure this is a valid example.  If there is
+Checks all fields to make sure this is a valid internal access user.  If there is
 an error, returns the error, otherwise returns false.  Called by the insert
 and replace methods.
 
@@ -109,6 +218,7 @@ sub check {
     || $self->ut_text('_password')
     || $self->ut_text('last')
     || $self->ut_text('first')
+    || $self->ut_enum('disabled', [ '', 'Y' ] )
   ;
   return $error if $error;
 
@@ -151,12 +261,107 @@ sub access_usergroup {
 #
 #}
 
+=item agentnums 
+
+Returns a list of agentnums this user can view (via group membership).
+
+=cut
+
+sub agentnums {
+  my $self = shift;
+  my $sth = dbh->prepare(
+    "SELECT DISTINCT agentnum FROM access_usergroup
+                              JOIN access_groupagent USING ( groupnum )
+       WHERE usernum = ?"
+  ) or die dbh->errstr;
+  $sth->execute($self->usernum) or die $sth->errstr;
+  map { $_->[0] } @{ $sth->fetchall_arrayref };
+}
+
+=item agentnums_href
+
+Returns a hashref of agentnums this user can view.
+
+=cut
+
+sub agentnums_href {
+  my $self = shift;
+  { map { $_ => 1 } $self->agentnums };
+}
+
+=item agentnums_sql
+
+Returns an sql fragement to select only agentnums this user can view.
+
+=cut
+
+sub agentnums_sql {
+  my $self = shift;
+  '( '.
+    join( ' OR ', map "agentnum = $_", $self->agentnums ).
+  ' )';
+}
+
+=item agentnum
+
+Returns true if the user can view the specified agent.
+
+=cut
+
+sub agentnum {
+  my( $self, $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];
+}
+
+=item agents
+
+Returns the list of agents this user can view (via group membership), as
+FS::agent objects.
+
+=cut
+
+sub agents {
+  my $self = shift;
+  qsearch({
+    'table'     => 'agent',
+    'hashref'   => { disabled=>'' },
+    'extra_sql' => ' AND '. $self->agentnums_sql,
+  });
+}
+
+=item access_right
+
+Given a right name, returns true if this user has this right (currently via
+group membership, eventually also via user overrides).
+
+=cut
+
+sub access_right {
+  my( $self, $rightname ) = @_;
+  my $sth = dbh->prepare("
+    SELECT groupnum FROM access_usergroup
+                    LEFT JOIN access_group USING ( groupnum )
+                    LEFT JOIN access_right
+                         ON ( access_group.groupnum = access_right.rightobjnum )
+      WHERE usernum = ?
+        AND righttype = 'FS::access_group'
+        AND rightname = ?
+  ") or die dbh->errstr;
+  $sth->execute($self->usernum, $rightname) or die $sth->errstr;
+  my $row = $sth->fetchrow_arrayref;
+  $row ? $row->[0] : '';
+}
+
 =back
 
 =head1 BUGS
 
-The author forgot to customize this manpage.
-
 =head1 SEE ALSO
 
 L<FS::Record>, schema.html from the base documentation.