ICRADIUS groups all done! UI and provisioning. closes: Bug#362

fix some bugs in the export and add queue_dangerous_controls option too

5 files changed, 253 insertions, 24 deletions

diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm
index 645dbf1c4..2bc5e24c0 100644
--- a/FS/FS/Conf.pm
+++ b/FS/FS/Conf.pm
@@ -836,6 +836,13 @@ httemplate/docs/config.html
     'type'        => 'checkbox',
   },
 
+  {
+    'key'         => 'queue_dangerous_controls',
+    'section'     => 'UI',
+    'description' => 'Enable queue modification controls on account pages and for new jobs.  Unless you are a developer working on new export code, you should probably leave this off to avoid causing provisioning problems.',
+    'type'        => 'checkbox',
+  },
+
 );
 
 1;
diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm
index 9aedd9f7a..eabcedec1 100644
--- a/FS/FS/part_export.pm
+++ b/FS/FS/part_export.pm
@@ -383,6 +383,22 @@ sub export_delete {
   $self->_export_delete(@_);
 }
 
+#fallbacks providing useful error messages intead of infinite loops
+sub _export_insert {
+  my $self = shift;
+  return "_export_insert: unknown export type ". $self->exporttype;
+}
+
+sub _export_replace {
+  my $self = shift;
+  return "_export_replace: unknown export type ". $self->exporttype;
+}
+
+sub _export_delete {
+  my $self = shift;
+  return "_export_delete: unknown export type ". $self->exporttype;
+}
+
 =back
 
 =cut
@@ -474,10 +490,22 @@ use vars qw(@ISA);
 
 sub _export_insert {
   my($self, $svc_acct) = (shift, shift);
-  $self->sqlradius_queue( $svc_acct->svcnum, 'insert',
-    'reply', $svc_acct->username, $svc_acct->radius_reply );
-  $self->sqlradius_queue( $svc_acct->svcnum, 'insert',
-    'check', $svc_acct->username, $svc_acct->radius_check );
+
+  foreach my $table (qw(reply check)) {
+    my $method = "radius_$table";
+    my %attrib = $svc_acct->$method;
+    next unless keys %attrib;
+    my $error = $self->sqlradius_queue( $svc_acct->svcnum, 'insert',
+      $table, $svc_acct->username, %attrib );
+    return $error if $error;
+  }
+  my @groups = $svc_acct->radius_groups;
+  if ( @groups ) {
+    my $error = $self->sqlradius_queue( $svc_acct->svcnum, 'usergroup_insert',
+      $svc_acct->username, @groups );
+    return $error if $error;
+  }
+  '';
 }
 
 sub _export_replace {
@@ -512,6 +540,30 @@ sub _export_replace {
     }
   }
 
+  # (sorta) false laziness with FS::svc_acct::replace
+  my @oldgroups = @{$old->usergroup}; #uuuh
+  my @newgroups = $new->radius_groups;
+  my @delgroups = ();
+  foreach my $oldgroup ( @oldgroups ) {
+    if ( grep { $oldgroup eq $_ } @newgroups ) {
+      @newgroups = grep { $oldgroup ne $_ } @newgroups;
+      next;
+    }
+    push @delgroups, $oldgroup;
+  }
+
+  if ( @delgroups ) {
+    my $error = $self->sqlradius_queue( $new->svcnum, 'usergroup_delete',
+      $new->username, @delgroups );
+    return $error if $error;
+  }
+
+  if ( @newgroups ) {
+    my $error = $self->sqlradius_queue( $new->svcnum, 'usergroup_insert',
+      $new->username, @newgroups );
+    return $error if $error;
+  }
+
   '';
 }
 
@@ -544,8 +596,8 @@ sub sqlradius_insert { #subroutine, not method
       "UPDATE rad$replycheck SET Value = ? WHERE UserName = ? AND Attribute = ?"    ) or die $dbh->errstr;
     my $i_sth = $dbh->prepare(
       "INSERT INTO rad$replycheck ( id, UserName, Attribute, Value ) ".
-        "VALUES ( ?, ?, ?, ? )" )
-      or die $dbh->errstr;
+        "VALUES ( ?, ?, ?, ? )"
+    ) or die $dbh->errstr;
     $u_sth->execute($attributes{$attribute}, $username, $attribute) > 0
       or $i_sth->execute( '', $username, $attribute, $attributes{$attribute} )
         or die "can't insert into rad$replycheck table: ". $i_sth->errstr;
@@ -553,10 +605,38 @@ sub sqlradius_insert { #subroutine, not method
   $dbh->disconnect;
 }
 
