add native Radiator export

3 files changed, 152 insertions, 6 deletions

diff --git a/FS/FS/part_export/radiator.pm b/FS/FS/part_export/radiator.pm
new file mode 100644
index 000000000..8f4a92911
--- /dev/null
+++ b/FS/FS/part_export/radiator.pm
@@ -0,0 +1,146 @@
+package FS::part_export::radiator;
+
+use vars qw(@ISA %info);
+use Tie::IxHash;
+use FS::part_export::sqlradius;
+
+tie my %options, 'Tie::IxHash', %FS::part_export::sqlradius::options;
+
+%info = (
+  'svc'      => 'svc_acct',
+  'desc'     => 'Real-time export to RADIATOR',
+  'options'  => \%options,
+  'nodomain' => '',
+  'notes' => <<'END',
+Real-time export of the <b>radusers</b> table to any SQL database in
+<a href="http://www.open.com.au/radiator/">Radiator</a>-native format.
+To setup accounting, see the RADIATOR documentation for hooks to update
+a standard <b>radacct</b> table.
+END
+);
+
+@ISA = qw(FS::part_export::sqlradius); #for regular sqlradius accounting
+
+#sub export_username {
+#  my($self, $svc_acct) = (shift, shift);
+#  $svc_acct->email;
+#}
+
+sub _export_insert {
+  my( $self, $svc_acct ) = (shift, shift);
+
+  $self->radiator_queue(
+    $svc_acct->svcnum,
+    'insert',
+    $self->_radiator_hash($svc_acct),
+  );
+}
+
+sub _export_replace {
+  my( $self, $new, $old ) = (shift, shift, shift);
+
+#  return "can't (yet) change domain with radiator export"
+#    if $old->domain ne $new->domain;
+#  return "can't (yet) change username with radiator export"
+#    if $old->username ne $new->username;
+
+  $self->radiator_queue(
+    $new->svcnum,
+    'replace',
+    $self->export_username($old),
+    $self->_radiator_hash($new),
+  );
+}
+
+sub _export_delete {
+  my( $self, $svc_acct ) = (shift, shift);
+
+  $self->radiator_queue(
+    $svc_acct->svcnum,
+    'delete',
+    $self->export_username($svc_acct),
+  );
+}
+
+sub _radiator_hash {
+  my( $self, $svc_acct ) = @_;
+  my %hash = (
+    'username'  => $self->export_username($svc_acct),
+    'pass_word' => $svc_acct->_password,
+    'fullname'  => $svc_acct->finger,
+    map { my $method = "radius_$_"; $_ => $svc_acct->$method(); }
+        qw( framed_filter_id framed_mtu framed_netmask framed_protocol
+            framed_routing login_host login_service login_tcp_port )
+  );
+  $hash{timeleft} = $svc_acct->seconds
+    if $svc_acct->seconds =~ /^\d+$/;
+  $hash{staticaddress} = $svc_acct->slipip
+    if $svc_acct->slipip =~ /^[\d\.]+$/; # and $self->slipip ne '0.0.0.0';
+
+  %hash;
+}
+
+sub radiator_queue {
+  my( $self, $svcnum, $method ) = (shift, shift, shift);
+  my $queue = new FS::queue {
+    'svcnum' => $svcnum,
+    'job'    => "FS::part_export::radiator::radiator_$method",
+  };
+  $queue->insert(
+    $self->option('datasrc'),
+    $self->option('username'),
+    $self->option('password'),
+    @_,
+  ); # or $queue;
+}
+
+sub radiator_insert { #subroutine, not method
+  my $dbh = radiator_connect(shift, shift, shift);
+  my %hash = @_;
+
+  my $sth = $dbh->prepare(
+    'INSERT INTO radusers ( '. join(', ', keys %hash ). ' ) '.
+      'VALUES ( '. join(', ', map '?', keys %hash ). ' ) '
+  ) or die $dbh->errstr;
+  $sth->execute( values %hash )
+    or die $sth->errstr;
+
+  $dbh->disconnect;
+
+}
+
+sub radiator_replace { #subroutine, not method
+  my $dbh = radiator_connect(shift, shift, shift);
+  my ( $old_username, %hash ) = @_;
+
+  my $sth = $dbh->prepare(
+    'UPDATE radusers SET '. join(', ', map " $_ = ?", keys %hash ).
+      ' WHERE username = ?'
+  ) or die $dbh->errstr;
+  $sth->execute( values(%hash), $old_username )
+    or die $sth->errstr;
+
+  $dbh->disconnect;
+}
+
+sub radiator_delete { #subroutine, not method
+  my $dbh = radiator_connect(shift, shift, shift);
+  my ( $username ) = @_;
+
+  my $sth = $dbh->prepare(
+    'DELETE FROM radusers WHERE username = ?'
+  ) or die $dbh->errstr;
+  $sth->execute( $username )
+    or die $sth->errstr;
+
+  $dbh->disconnect;
+}
+
+
+sub radiator_connect {
+  #my($datasrc, $username, $password) = @_;
+  #DBI->connect($datasrc, $username, $password) or die $DBI::errstr;
+  DBI->connect(@_) or die $DBI::errstr;
+}
+
+1;
diff --git a/FS/FS/part_export/sqlradius.pm b/FS/FS/part_export/sqlradius.pm
index 772da1255..10bccb034 100644
--- a/FS/FS/part_export/sqlradius.pm
+++ b/FS/FS/part_export/sqlradius.pm
@@ -34,10 +34,10 @@ tie %options, 'Tie::IxHash',
 ;
 
 $notes1 = <<'END';
-Real-time export of radcheck, radreply and usergroup tables to any SQL database
-for <a href="http://www.freeradius.org/">FreeRADIUS</a>,
-<a href="http://radius.innercite.com/">ICRADIUS</a>
-or <a href="http://www.open.com.au/radiator/">Radiator</a>.  
+Real-time export of <b>radcheck</b>, <b>radreply</b> and <b>usergroup</b>
+tables to any SQL database for
+<a href="http://www.freeradius.org/">FreeRADIUS</a>
+or <a href="http://radius.innercite.com/">ICRADIUS</a>.
 END
 
 $notes2 = <<'END';
@@ -66,7 +66,7 @@ END
 
 %info = (
   'svc'      => 'svc_acct',
-  'desc'     => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS, Radiator)',
+  'desc'     => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS)',
   'options'  => \%options,
   'nodomain' => 'Y',
   'notes'    => $notes1.
diff --git a/FS/FS/part_export/sqlradius_withdomain.pm b/FS/FS/part_export/sqlradius_withdomain.pm
index 6130e5eb6..e5a7151a2 100644
--- a/FS/FS/part_export/sqlradius_withdomain.pm
+++ b/FS/FS/part_export/sqlradius_withdomain.pm
@@ -8,7 +8,7 @@ tie my %options, 'Tie::IxHash', %FS::part_export::sqlradius::options;
 
 %info = (
   'svc'      => 'svc_acct',
-  'desc'     => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS, Radiator) with realms',
+  'desc'     => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS) with realms',
   'options'  => \%options,
   'nodomain' => '',
   'notes' => $FS::part_export::sqlradius::notes1.