FS/FS/part_export/broadband_nas.pm

   1 package FS::part_export::broadband_nas;
   2
   3 use strict;
   4 use vars qw(%info $DEBUG);
   5 use base 'FS::part_export';
   6 use FS::Record qw(qsearch qsearchs);
   7 use FS::nas;
   8 use FS::export_nas;
   9 use FS::svc_broadband;
  10 use FS::part_export::sqlradius;
  11 use Tie::IxHash;
  12
  13 $DEBUG = 0;
  14
  15 my $me = '['.__PACKAGE__.']';
  16
  17 tie my %options, 'Tie::IxHash',
  18   '1' => { type => 'title', label => 'Defaults' },
  19   default_shortname => { label => 'Short name' },
  20   default_secret    => { label => 'Shared secret' },
  21   default_type      => { label => 'Type' },
  22   default_ports     => { label => 'Ports' },
  23   default_server    => { label => 'Virtual server' },
  24   default_community => { label => 'Community' },
  25   '2' => { type => 'title', label => 'Export to' },
  26   # default export_nas entries will be inserted at runtime
  27 ;
  28
  29 FS::UID->install_callback(
  30   sub {
  31     #creating new options based on records in a table,
  32     #has to be done after initialization
  33     foreach ( FS::part_export::sqlradius->all_sqlradius ) {
  34       my $name = 'exportnum' . $_->exportnum;
  35       $options{$name} =
  36         { type => 'checkbox', label => $_->exportnum . ': ' . $_->label };
  37
  38     }
  39   }
  40 );
  41
  42 %info = (
  43   'svc'     => 'svc_broadband',
  44   'desc'    => 'Create a NAS entry in Freeside',
  45   'options' => \%options,
  46   'no_machine' => 1,
  47   'weight'  => 10,
  48   'notes'   => <<'END'
  49 <p>Create an entry in the NAS (RADIUS client) table, inheriting the IP
  50 address and description of the broadband service.  This can be used
  51 with 'sqlradius' or 'broadband_sqlradius' exports to maintain entries
  52 in the client table on a RADIUS server.</p>
  53 <p>The checkboxes at the bottom of this page correspond to RADIUS server
  54 databases that Freeside knows about (i.e. 'sqlradius' or 'broadband_sqlradius'
  55 exports that you have configured).  Check the box for each server that you
  56 want the NAS entries to be exported to.  Do not create multiple broadband_nas
  57 exports for the same service definition; this will fail.</p>
  58 <p>Most broadband configurations should not use this, even if they use
  59 RADIUS for access control.</p>
  60 END
  61 );
  62
  63 =item export_insert NEWSVC
  64
  65 =item export_replace NEWSVC OLDSVC
  66
  67 NEWSVC can contain pseudo-field entries for fields in nas.  Those changes
  68 will be applied to the attached NAS record.
  69
  70 =cut
  71
  72 sub _export_insert {
  73   my $self = shift;
  74   my $svc_broadband = shift;
  75   my %hash = (
  76     'nasname'     => $svc_broadband->ip_addr,
  77     'description' => $svc_broadband->description,
  78     'svcnum'      => $svc_broadband->svcnum,
  79   );
  80   foreach (FS::nas->fields) {
  81     if ( length($svc_broadband->get($_)) ) {
  82       $hash{$_} = $svc_broadband->get($_);
  83     }
  84   }
  85   # if there's somehow a completely identical NAS in the table already,
  86   # use that one.
  87   my $nas = qsearchs('nas', \%hash);
  88   my $error;
  89   if ($nas) {
  90     # propagate the export message
  91     foreach my $part_export ($nas->part_export) {
  92       $error = $part_export->export_nas_insert($nas);
  93       die $error if $error;
  94     }
  95   } else {
  96     $nas = $self->default_nas( %hash );
  97     $error = $nas->insert ||
  98         $nas->process_m2m('link_table' => 'export_nas',
  99                           'target_table' => 'part_export',
 100                           'params' => { $self->options });
 101   }
 102   die $error if $error;
 103   return;
 104 }
 105
 106 sub _export_delete {
 107   my $self = shift;
 108   my $svc_broadband = shift;
 109   my $svcnum = $svc_broadband->svcnum;
 110   my $nas = qsearchs('nas', { 'svcnum' => $svcnum });
 111   if ( !$nas ) {
 112     # we were going to delete it anyway...
 113     warn "linked NAS with svcnum $svcnum not found for deletion\n";
 114     return;
 115   }
 116   my $error = $nas->delete; # will clean up export_nas records
 117   die $error if $error;
 118   return;
 119 }
 120
 121 sub _export_replace {
 122   my $self = shift;
 123   my ($new_svc, $old_svc) = (shift, shift);
 124
 125   my $svcnum = $new_svc->svcnum;
 126   my $nas = qsearchs('nas', { 'svcnum' => $svcnum });
 127   if ( !$nas ) {
 128     warn "linked nas with svcnum $svcnum not found for update, creating new\n";
 129     # then we should insert it
 130     # (this happens if the nas table is wiped out, or if the broadband_nas
 131     # export is newly applied to an existing svcpart)
 132     return $self->export_insert($new_svc);
 133   }
 134
 135   my %hash = $new_svc->hash;
 136   foreach (FS::nas->fields) {
 137     $nas->set($_, $hash{$_}) if exists($hash{$_});
 138   }
 139
 140   $nas->nasname($new_svc->ip_addr); # this must always be true
 141
 142   my $error = $nas->replace;
 143   die $error if $error;
 144   return;
 145 }
 146
 147 =item default_nas HASH
 148
 149 Returns a new L<FS::nas> object containing the default values, plus anything
 150 in HASH.
 151
 152 =cut
 153
 154 sub default_nas {
 155   my $self = shift;
 156   FS::nas->new({
 157     map( { $_ => $self->option("default_$_") }
 158       qw(shortname type ports secret server community)
 159     ),
 160     @_
 161   });
 162 }
 163
 164
 165 1;