+sub sqlradius_usergroup_insert { #subroutine, not method
+  my $dbh = sqlradius_connect(shift, shift, shift);
+  my( $username, @groups ) = @_;
+
+  my $sth = $dbh->prepare( 
+    "INSERT INTO usergroup ( id, UserName, GroupName ) VALUES ( ?, ?, ? )"
+  ) or die $dbh->errstr;
+  foreach my $group ( @groups ) {
+    $sth->execute( '', $username, $group )
+      or die "can't insert into groupname table: ". $sth->errstr;
+  }
+  $dbh->disconnect;
+}
+
+sub sqlradius_usergroup_delete { #subroutine, not method
+  my $dbh = sqlradius_connect(shift, shift, shift);
+  my( $username, @groups ) = @_;
+
+  my $sth = $dbh->prepare( 
+    "DELETE FROM usergroup ( id, UserName, GroupName ) VALUES ( ?, ?, ? )"
+  ) or die $dbh->errstr;
+  foreach my $group ( @groups ) {
+    $sth->execute( '', $username, $group )
+      or die "can't delete from groupname table: ". $sth->errstr;
+  }
+  $dbh->disconnect;
+}
+
 sub sqlradius_rename { #subroutine, not method
   my $dbh = sqlradius_connect(shift, shift, shift);
   my($new_username, $old_username) = @_;
-  foreach my $table (qw(radreply radcheck)) {
+  foreach my $table (qw(radreply radcheck usergroup )) {
     my $sth = $dbh->prepare("UPDATE $table SET Username = ? WHERE UserName = ?")
       or die $dbh->errstr;
     $sth->execute($new_username, $old_username)
@@ -583,7 +663,7 @@ sub sqlradius_delete { #subroutine, not method
   my $dbh = sqlradius_connect(shift, shift, shift);
   my $username = shift;
 
-  foreach my $table (qw( radcheck radreply )) {
+  foreach my $table (qw( radcheck radreply usergroup )) {
     my $sth = $dbh->prepare( "DELETE FROM $table WHERE UserName = ?" );
     $sth->execute($username)
       or die "can't delete from $table table: ". $sth->errstr;
diff --git a/FS/FS/queue.pm b/FS/FS/queue.pm
index 7a38a6eef..e5369cf82 100644
--- a/FS/FS/queue.pm
+++ b/FS/FS/queue.pm
@@ -1,8 +1,10 @@
 package FS::queue;
 
 use strict;
-use vars qw( @ISA @EXPORT_OK );
+use vars qw( @ISA @EXPORT_OK $conf );
 use Exporter;
+use FS::UID;
+use FS::Conf;
 use FS::Record qw( qsearch qsearchs dbh );
 #use FS::queue;
 use FS::queue_arg;
@@ -11,6 +13,10 @@ use FS::cust_svc;
 @ISA = qw(FS::Record);
 @EXPORT_OK = qw( joblisting );
 
+$FS::UID::callback{'FS::queue'} = sub {
+  $conf = new FS::Conf;
+};
+
 =head1 NAME
 
 FS::queue - Object methods for queue records
@@ -255,7 +261,8 @@ END
     my $date = time2str( "%a %b %e %T %Y", $queue->_date );
     my $status = $queue->status;
     $status .= ': '. $queue->statustext if $queue->statustext;
-    if ( ! $noactions && $status =~ /^failed/ || $status =~ /^locked/ ) {
+    if ( $conf->exists('queue_dangerous_controls')
+         || ( ! $noactions && $status =~ /^failed/ || $status =~ /^locked/ ) ) {
       $status .=
         qq! (&nbsp;<A HREF="$p/misc/queue.cgi?jobnum=$jobnum&action=new">retry</A>&nbsp;|!.
         qq!&nbsp;<A HREF="$p/misc/queue.cgi?jobnum=$jobnum&action=del">remove</A>&nbsp;)!;
@@ -298,7 +305,7 @@ END
 
 =head1 VERSION
 
-$Id: queue.pm,v 1.8 2002-03-23 16:16:00 ivan Exp $
+$Id: queue.pm,v 1.9 2002-03-24 14:29:00 ivan Exp $
 
 =head1 BUGS
 
diff --git a/FS/FS/radius_usergroup.pm b/FS/FS/radius_usergroup.pm
new file mode 100644
index 000000000..647621d28
--- /dev/null
+++ b/FS/FS/radius_usergroup.pm
@@ -0,0 +1,130 @@
+package FS::radius_usergroup;
+
+use strict;
+use vars qw( @ISA );
+use FS::Record qw( qsearch qsearchs );
+use FS::svc_acct;
+
+@ISA = qw(FS::Record);
+
+=head1 NAME
+
+FS::radius_usergroup - Object methods for radius_usergroup records
+
+=head1 SYNOPSIS
+
+  use FS::radius_usergroup;
+
+  $record = new FS::radius_usergroup \%hash;
+  $record = new FS::radius_usergroup { 'column' => 'value' };
+
+  $error = $record->insert;
+
+  $error = $new_record->replace($old_record);
+
+  $error = $record->delete;
+
+  $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::radius_usergroup object links an account (see L<FS::svc_acct>) with a
+RADIUS group.  FS::radius_usergroup inherits from FS::Record.  The following
+fields are currently supported:
+
+=over 4
+
+=item usergroupnum - primary key
+
+=item svcnum - Account (see L<FS::svc_acct>).
+
+=item groupname - group name
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new record.  To add the record 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.
+
+=cut
+
+# the new method can be inherited from FS::Record, if a table method is defined
+
+sub table { 'radius_usergroup'; }
+
+=item insert
+
+Adds this record to the database.  If there is an error, returns the error,
+otherwise returns false.
+
+=cut
+
+#inherited from FS::Record
+
+=item delete
+
+Delete this record from the database.
+
+=cut
+
+#inherited from FS::Record
+
+=item replace OLD_RECORD
+
+Replaces the OLD_RECORD with this one in the database.  If there is an error,
+returns the error, otherwise returns false.
+
+=cut
+
+#inherited from FS::Record
+
+=item check
+
+Checks all fields to make sure this is a valid record.  If there is
+an error, returns the error, otherwise returns false.  Called by the insert
+and replace methods.
+
+=cut
+
+sub check {
+  my $self = shift;
+
+  $self->ut_numbern('usergroupnum')
+    || $self->ut_number('svcnum')
+    || $self->ut_foreign_key('svcnum','svc_acct','svcnum')
+    || $self->ut_text('groupname')
+  ;
+}
+
+=item svc_acct
+
+Returns the account associated with this record (see L<FS::svc_acct>).
+
+=cut
+
+sub svc_acct {
+  my $self = shift;
+  qsearchs('svc_acct', { svcnum => $self->svcnum } );
+}
+
+=back
+
+=head1 BUGS
+
+Don't let 'em get you down.
+
+=head1 SEE ALSO
+
+L<svc_acct>, L<FS::Record>, schema.html from the base documentation.
+
+=cut
+
+1;
+
diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm
index a3e97f74c..197eec1b5 100644
--- a/FS/FS/svc_acct.pm
+++ b/FS/FS/svc_acct.pm
@@ -257,8 +257,6 @@ sub insert {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
-  my $amount = 0;
-
   $error = $self->check;
   return $error if $error;
 
@@ -587,6 +585,8 @@ sub delete {
     }
   }
 
+  my $part_svc = $self->cust_svc->part_svc;
+
   my $error = $self->SUPER::delete;
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
@@ -595,7 +595,7 @@ sub delete {
 
   #new-style exports!
   unless ( $noexport_hack ) {
-    foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
+    foreach my $part_export ( $part_svc->part_export ) {
       my $error = $part_export->export_delete($self);
       if ( $error ) {
         $dbh->rollback if $oldAutoCommit;
@@ -791,34 +791,34 @@ sub replace {
   }
 
   $old->usergroup( [ $old->radius_groups ] );
-
   if ( $new->usergroup ) {
-
-    foreach my $groupname ( @{$old->usergroup} ) {
-      if ( grep { $groupname eq $_ } @{$new->usergroup} ) {
-        $new->usergroup( [ grep { $groupname ne $_ } @{$new->usergroup} ] );
+    #(sorta) false laziness with FS::part_export::sqlradius::_export_replace
+    my @newgroups = @{$new->usergroup};
+    foreach my $oldgroup ( @{$old->usergroup} ) {
+      if ( grep { $oldgroup eq $_ } @newgroups ) {
+        @newgroups = grep { $oldgroup ne $_ } @newgroups;
         next;
       }
       my $radius_usergroup = qsearchs('radius_usergroup', {
         svcnum    => $old->svcnum,
-        groupname => $groupname,
+        groupname => $oldgroup,
       } );
       my $error = $radius_usergroup->delete;
       if ( $error ) {
         $dbh->rollback if $oldAutoCommit;
-        return "error deleting radius_usergroup $groupname: $error";
+        return "error deleting radius_usergroup $oldgroup: $error";
       }
     }
 
-    foreach my $groupname ( @{$new->usergroup} ) {
+    foreach my $newgroup ( @newgroups ) {
       my $radius_usergroup = new FS::radius_usergroup ( {
         svcnum    => $new->svcnum,
-        groupname => $groupname,
+        groupname => $newgroup,
       } );
       my $error = $radius_usergroup->insert;
       if ( $error ) {
         $dbh->rollback if $oldAutoCommit;
-        return "error adding radius_usergroup $groupname: $error";
+        return "error adding radius_usergroup $newgroup: $error";
       }
     }
 
@@ -1072,6 +1072,11 @@ sub check {
   return $x unless ref($x);
   my $part_svc = $x;
 
+  if ( $part_svc->part_svc_column('usergroup')->columnflag eq "F" ) {
+    $self->usergroup(
+      [ split(',', $part_svc->part_svc_column('usergroup')->columnvalue) ] );
+  }
+
   my $error = $self->ut_numbern('svcnum')
               || $self->ut_number('domsvc')
   ;