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