Merge branch 'patch-1' of https://github.com/gjones2/Freeside

[freeside.git] / FS / FS / part_export.pm

diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm
index d533db8..5d65062 100644 (file)
--- a/FS/FS/part_export.pm
+++ b/FS/FS/part_export.pm
@@ -4,16 +4,17 @@ use strict;
 use vars qw( @ISA @EXPORT_OK $DEBUG %exports );
 use Exporter;
 use Tie::IxHash;
 use vars qw( @ISA @EXPORT_OK $DEBUG %exports );
 use Exporter;
 use Tie::IxHash;

+use base qw( FS::option_Common FS::m2m_Common );

 use FS::Record qw( qsearch qsearchs dbh );
 use FS::Record qw( qsearch qsearchs dbh );

-use FS::option_Common;

 use FS::part_svc;
 use FS::part_export_option;
 use FS::part_svc;
 use FS::part_export_option;

+use FS::part_export_machine;
+use FS::svc_export_machine;

 use FS::export_svc;
 
 #for export modules, though they should probably just use it themselves
 use FS::queue;
 
 use FS::export_svc;
 
 #for export modules, though they should probably just use it themselves
 use FS::queue;
 

-@ISA = qw( FS::option_Common );

 @EXPORT_OK = qw(export_info);
 
 $DEBUG = 0;
 @EXPORT_OK = qw(export_info);
 
 $DEBUG = 0;


@@ -50,6 +51,8 @@ fields are currently supported:
 
 =item exportnum - primary key
 
 
 =item exportnum - primary key
 

+=item exportname - Descriptive name
+

 =item machine - Machine name 
 
 =item exporttype - Export type
 =item machine - Machine name 
 
 =item exporttype - Export type


@@ -107,6 +110,50 @@ otherwise returns false.
 If a hash reference of options is supplied, part_export_option records are
 created (see L<FS::part_export_option>).
 
 If a hash reference of options is supplied, part_export_option records are
 created (see L<FS::part_export_option>).
 

+=cut
+
+sub insert {
+  my $self = shift;
+
+  local $SIG{HUP} = 'IGNORE';
+  local $SIG{INT} = 'IGNORE';
+  local $SIG{QUIT} = 'IGNORE';
+  local $SIG{TERM} = 'IGNORE';
+  local $SIG{TSTP} = 'IGNORE';
+  local $SIG{PIPE} = 'IGNORE';
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
+  my $error = $self->SUPER::insert(@_);
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }
+
+  #kinda false laziness with process_m2name
+  my @machines = map { $_ =~ s/^\s+//; $_ =~ s/\s+$//; $_ }
+                   grep /\S/,
+                     split /[\n\r]{1,2}/,
+                       $self->part_export_machine_textarea;
+
+  foreach my $machine ( @machines ) {
+
+    my $part_export_machine = new FS::part_export_machine {
+      'exportnum' => $self->exportnum,
+      'machine'   => $machine,
+    };
+    $error = $part_export_machine->insert;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+  }
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+  '';
+}
+

 =item delete
 
 Delete this record from the database.
 =item delete
 
 Delete this record from the database.


@@ -116,18 +163,23 @@ Delete this record from the database.
 #foreign keys would make this much less tedious... grr dumb mysql
 sub delete {
   my $self = shift;
 #foreign keys would make this much less tedious... grr dumb mysql
 sub delete {
   my $self = shift;

+

   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
   local $SIG{QUIT} = 'IGNORE';
   local $SIG{TERM} = 'IGNORE';
   local $SIG{TSTP} = 'IGNORE';
   local $SIG{PIPE} = 'IGNORE';
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
   local $SIG{QUIT} = 'IGNORE';
   local $SIG{TERM} = 'IGNORE';
   local $SIG{TSTP} = 'IGNORE';
   local $SIG{PIPE} = 'IGNORE';

-

   my $oldAutoCommit = $FS::UID::AutoCommit;
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
   my $oldAutoCommit = $FS::UID::AutoCommit;
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 

-  my $error = $self->SUPER::delete;
+  # clean up export_nas records
+  my $error = $self->process_m2m(
+    'link_table'    => 'export_nas',
+    'target_table'  => 'nas',
+    'params'        => [],
+  ) || $self->SUPER::delete;

   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
     return $error;
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
     return $error;


@@ -141,10 +193,103 @@ sub delete {
     }
   }
 
     }
   }
 

-  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+  foreach my $part_export_machine ( $self->part_export_machine ) {
+    my $error = $part_export_machine->delete;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+  }

 
 

+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;

   '';
   '';

