FS/FS/part_export/radiator.pm

   1 package FS::part_export::radiator;
   2
   3 use vars qw(@ISA %info);
   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 #sub export_username {
  25 #  my($self, $svc_acct) = (shift, shift);
  26 #  $svc_acct->email;
  27 #}
  28
  29 sub _export_insert {
  30   my( $self, $svc_acct ) = (shift, shift);
  31
  32   $self->radiator_queue(
  33     $svc_acct->svcnum,
  34     'insert',
  35     $self->_radiator_hash($svc_acct),
  36   );
  37 }
  38
  39 sub _export_replace {
  40   my( $self, $new, $old ) = (shift, shift, shift);
  41
  42 #  return "can't (yet) change domain with radiator export"
  43 #    if $old->domain ne $new->domain;
  44 #  return "can't (yet) change username with radiator export"
  45 #    if $old->username ne $new->username;
  46
  47   $self->radiator_queue(
  48     $new->svcnum,
  49     'replace',
  50     $self->export_username($old),
  51     $self->_radiator_hash($new),
  52   );
  53 }
  54
  55 sub _export_delete {
  56   my( $self, $svc_acct ) = (shift, shift);
  57
  58   $self->radiator_queue(
  59     $svc_acct->svcnum,
  60     'delete',
  61     $self->export_username($svc_acct),
  62   );
  63 }
  64
  65 sub _radiator_hash {
  66   my( $self, $svc_acct ) = @_;
  67   my %hash = (
  68     'username'  => $self->export_username($svc_acct),
  69     'pass_word' => $svc_acct->_password,
  70     'fullname'  => $svc_acct->finger,
  71     map { my $method = "radius_$_"; $_ => $svc_acct->$method(); }
  72         qw( framed_filter_id framed_mtu framed_netmask framed_protocol
  73             framed_routing login_host login_service login_tcp_port )
  74   );
  75   $hash{timeleft} = $svc_acct->seconds
  76     if $svc_acct->seconds =~ /^\d+$/;
  77   $hash{staticaddress} = $svc_acct->slipip
  78     if $svc_acct->slipip =~ /^[\d\.]+$/; # and $self->slipip ne '0.0.0.0';
  79
  80   %hash;
  81 }
  82
  83 sub radiator_queue {
  84   my( $self, $svcnum, $method ) = (shift, shift, shift);
  85   my $queue = new FS::queue {
  86     'svcnum' => $svcnum,
  87     'job'    => "FS::part_export::radiator::radiator_$method",
  88   };
  89   $queue->insert(
  90     $self->option('datasrc'),
  91     $self->option('username'),
  92     $self->option('password'),
  93     @_,
  94   ); # or $queue;
  95 }
  96
  97 sub radiator_insert { #subroutine, not method
  98   my $dbh = radiator_connect(shift, shift, shift);
  99   my %hash = @_;
 100
 101   my $sth = $dbh->prepare(
 102     'INSERT INTO radusers ( '. join(', ', keys %hash ). ' ) '.
 103       'VALUES ( '. join(', ', map '?', keys %hash ). ' ) '
 104   ) or die $dbh->errstr;
 105   $sth->execute( values %hash )
 106     or die $sth->errstr;
 107
 108   $dbh->disconnect;
 109
 110 }
 111
 112 sub radiator_replace { #subroutine, not method
 113   my $dbh = radiator_connect(shift, shift, shift);
 114   my ( $old_username, %hash ) = @_;
 115
 116   my $sth = $dbh->prepare(
 117     'UPDATE radusers SET '. join(', ', map " $_ = ?", keys %hash ).
 118       ' WHERE username = ?'
 119   ) or die $dbh->errstr;
 120   $sth->execute( values(%hash), $old_username )
 121     or die $sth->errstr;
 122
 123   $dbh->disconnect;
 124 }
 125
 126 sub radiator_delete { #subroutine, not method
 127   my $dbh = radiator_connect(shift, shift, shift);
 128   my ( $username ) = @_;
 129
 130   my $sth = $dbh->prepare(
 131     'DELETE FROM radusers WHERE username = ?'
 132   ) or die $dbh->errstr;
 133   $sth->execute( $username )
 134     or die $sth->errstr;
 135
 136   $dbh->disconnect;
 137 }
 138
 139
 140 sub radiator_connect {
 141   #my($datasrc, $username, $password) = @_;
 142   #DBI->connect($datasrc, $username, $password) or die $DBI::errstr;
 143   DBI->connect(@_) or die $DBI::errstr;
 144 }
 145
 146 1;