re-write RADIUS groups, RT13274

10 files changed, 223 insertions, 74 deletions

diff --git a/FS/FS.pm b/FS/FS.pm
index c8c58bd4e..2f9892049 100644
--- a/FS/FS.pm
+++ b/FS/FS.pm
@@ -124,7 +124,9 @@ L<FS::acct_snarf> - External mail account class
 
 L<FS::acct_rt_transaction> - Time worked application to account class
 
-L<FS::radius_usergroup> - RADIUS groups
+L<FS::radius_usergroup> - RADIUS user group membership
+
+L<FS::radius_group> - RADIUS groups
 
 L<FS::svc_domain> - Domain class
 
diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm
index b29df75d3..934004e4a 100644
--- a/FS/FS/Mason.pm
+++ b/FS/FS/Mason.pm
@@ -288,6 +288,7 @@ if ( -e $addl_handler_use_file ) {
   use FS::msa;
   use FS::rate_center;
   use FS::cust_msg;
+  use FS::radius_group;
   # Sammath Naur
 
   if ( $FS::Mason::addl_handler_use ) {
diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm
index 9dc5dc6f8..978a9bff6 100644
--- a/FS/FS/Schema.pm
+++ b/FS/FS/Schema.pm
@@ -2329,12 +2329,24 @@ sub tables_hashref {
       'columns' => [
         'usergroupnum', 'serial', '', '', '', '', 
         'svcnum',       'int', '', '', '', '', 
-        'groupname',    'varchar', '', $char_d, '', '', 
+        'groupname',    'varchar', 'NULL', $char_d, '', '', 
+        'groupnum',     'int', 'NULL', '', '', '', 
       ],
       'primary_key' => 'usergroupnum',
       'unique'      => [],
       'index'       => [ [ 'svcnum' ], [ 'groupname' ] ],
     },
+    
+    'radius_group' => {
+      'columns' => [
+        'groupnum', 'serial', '', '', '', '', 
+        'groupname',    'varchar', '', $char_d, '', '', 
+        'description',  'varchar', 'NULL', $char_d, '', '', 
+      ],
+      'primary_key' => 'groupnum',
+      'unique'      => [ ['groupname'] ],
+      'index'       => [],
+    },
 
     'msgcat' => {
       'columns' => [
diff --git a/FS/FS/Upgrade.pm b/FS/FS/Upgrade.pm
index 9b973c4cb..787ee24bb 100644
--- a/FS/FS/Upgrade.pm
+++ b/FS/FS/Upgrade.pm
@@ -191,6 +191,9 @@ sub upgrade_data {
     #insert MSA data if not already present
     'msa' => [],
 
+    # migrate to radius_group and groupnum instead of groupname
+    'radius_usergroup' => [],
+
   ;
 
   \%hash;
diff --git a/FS/FS/part_svc.pm b/FS/FS/part_svc.pm
index e15b22590..ddc0a7969 100644
--- a/FS/FS/part_svc.pm
+++ b/FS/FS/part_svc.pm
@@ -672,7 +672,8 @@ the following keys:
 
 =item def_label - Optional description of the field in the context of service definitions
 
-=item type - Currently "text", "select", "disabled", or "radius_usergroup_selector"
+=item type - Currently "text", "select", "checkbox", "textarea", "disabled", 
+some components specified by "select-.*.html", and a bunch more...
 
 =item disable_default - This field should not allow a default value in service definitions
 
diff --git a/FS/FS/radius_group.pm b/FS/FS/radius_group.pm
new file mode 100644
index 000000000..96de2948a
--- /dev/null
+++ b/FS/FS/radius_group.pm
@@ -0,0 +1,129 @@
+package FS::radius_group;
+
+use strict;
+use base qw( FS::Record );
+use FS::Record qw( qsearch qsearchs );
+
+=head1 NAME
+
+FS::radius_group - Object methods for radius_group records
+
+=head1 SYNOPSIS
+
+  use FS::radius_group;
+
+  $record = new FS::radius_group \%hash;
+  $record = new FS::radius_group { 'column' => 'value' };
+
+  $error = $record->insert;
+
+  $error = $new_record->replace($old_record);
+
+  $error = $record->delete;
+
+  $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::radius_group object represents a RADIUS group.  FS::radius_group inherits from
+FS::Record.  The following fields are currently supported:
+
+=over 4
+
+=item groupnum
+
+primary key
+
+=item groupname
+
+groupname
+
+=item description
+
+description
+
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new RADIUS group.  To add the RADIUS group 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_group'; }
+
+=item insert
+
+Adds this record to the database.  If there is an error, returns the error,
+otherwise returns false.
+
+=cut
+
+# the insert method can be inherited from FS::Record
+
+=item delete
+
+Delete this record from the database.
+
+=cut
+
+# the delete method can be 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
+
+# the replace method can be inherited from FS::Record
+
+=item check
+
+Checks all fields to make sure this is a valid RADIUS group.  If there is
+an error, returns the error, otherwise returns false.  Called by the insert
+and replace methods.
+
+=cut
+
+# the check method should currently be supplied - FS::Record contains some
+# data checking routines
+
+sub check {
+  my $self = shift;
+
+  my $error = 
+    $self->ut_numbern('groupnum')
+    || $self->ut_text('groupname')
+    || $self->ut_textn('description')
+  ;
+  return $error if $error;
+
+  $self->SUPER::check;
+}
+
+=back
+
+=head1 BUGS
+
+This isn't export-specific (i.e. groups are globally unique, as opposed to being
+unique per-export).
+
+=head1 SEE ALSO
+
+L<FS::radius_usergroup>, L<FS::Record>, schema.html from the base documentation.
+
+=cut
+
+1;
+
diff --git a/FS/FS/radius_usergroup.pm b/FS/FS/radius_usergroup.pm
index 9bba057c9..2de142397 100644
--- a/FS/FS/radius_usergroup.pm
+++ b/FS/FS/radius_usergroup.pm
@@ -4,6 +4,7 @@ use strict;
 use vars qw( @ISA );
 use FS::Record qw( qsearch qsearchs );
 use FS::svc_acct;
+use FS::radius_group;
 
 @ISA = qw(FS::Record);
 
@@ -29,8 +30,8 @@ FS::radius_usergroup - Object methods for radius_usergroup records
 =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:
+RADIUS group (see L<FS::radius_group>).  FS::radius_usergroup inherits from
+FS::Record.  The following fields are currently supported:
 
 =over 4
 
@@ -38,7 +39,7 @@ fields are currently supported:
 
 =item svcnum - Account (see L<FS::svc_acct>).
 
-=item groupname - group name
+=item groupnum - RADIUS group (see L<FS::radius_group>).
 
 =back
 
@@ -96,10 +97,11 @@ and replace methods.
 sub check {
   my $self = shift;
 
+  die "radius_usergroup.groupname is deprecated" if $self->groupname;
+
   $self->ut_numbern('usergroupnum')
-    || $self->ut_number('svcnum')
     || $self->ut_foreign_key('svcnum','svc_acct','svcnum')
-    || $self->ut_text('groupname')
+    || $self->ut_foreign_key('groupnum','radius_group','groupnum')
     || $self->SUPER::check
   ;
 }
@@ -115,15 +117,49 @@ sub svc_acct {
   qsearchs('svc_acct', { svcnum => $self->svcnum } );
 }
 
-=back
+=item radius_group
+
+Returns the RADIUS group associated with this record (see L<FS::radius_group>).
+
+=cut
 
-=head1 BUGS
+sub radius_group {
+  my $self = shift;
+  qsearchs('radius_group', { 'groupnum'  => $self->groupnum } );
+}
 
-Don't let 'em get you down.
+sub _upgrade_data {  #class method
+  my ($class, %opts) = @_;
+
+  my %group_cache = map { $_->groupname => $_->groupnum } 
+                                                qsearch('radius_group', {});
+
+  my @radius_usergroup = qsearch('radius_usergroup', {} );
+  my $error = '';
+  foreach my $rug ( @radius_usergroup ) {
+        my $groupname = $rug->groupname;
+        next unless $groupname;
+        unless(defined($group_cache{$groupname})) {
+            my $g = new FS::radius_group {
+                            'groupname' => $groupname,
+                            'description' => $groupname,
+                            };
+            $error = $g->insert;
+            die $error if $error;
+            $group_cache{$groupname} = $g->groupnum;
+        }
+        $rug->groupnum($group_cache{$groupname});
+        $rug->groupname('');
+        $error = $rug->replace;
+        die $error if $error;
+  }
+}
+
+=back
 
 =head1 SEE ALSO
 
-L<svc_acct>, L<FS::Record>, schema.html from the base documentation.
+L<svc_acct>, L<FS::radius_group>, L<FS::Record>, schema.html from the base documentation.
 
 =cut
 
diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm
index f12eca174..1c4b574e9 100644
--- a/FS/FS/svc_acct.pm
+++ b/FS/FS/svc_acct.pm
@@ -43,6 +43,7 @@ use FS::svc_pbx;
 use FS::raddb;
 use FS::queue;
 use FS::radius_usergroup;
+use FS::radius_group;
 use FS::export_svc;
 use FS::part_export;
 use FS::svc_forward;
@@ -335,7 +336,7 @@ sub table_info {
                        },
         'usergroup' => {
                          label => 'RADIUS groups',
-                         type  => 'radius_usergroup_selector',
+                         type  => 'select-radius_group.html',
                          disable_inventory => 1,
                          disable_select => 1,
                        },
@@ -709,10 +710,10 @@ sub insert {
   }
 
   if ( $self->usergroup ) {
-    foreach my $groupname ( @{$self->usergroup} ) {
+    foreach my $groupnum ( @{$self->usergroup} ) {
       my $radius_usergroup = new FS::radius_usergroup ( {
         svcnum    => $self->svcnum,
-        groupname => $groupname,
+        groupnum  => $groupnum,
       } );
       my $error = $radius_usergroup->insert;
       if ( $error ) {
@@ -1010,10 +1011,10 @@ sub replace {
   $error = $new->check;
   return $error if $error;
 
-  $old->usergroup( [ $old->radius_groups ] );
+  $old->usergroup( [ $old->radius_groups('NUMBERS') ] );
   if ( $DEBUG ) {
     warn $old->email. " old groups: ". join(' ',@{$old->usergroup}). "\n";
-    warn $new->email. "new groups: ". join(' ',@{$new->usergroup}). "\n";
+    warn $new->email. " new groups: ". join(' ',@{$new->usergroup}). "\n";
   }
   if ( $new->usergroup ) {
     #(sorta) false laziness with FS::part_export::sqlradius::_export_replace
@@ -1025,7 +1026,7 @@ sub replace {
       }
       my $radius_usergroup = qsearchs('radius_usergroup', {
         svcnum    => $old->svcnum,
-        groupname => $oldgroup,
+        groupnum  => $oldgroup,
       } );
       my $error = $radius_usergroup->delete;
       if ( $error ) {
@@ -1037,7 +1038,7 @@ sub replace {
     foreach my $newgroup ( @newgroups ) {
       my $radius_usergroup = new FS::radius_usergroup ( {
         svcnum    => $new->svcnum,
-        groupname => $newgroup,
+        groupnum => $newgroup,
       } );
       my $error = $radius_usergroup->insert;
       if ( $error ) {
@@ -2560,8 +2561,18 @@ sub radius_groups {
     #radius_usergroup records can be inserted...
     @{$self->usergroup};
   } else {
-    map { $_->groupname }
-      qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } );
+     my $format = shift || '';
+     my @groups = qsearch({ 'table'         => 'radius_usergroup',
+                            'addl_from'     => 'left join radius_group using (groupnum)',
+                            'select'        => 'radius_group.*',
+                            'hashref'       => { 'svcnum' => $self->svcnum },
+                        });
+
+     # this is to preserve various legacy behaviour / avoid re-writing other code
+     return map { $_->groupnum } @groups if $format eq 'NUMBERS';
+     return map { $_->description . " (" . $_->groupname . ")" } @groups
+        if $format eq 'COMBINED';
+     map { $_->groupname } @groups;
   }
 }
 
@@ -3102,56 +3113,6 @@ sub append_fuzzyfiles {
 }
 
 
-
-=item radius_usergroup_selector GROUPS_ARRAYREF [ SELECTNAME ]
-
-=cut
-
-sub radius_usergroup_selector {
-  my $sel_groups = shift;
-  my %sel_groups = map { $_=>1 } @$sel_groups;
-
-  my $selectname = shift || 'radius_usergroup';
-
-  my $dbh = dbh;
-  my $sth = $dbh->prepare(
-    'SELECT DISTINCT(groupname) FROM radius_usergroup ORDER BY groupname'
-  ) or die $dbh->errstr;
-  $sth->execute() or die $sth->errstr;
-  my @all_groups = map { $_->[0] } @{$sth->fetchall_arrayref};
-
-  my $html = <<END;
-    <SCRIPT>
-    function ${selectname}_doadd(object) {
-      var myvalue = object.${selectname}_add.value;
-      var optionName = new Option(myvalue,myvalue,false,true);
-      var length = object.$selectname.length;
-      object.$selectname.options[length] = optionName;
-      object.${selectname}_add.value = "";
-    }
-    </SCRIPT>
-    <SELECT MULTIPLE NAME="$selectname">
-END
-
-  foreach my $group ( @all_groups ) {
-    $html .= qq(<OPTION VALUE="$group");
-    if ( $sel_groups{$group} ) {
-      $html .= ' SELECTED';
-      $sel_groups{$group} = 0;
-    }
-    $html .= ">$group</OPTION>\n";
-  }
-  foreach my $group ( grep { $sel_groups{$_} } keys %sel_groups ) {
-    $html .= qq(<OPTION VALUE="$group" SELECTED>$group</OPTION>\n);
-  };
-  $html .= '</SELECT>';
-
-  $html .= qq!<BR><INPUT TYPE="text" NAME="${selectname}_add">!.
-           qq!<INPUT TYPE="button" VALUE="Add new group" onClick="${selectname}_doadd(this.form)">!;
-
-  $html;
-}
-
 =item reached_threshold
 
 Performs some activities when svc_acct thresholds (such as number of seconds
@@ -3241,9 +3202,6 @@ The suspend, unsuspend and cancel methods update the database, but not the
 current object.  This is probably a bug as it's unexpected and
 counterintuitive.
 
-radius_usergroup_selector?  putting web ui components in here?  they should
-probably live somewhere else...
-
 insertion of RADIUS group stuff in insert could be done with child_objects now
 (would probably clean up export of them too)
 
diff --git a/FS/MANIFEST b/FS/MANIFEST
index fddbddd9b..ceeb3b7bc 100644
--- a/FS/MANIFEST
+++ b/FS/MANIFEST
@@ -606,3 +606,5 @@ FS/L10N.pm
 t/L10N.t
 FS/Maketext.pm
 t/Maketext.t
+FS/radius_group.pm
+t/radius_group.t
diff --git a/FS/t/radius_group.t b/FS/t/radius_group.t
new file mode 100644
index 000000000..202032d75
--- /dev/null
+++ b/FS/t/radius_group.t
@@ -0,0 +1,5 @@
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::radius_group;
+$loaded=1;
+print "ok 1\n";