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   'weight'  => 10,
  47   'notes'   => <<'END'
  48 <p>Create an entry in the NAS (RADIUS client) table, inheriting the IP
  49 address and description of the broadband service.  This can be used
  50 with 'sqlradius' or 'broadband_sqlradius' exports to maintain entries
  51 in the client table on a RADIUS server.</p>
  52 <p>Most broadband configurations should not use this, even if they use
  53 RADIUS for access control.</p>
  54 END
  55 );
  56
  57 =item export_insert NEWSVC
  58
  59 =item export_replace NEWSVC OLDSVC
  60
  61 NEWSVC can contain pseudo-field entries for fields in nas.  Those changes
  62 will be applied to the attached NAS record.
  63
  64 =cut
  65
  66 sub export_insert {
  67   my $self = shift;
  68   my $svc_broadband = shift;
  69   my %hash = map { $_ => $svc_broadband->get($_) } FS::nas->fields;
  70   my $nas = $self->default_nas(
  71     %hash,
  72     'nasname'     => $svc_broadband->ip_addr,
  73     'description' => $svc_broadband->description,
  74     'svcnum'      => $svc_broadband->svcnum,
  75   );
  76
  77   my $error =
  78       $nas->insert()
  79    || $nas->process_m2m('link_table' => 'export_nas',
  80                         'target_table' => 'part_export',
  81                         'params' => { $self->options });
  82   die $error if $error;
  83   return;
  84 }
  85
  86 sub export_delete {
  87   my $self = shift;
  88   my $svc_broadband = shift;
  89   my $svcnum = $svc_broadband->svcnum;
  90   my $nas = qsearchs('nas', { 'svcnum' => $svcnum });
  91   if ( !$nas ) {
  92     # we were going to delete it anyway...
  93     warn "linked NAS with svcnum $svcnum not found for deletion\n";
  94     return;
  95   }
  96   my $error = $nas->delete; # will clean up export_nas records
  97   die $error if $error;
  98   return;
  99 }
 100
 101 sub export_replace {
 102   my $self = shift;
 103   my ($new_svc, $old_svc) = (shift, shift);
 104
 105   my $svcnum = $new_svc->svcnum;
 106   my $nas = qsearchs('nas', { 'svcnum' => $svcnum });
 107   if ( !$nas ) {
 108     warn "linked nas with svcnum $svcnum not found for update, creating new\n";
 109     # then we should insert it
 110     # (this happens if the nas table is wiped out, or if the broadband_nas
 111     # export is newly applied to an existing svcpart)
 112     return $self->export_insert($new_svc);
 113   }
 114
 115   my %hash = $new_svc->hash;
 116   foreach (FS::nas->fields) {
 117     $nas->set($_, $hash{$_}) if exists($hash{$_});
 118   }
 119
 120   $nas->nasname($new_svc->ip_addr); # this must always be true
 121
 122   my $error = $nas->replace;
 123   die $error if $error;
 124   return;
 125 }
 126
 127 =item default_nas HASH
 128
 129 Returns a new L<FS::nas> object containing the default values, plus anything
 130 in HASH.
 131
 132 =cut
 133
 134 sub default_nas {
 135   my $self = shift;
 136   FS::nas->new({
 137     map( { $_ => $self->option("default_$_") }
 138       qw(shortname type ports secret server community)
 139     ),
 140     @_
 141   });
 142 }
 143
 144
 145 1;