FS/FS/part_export/radiator.pm

   1 package FS::part_export::radiator;
   2
   3 use vars qw(@ISA %info $radusers);
   4 use Tie::IxHash;
   5 use FS::part_export::sqlradius;
   6
   7 tie my %options, 'Tie::IxHash', %FS::part_export::sqlradius::options;
   8
   9 %info = (
  10   'svc'      => 'svc_acct',
  11   'desc'     => 'Real-time export to RADIATOR',
  12   'options'  => \%options,
  13   'nodomain' => '',
  14   'notes' => <<'END',
  15 Real-time export of the <b>radusers</b> table to any SQL database in
  16 <a href="http://www.open.com.au/radiator/">Radiator</a>-native format.
  17 To setup accounting, see the RADIATOR documentation for hooks to update
  18 a standard <b>radacct</b> table.
  19 END
  20 );
  21
  22 @ISA = qw(FS::part_export::sqlradius); #for regular sqlradius accounting
  23
  24 $radusers = 'RADUSERS'; #MySQL is case sensitive about table names!  huh
  25
  26 #sub export_username {
  27 #  my($self, $svc_acct) = (shift, shift);
  28 #  $svc_acct->email;
  29 #}
  30
  31 sub _export_insert {
  32   my( $self, $svc_acct ) = (shift, shift);
  33
  34   $self->radiator_queue(
  35     $svc_acct->svcnum,
  36     'insert',
  37     $self->_radiator_hash($svc_acct),
  38   );
  39 }
  40
  41 sub _export_replace {
  42   my( $self, $new, $old ) = (shift, shift, shift);
  43
  44 #  return "can't (yet) change domain with radiator export"
  45 #    if $old->domain ne $new->domain;
  46 #  return "can't (yet) change username with radiator export"
  47 #    if $old->username ne $new->username;
  48
  49   $self->radiator_queue(
  50     $new->svcnum,
  51     'replace',
  52     $self->export_username($old),
  53     $self->_radiator_hash($new),
  54   );
  55 }
  56
  57 sub _export_delete {
  58   my( $self, $svc_acct ) = (shift, shift);
  59
  60   $self->radiator_queue(
  61     $svc_acct->svcnum,
  62     'delete',
  63     $self->export_username($svc_acct),
  64   );
  65 }
  66
  67 sub _radiator_hash {
  68   my( $self, $svc_acct ) = @_;
  69   my %hash = (
  70     'username'  => $self->export_username($svc_acct),
  71     'pass_word' => $svc_acct->_password,
  72     'fullname'  => $svc_acct->finger,
  73     map { my $method = "radius_$_"; $_ => $svc_acct->$method(); }
  74         qw( framed_filter_id framed_mtu framed_netmask framed_protocol
  75             framed_routing login_host login_service login_tcp_port )
  76   );
  77   $hash{timeleft} = $svc_acct->seconds
  78     if $svc_acct->seconds =~ /^\d+$/;
  79   $hash{staticaddress} = $svc_acct->slipip
  80     if $svc_acct->slipip =~ /^[\d\.]+$/; # and $self->slipip ne '0.0.0.0';
  81
  82   %hash;
  83 }
  84
  85 sub radiator_queue {
  86   my( $self, $svcnum, $method ) = (shift, shift, shift);
  87   my $queue = new FS::queue {
  88     'svcnum' => $svcnum,
  89     'job'    => "FS::part_export::radiator::radiator_$method",
  90   };
  91   $queue->insert(
  92     $self->option('datasrc'),
  93     $self->option('username'),
  94     $self->option('password'),
  95     @_,
  96   ); # or $queue;
  97 }
  98
  99 sub radiator_insert { #subroutine, not method
 100   my $dbh = radiator_connect(shift, shift, shift);
 101   my %hash = @_;
 102
 103   my $sth = $dbh->prepare(
 104     "INSERT INTO $radusers ( ". join(', ', keys %hash ). ' ) '.
 105       'VALUES ( '. join(', ', map '?', keys %hash ). ' ) '
 106   ) or die $dbh->errstr;
 107   $sth->execute( values %hash )
 108     or die $sth->errstr;
 109
 110   $dbh->disconnect;
 111
 112 }
 113
 114 sub radiator_replace { #subroutine, not method
 115   my $dbh = radiator_connect(shift, shift, shift);
 116   my ( $old_username, %hash ) = @_;
 117
 118   my $sth = $dbh->prepare(
 119     "UPDATE $radusers SET ". join(', ', map " $_ = ?", keys %hash ).
 120       ' WHERE username = ?'
 121   ) or die $dbh->errstr;
 122   $sth->execute( values(%hash), $old_username )
 123     or die $sth->errstr;
 124
 125   $dbh->disconnect;
 126 }
 127
 128 sub radiator_delete { #subroutine, not method
 129   my $dbh = radiator_connect(shift, shift, shift);
 130   my ( $username ) = @_;
 131
 132   my $sth = $dbh->prepare(
 133     "DELETE FROM $radusers WHERE username = ?"
 134   ) or die $dbh->errstr;
 135   $sth->execute( $username )
 136     or die $sth->errstr;
 137
 138   $dbh->disconnect;
 139 }
 140
 141
 142 sub radiator_connect {
 143   #my($datasrc, $username, $password) = @_;
 144   #DBI->connect($datasrc, $username, $password) or die $DBI::errstr;
 145   DBI->connect(@_) or die $DBI::errstr;
 146 }
 147
 148 1;