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