+}
+
+=item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ]
+
+Replaces the OLD_RECORD with this one in the database.  If there is an error,
+returns the error, otherwise returns false.
+
+If a list or hash reference of options is supplied, option records are created
+or modified.
+
+=cut
+
+sub replace {
+  my $self = shift;
+
+  local $SIG{HUP} = 'IGNORE';
+  local $SIG{INT} = 'IGNORE';
+  local $SIG{QUIT} = 'IGNORE';
+  local $SIG{TERM} = 'IGNORE';
+  local $SIG{TSTP} = 'IGNORE';
+  local $SIG{PIPE} = 'IGNORE';
+
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
+  my $error = $self->SUPER::replace(@_);
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }
+
+  if ( $self->part_export_machine_textarea ) {
+
+    my %part_export_machine = map { $_->machine => $_ }
+                                $self->part_export_machine;
+
+    my @machines = map { $_ =~ s/^\s+//; $_ =~ s/\s+$//; $_ }
+                     grep /\S/,
+                       split /[\n\r]{1,2}/,
+                         $self->part_export_machine_textarea;
+
+    foreach my $machine ( @machines ) {
+
+      if ( $part_export_machine{$machine} ) {
+
+        if ( $part_export_machine{$machine}->disabled eq 'Y' ) {
+          $part_export_machine{$machine}->disabled('');
+          $error = $part_export_machine{$machine}->replace;
+          if ( $error ) {
+            $dbh->rollback if $oldAutoCommit;
+            return $error;
+          }
+        }

 
 

+        delete $part_export_machine{$machine}; #so we don't disable it below
+
+      } else {
+
+        my $part_export_machine = new FS::part_export_machine {
+                                        'exportnum' => $self->exportnum,
+                                        'machine'   => $machine
+                                      };
+        $error = $part_export_machine->insert;
+        if ( $error ) {
+          $dbh->rollback if $oldAutoCommit;
+          return $error;
+        }
+  
+      }
+
+    }
+
+
+    foreach my $part_export_machine ( values %part_export_machine ) {
+      $part_export_machine->disabled('Y');
+      $error = $part_export_machine->replace;
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return $error;
+      }
+    }
+
+  }
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+  '';

 }
 
 =item check
 }
 
 =item check


@@ -159,7 +304,8 @@ sub check {
   my $self = shift;
   my $error = 
     $self->ut_numbern('exportnum')
   my $self = shift;
   my $error = 
     $self->ut_numbern('exportnum')

-    || $self->ut_domain('machine')
+    || $self->ut_textn('exportname')
+    || $self->ut_domainn('machine')

     || $self->ut_alpha('exporttype')
   ;
   return $error if $error;
     || $self->ut_alpha('exporttype')
   ;
   return $error if $error;


@@ -174,6 +320,42 @@ sub check {
   $self->SUPER::check;
 }
 
   $self->SUPER::check;
 }
 

+=item label
+
+Returns a label for this export, "exportname||exportype (machine)".  
+
+=cut
+
+sub label {
+  my $self = shift;
+  ($self->exportname || $self->exporttype ). ' ('. $self->machine. ')';
+}
+
+=item label_html
+
+Returns a label for this export, "exportname: exporttype to machine".
+
+=cut
+
+sub label_html {
+  my $self = shift;
+
+  my $label = $self->exportname
+                ? '<B>'. $self->exportname. '</B>: ' #<BR>'.
+                : '';
+
+  $label .= $self->exporttype;
+
+  $label .= ' to '. ( $self->machine eq '_SVC_MACHINE'
+                        ? 'per-service hostname'
+                        : $self->machine
+                    )
+    if $self->machine;
+
+  $label;
+
+}
+

 #=item part_svc
 #
 #Returns the service definition (see L<FS::part_svc>) for this export.
 #=item part_svc
 #
 #Returns the service definition (see L<FS::part_svc>) for this export.


@@ -215,6 +397,20 @@ sub cust_svc {
       $self->export_svc;
 }
 
       $self->export_svc;
 }
 

+=item part_export_machine
+
+Returns all machines as FS::part_export_machine objects (see
+L<FS::part_export_machine>).
+
+=cut
+
+sub part_export_machine {
+  my $self = shift;
+  map { $_ } #behavior of sort undefined in scalar context
+    sort { $a->machine cmp $b->machine }
+      qsearch('part_export_machine', { 'exportnum' => $self->exportnum } );
+}
+

 =item export_svc
 
 Returns a list of associated FS::export_svc records.
 =item export_svc
 
 Returns a list of associated FS::export_svc records.


@@ -275,6 +471,26 @@ sub _rebless {
   $self;
 }
 
   $self;
 }
 

+=item svc_machine
+
+=cut
+
+sub svc_machine {
+  my( $self, $svc_x ) = @_;
+
+  return $self->machine unless $self->machine eq '_SVC_MACHINE';
+
+  my $svc_export_machine = qsearchs('svc_export_machine', {
+    'svcnum'    => $svc_x->svcnum,
+    'exportnum' => $self->exportnum,
+  })
+    #would only happen if you add this export to existing services without a
+    #machine set then try to run exports without setting it... right?
+    or die "No hostname selected for ".($self->exportname || $self->exporttype);
+
+  return $svc_export_machine->part_export_machine->machine;
+}
+

 #these should probably all go away, just let the subclasses define em
 
 =item export_insert SVC_OBJECT
 #these should probably all go away, just let the subclasses define em
 
 =item export_insert SVC_OBJECT


@@ -376,8 +592,46 @@ Adds a list of web elements to ARRAYREF specific to this export and SVC_OBJECT.
 The elements are displayed in the UI to lead the the operator to external
 configuration, monitoring, and similar tools.
 
 The elements are displayed in the UI to lead the the operator to external
 configuration, monitoring, and similar tools.
 

+=item export_getsettings SVC_OBJECT SETTINGS_HASHREF DEFAUTS_HASHREF
+
+Adds a hashref of settings to SETTINGSREF specific to this export and
+SVC_OBJECT.  The elements can be displayed in the UI on the service view.
+
+DEFAULTSREF is a hashref with the same keys where true values indicate the
+setting is a default (and thus can be displayed in the UI with less emphasis,
+or hidden by default).
+
+=cut
+
+=item weight
+
+Returns the 'weight' element from the export's %info hash, or 0 if there is 
+no weight defined.
+

 =cut
 
 =cut
 

+sub weight {
+  my $self = shift;
+  export_info()->{$self->exporttype}->{'weight'} || 0;
+}
+
+=item info
+
+Returns a reference to (a copy of) the export's %info hash.
+
+=cut
+
+sub info {
+  my $self = shift;
+  $self->{_info} ||= { 
+    %{ export_info()->{$self->exporttype} }
+  };
+}
+
+#default fallbacks... FS::part_export::DID_Common ?
+sub get_dids_can_tollfree { 0; }
+sub get_dids_npa_select   { 1; }
+

 =back
 
 =head1 SUBROUTINES
 =back
 
 =head1 SUBROUTINES


@@ -408,6 +662,40 @@ sub export_info {
   my $r = { map { %{$exports{$_}} } keys %exports };
 }
 
   my $r = { map { %{$exports{$_}} } keys %exports };
 }
 

+
+sub _upgrade_data {  #class method
+  my ($class, %opts) = @_;
+
+  my @part_export_option = qsearch('part_export_option', { 'optionname' => 'overlimit_groups' });
+  foreach my $opt ( @part_export_option ) {
+    next if $opt->optionvalue =~ /^[\d\s]+$/ || !$opt->optionvalue;
+    my @groupnames = split(' ',$opt->optionvalue);
+    my @groupnums;
+    my $error = '';
+    foreach my $groupname ( @groupnames ) {
+        my $g = qsearchs('radius_group', { 'groupname' => $groupname } );
+        unless ( $g ) {
+            $g = new FS::radius_group {
+                            'groupname' => $groupname,
+                            'description' => $groupname,
+                            };
+            $error = $g->insert;
+            die $error if $error;
+        }
+        push @groupnums, $g->groupnum;
+    }
+    $opt->optionvalue(join(' ',@groupnums));
+    $error = $opt->replace;
+    die $error if $error;
+  }
+  # pass downstream
+  my %exports_in_use;
+  $exports_in_use{ref $_} = 1 foreach qsearch('part_export', {});
+  foreach (keys(%exports_in_use)) {
+    $_->_upgrade_exporttype(%opts) if $_->can('_upgrade_exporttype');
+  }
+}
+

 #=item exporttype2svcdb EXPORTTYPE
 #
 #Returns the applicable I<svcdb> for an I<exporttype>.
 #=item exporttype2svcdb EXPORTTYPE
 #
 #Returns the applicable I<svcdb> for an I<exporttype>.


@@ -439,7 +727,7 @@ foreach my $INC ( @INC ) {
     }
     unless ( keys %$info ) {
       warn "no %info hash found in FS::part_export::$mod, skipping\n"
     }
     unless ( keys %$info ) {
       warn "no %info hash found in FS::part_export::$mod, skipping\n"

-        unless $mod =~ /^(passwdfile|null)$/; #hack but what the heck
+        unless $mod =~ /^(passwdfile|null|.+_Common)$/; #hack but what the heck

       next;
     }
     warn "got export info from FS::part_export::$mod: $info\n" if $DEBUG;
       next;
     }
     warn "got export info from FS::part_export::$mod: $info\n" if $DEBUG;