svc_hardware: better error messages for bad hw_addr when not validating as a MAC...
[freeside.git] / FS / FS / part_export.pm
index ed66b41..96fb85f 100644 (file)
@@ -1,16 +1,16 @@
 package FS::part_export;
+use base qw( FS::option_Common FS::m2m_Common );
 
 use strict;
 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::part_svc;
 use FS::part_export_option;
 use FS::part_export_machine;
 use FS::svc_export_machine;
-use FS::export_svc;
+use FS::export_cust_svc;
 
 #for export modules, though they should probably just use it themselves
 use FS::queue;
@@ -59,6 +59,12 @@ fields are currently supported:
 
 =item nodomain - blank or "Y" : usernames are exported to this service with no domain
 
+=item default_machine - For exports that require a machine to be selected for
+each service (see L<FS::svc_export_machine>), the one to use as the default.
+
+=item no_suspend - Don't export service suspensions. In the future there may
+be "no_*" options for the other service actions.
+
 =back
 
 =head1 METHODS
@@ -125,31 +131,14 @@ sub insert {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
-  my $error = $self->SUPER::insert(@_);
+  my $error = $self->SUPER::insert(@_)
+           || $self->replace;
+  # use replace to do all the part_export_machine and default_machine stuff
   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;
   '';
 }
@@ -174,11 +163,26 @@ sub delete {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
+  # delete associated export_cust_svc
+  foreach my $export_cust_svc ( 
+    qsearch('export_cust_svc',{ 'exportnum' => $self->exportnum })
+  ) {
+    my $error = $export_cust_svc->delete;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+  }
+
   # clean up export_nas records
   my $error = $self->process_m2m(
     'link_table'    => 'export_nas',
     'target_table'  => 'nas',
     'params'        => [],
+  ) || $self->process_m2m(
+    'link_table'    => 'export_svc',
+    'target_table'  => 'part_svc',
+    'params'        => [],
   ) || $self->SUPER::delete;
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
@@ -217,6 +221,7 @@ or modified.
 
 sub replace {
   my $self = shift;
+  my $old = $self->replace_old;
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
@@ -228,12 +233,7 @@ sub replace {
   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;
-  }
+  my $error;
 
   if ( $self->part_export_machine_textarea ) {
 
@@ -258,6 +258,10 @@ sub replace {
           }
         }
 
+        if ( $self->default_machine_name eq $machine ) {
+          $self->default_machine( $part_export_machine{$machine}->machinenum );
+        }
+
         delete $part_export_machine{$machine}; #so we don't disable it below
 
       } else {
@@ -272,11 +276,13 @@ sub replace {
           return $error;
         }
   
+        if ( $self->default_machine_name eq $machine ) {
+          $self->default_machine( $part_export_machine->machinenum );
+        }
       }
 
     }
 
-
     foreach my $part_export_machine ( values %part_export_machine ) {
       $part_export_machine->disabled('Y');
       $error = $part_export_machine->replace;
@@ -286,6 +292,48 @@ sub replace {
       }
     }
 
+    if ( $old->machine ne '_SVC_MACHINE' ) {
+      # then set up the default for any already-attached export_svcs
+      foreach my $export_svc ( $self->export_svc ) {
+        my @svcs = qsearch('cust_svc', { 'svcpart' => $export_svc->svcpart });
+        foreach my $cust_svc ( @svcs ) {
+          my $svc_export_machine = FS::svc_export_machine->new({
+              'exportnum'   => $self->exportnum,
+              'svcnum'      => $cust_svc->svcnum,
+              'machinenum'  => $self->default_machine,
+          });
+          $error ||= $svc_export_machine->insert;
+        }
+      }
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return $error;
+      }
+    } # if switching to selectable hosts
+
+  } elsif ( $old->machine eq '_SVC_MACHINE' ) {
+    # then we're switching from selectable to non-selectable
+    foreach my $svc_export_machine (
+      qsearch('svc_export_machine', { 'exportnum' => $self->exportnum })
+    ) {
+      $error ||= $svc_export_machine->delete;
+    }
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+
+  }
+
+  $error = $self->SUPER::replace(@_);
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }
+
+  if ( $self->machine eq '_SVC_MACHINE' and ! $self->default_machine ) {
+    $dbh->rollback if $oldAutoCommit;
+    return "no default export host selected";
   }
 
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
@@ -307,7 +355,15 @@ sub check {
     || $self->ut_textn('exportname')
     || $self->ut_domainn('machine')
     || $self->ut_alpha('exporttype')
+    || $self->ut_flag('no_suspend')
   ;
+
+  if ( $self->machine eq '_SVC_MACHINE' ) {
+    $error ||= $self->ut_numbern('default_machine')
+  } else {
+    $self->set('default_machine', '');
+  }
+
   return $error if $error;
 
   $self->nodomain =~ /^(Y?)$/ or return "Illegal nodomain: ". $self->nodomain;
@@ -415,24 +471,10 @@ sub part_export_machine {
 
 Returns a list of associated FS::export_svc records.
 
-=cut
-
-sub export_svc {
-  my $self = shift;
-  qsearch('export_svc', { 'exportnum' => $self->exportnum } );
-}
-
 =item export_device
 
 Returns a list of associated FS::export_device records.
 
-=cut
-
-sub export_device {
-  my $self = shift;
-  qsearch('export_device', { 'exportnum' => $self->exportnum } );
-}
-
 =item part_export_option
 
 Returns all options as FS::part_export_option objects (see
@@ -471,7 +513,9 @@ sub _rebless {
   $self;
 }
 
-=item svc_machine
+=item svc_machine SVC_X
+
+Return the export hostname for SVC_X.
 
 =cut
 
@@ -483,23 +527,46 @@ sub 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);
+  });
+
+  if (!$svc_export_machine) {
+    warn "No hostname selected for ".($self->exportname || $self->exporttype);
+    return $self->default_export_machine->machine;
+  }
 
   return $svc_export_machine->part_export_machine->machine;
 }
 
-#these should probably all go away, just let the subclasses define em
+=item default_export_machine
+
+Return the default export hostname for this export.
+
+=cut
+
+sub default_export_machine {
+  my $self = shift;
+  my $machinenum = $self->default_machine;
+  if ( $machinenum ) {
+    my $default_machine = FS::part_export_machine->by_key($machinenum);
+    return $default_machine->machine if $default_machine;
+  }
+  # this should not happen
+  die "no default export hostname for export ".$self->exportnum;
+}
 
 =item export_insert SVC_OBJECT
 
 =cut
 
+# Do not overload!  Overload _export_insert instead
+
 sub export_insert {
   my $self = shift;
   #$self->rebless;
+  if ( $FS::svc_Common::noexport_hack ) {
+    carp "export_insert() suppressed by noexport_hack" if $DEBUG;
+    return;
+  }
   $self->_export_insert(@_);
 }
 
@@ -516,9 +583,15 @@ sub export_insert {
 
 =cut
 
+# Do not overload!  Overload _export_replace instead
+
 sub export_replace {
   my $self = shift;
   #$self->rebless;
+  if ( $FS::svc_Common::noexport_hack ) {
+    carp "export_replace() suppressed by noexport_hack" if $DEBUG;
+    return;
+  }
   $self->_export_replace(@_);
 }
 
@@ -526,9 +599,15 @@ sub export_replace {
 
 =cut
 
+# Do not overload!  Overload _export_delete instead
+
 sub export_delete {
   my $self = shift;
   #$self->rebless;
+  if ( $FS::svc_Common::noexport_hack ) {
+    carp "export_delete() suppressed by noexport_hack" if $DEBUG;
+    return;
+  }
   $self->_export_delete(@_);
 }
 
@@ -536,9 +615,15 @@ sub export_delete {
 
 =cut
 
+# Do not overload!  Overload _export_suspend instead
+
 sub export_suspend {
   my $self = shift;
   #$self->rebless;
+  if ( $FS::svc_Common::noexport_hack ) {
+    carp "export_suspend() suppressed by noexport_hack" if $DEBUG;
+    return;
+  }
   $self->_export_suspend(@_);
 }
 
@@ -546,9 +631,15 @@ sub export_suspend {
 
 =cut
 
+# Do not overload!  Overload _export_unsuspend instead
+
 sub export_unsuspend {
   my $self = shift;
   #$self->rebless;
+  if ( $FS::svc_Common::noexport_hack ) {
+    carp "export_unsuspend() suppressed by noexport_hack" if $DEBUG;
+    return;
+  }
   $self->_export_unsuspend(@_);
 }
 
@@ -575,7 +666,7 @@ sub _export_suspend {
   #warn "warning: _export_suspened unimplemented for". ref($self);
   my $svc_x = shift;
   my $new = $svc_x->clone_suspended;
-  $self->_export_replace( $new, $svc_x );
+  $self->export_replace( $new, $svc_x );
 }
 
 sub _export_unsuspend {
@@ -583,7 +674,82 @@ sub _export_unsuspend {
   #warn "warning: _export_unsuspend unimplemented for ". ref($self);
   my $svc_x = shift;
   my $old = $svc_x->clone_kludge_unsuspend;
-  $self->_export_replace( $svc_x, $old );
+  $self->export_replace( $svc_x, $old );
+}
+
+=item get_remoteid SVC
+
+Returns the remote id for this export for the given service.
+
+=cut
+
+sub get_remoteid {
+  my ($self, $svc_x) = @_;
+
+  my $export_cust_svc = qsearchs('export_cust_svc',{
+    'exportnum' => $self->exportnum,
+    'svcnum' => $svc_x->svcnum
+  });
+
+  return $export_cust_svc ? $export_cust_svc->remoteid : '';
+}
+
+=item set_remoteid SVC VALUE
+
+Sets the remote id for this export for the given service.
+See L<FS::export_cust_svc>.
+
+If value is true, inserts or updates export_cust_svc record.
+If value is false, deletes any existing record.
+
+Returns error message, blank on success.
+
+=cut
+
+sub set_remoteid {
+  my ($self, $svc_x, $value) = @_;
+
+  my $export_cust_svc = qsearchs('export_cust_svc',{
+    'exportnum' => $self->exportnum,
+    'svcnum' => $svc_x->svcnum
+  });
+
+  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 = '';
+  if ($value) {
+    if ($export_cust_svc) {
+      $export_cust_svc->set('remoteid',$value);
+      $error = $export_cust_svc->replace;
+    } else {
+      $export_cust_svc = new FS::export_cust_svc {
+        'exportnum' => $self->exportnum,
+        'svcnum' => $svc_x->svcnum,
+        'remoteid' => $value
+      };
+      $error = $export_cust_svc->insert;
+    }
+  } else {
+    if ($export_cust_svc) {
+      $error = $export_cust_svc->delete;
+    } #otherwise, it already doesn't exist
+  }
+
+  if ($oldAutoCommit) {
+    $dbh->rollback if $error;
+    $dbh->commit unless $error;
+  }
+
+  return $error;  
 }
 
 =item export_links SVC_OBJECT ARRAYREF
@@ -601,6 +767,17 @@ 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).
 
+=item actions
+
+Adds one or more "action" links to the export's display in 
+browse/part_export.cgi.  Should return pairs of values.  The first is 
+the link label; the second is the Mason path to a document to load.
+The document will show in a popup.
+
+=cut
+
+sub actions { }
+
 =cut
 
 =item weight
@@ -628,6 +805,121 @@ sub info {
   };
 }
 
+=item get_dids SELECTION
+
+Does several things, which is unfortunate. DID phone numbers are organized
+in a sort-of hierarchy: state, areacode, exchange, number. Or, for some 
+vendors: state, region, number. But not always that, either.
+
+SELECTION is one or more field/value pairs specifying parts of the hierarchy
+that have already been selected.  C<get_dids> will then return an arrayref of
+the possible values for the next selection level. Note that these are not
+actual DIDs except at the lowest level.
+
+Generally, 'state' alone will return an array of area codes or region names
+in the state.
+
+'state' and 'areacode' together will return an array of either:
+- exchange strings of the form "New York (212-555-XXXX)"
+- ratecenter names of the form "New York, NY"
+
+These strings are sent back to the UI and offered as options so that the user
+can choose the local calling area they like.
+
+'areacode' and 'exchange', or 'state' and 'ratecenter', or 'region' by itself
+will return an array of actual DID numbers.
+
+Passing 'tollfree' with a true value will override the whole hierarchy and
+return an array of tollfree numbers.
+
+C<get_dids> methods should report errors via die().
+
+=cut
+
+# no stub; can('get_dids') should return false by default
+
+#default fallbacks... FS::part_export::DID_Common ?
+sub can_get_dids { 0; }
+sub get_dids_can_tollfree { 0; }
+sub get_dids_can_manual   { 0; }
+sub get_dids_can_edit     { 0; } #don't use without can_manual, otherwise the
+                                 # DID selector provisions a new number from
+                                 # inventory each edit
+sub get_dids_npa_select   { 1; }
+
+# get_dids_npa_select: if true, then prompt to select state, then area code,
+# then city/exchange, then phone number.
+# if false, then prompt to select state (actually province), then "region",
+# then phone number.
+#
+# get_dids_can_manual: if true, then there will be a radio button to enter
+# a phone number manually.
+#
+# get_dids_can_tollfree: if true, then the user will be prompted to choose
+# both a regular and a toll-free number. The export can have a 
+# 'restrict_selection' option to enable only one or the other of those. See
+# part_export/vitelity.pm for an example.
+#
+# get_dids_can_edit: if true, then the user can use the selector again to
+# change the phone number for a service. if false, then they can't (have to
+# reprovision completely).
+
+=item svc_role SVC
+
+Returns the role that SVC occupies with respect to this export, if any.
+This is part of the part_svc's export configuration.
+
+=cut
+
+sub svc_role {
+  my $self = shift;
+  my $svc_x = shift;
+  my $cust_svc = $svc_x->cust_svc or return '';
+  my $export_svc = qsearchs('export_svc', { exportnum => $self->exportnum,
+                                            svcpart   => $cust_svc->svcpart })
+                   or return '';
+  $export_svc->role;
+} 
+
+=item svc_with_role { SVC | PKGNUM }, ROLE
+
+Given a svc_* object SVC or pkgnum PKG, and a role name ROLE, finds the
+service(s) in the same package that are linked to this export with ROLE.
+
+=cut
+
+sub svc_with_role {
+  my $self = shift;
+  my $svc_or_pkgnum = shift;
+  my $role = shift; 
+  my $pkgnum;
+  if ( ref $svc_or_pkgnum ) {
+    $pkgnum = $svc_or_pkgnum->cust_svc->pkgnum or return '';
+  } else {
+    $pkgnum = $svc_or_pkgnum;
+  }
+  my $role_info = $self->info->{roles}->{$role}
+    or die "role '$role' does not exist for export '".$self->exporttype."'\n";
+  my $svcdb = $role_info->{svcdb};
+
+  my @svcs = qsearch({
+    'table'     =>  $svcdb,
+    'addl_from' =>  ' JOIN cust_svc USING (svcnum)' .
+                    ' JOIN export_svc USING (svcpart)',
+    'extra_sql' =>  " WHERE cust_svc.pkgnum = $pkgnum" .
+                    " AND export_svc.exportnum = ".$self->exportnum .
+                    " AND export_svc.role = '$role'",
+  });               
+  if ( $role_info->{multiple} ) {
+    return @svcs;
+  } else {
+    if ( @svcs > 1 ) {
+      warn "multiple $role services in pkgnum $pkgnum; returning the first one.\n";
+    }
+    return $svcs[0];
+  }
+}
+
 =back
 
 =head1 SUBROUTINES
@@ -684,6 +976,55 @@ sub _upgrade_data {  #class method
     $error = $opt->replace;
     die $error if $error;
   }
+  # for exports that have selectable hostnames, make sure all services
+  # have a hostname selected
+  foreach my $part_export (
+    qsearch('part_export', { 'machine' => '_SVC_MACHINE' })
+  ) {
+
+    my $exportnum = $part_export->exportnum;
+    my $machinenum = $part_export->default_machine;
+    if (!$machinenum) {
+      my ($first) = $part_export->part_export_machine;
+      if (!$first) {
+        # user intervention really is required.
+        die "Export $exportnum has no hostname options defined.\n".
+            "You must correct this before upgrading.\n";
+      }
+      # warn about this, because we might not choose the right one
+      warn "Export $exportnum (". $part_export->exporttype.
+           ") has no default hostname.  Setting to ".$first->machine."\n";
+      $machinenum = $first->machinenum;
+      $part_export->set('default_machine', $machinenum);
+      my $error = $part_export->replace;
+      die $error if $error;
+    }
+
+    # the service belongs to a service def that uses this export
+    # and there is not a hostname selected for this export for that service
+    my $join = ' JOIN export_svc USING ( svcpart )'.
+               ' LEFT JOIN svc_export_machine'.
+               ' ON ( cust_svc.svcnum = svc_export_machine.svcnum'.
+               ' AND export_svc.exportnum = svc_export_machine.exportnum )';
+
+    my @svcs = qsearch( {
+          'select'    => 'cust_svc.*',
+          'table'     => 'cust_svc',
+          'addl_from' => $join,
+          'extra_sql' => ' WHERE svcexportmachinenum IS NULL'.
+                         ' AND export_svc.exportnum = '.$part_export->exportnum,
+      } );
+    foreach my $cust_svc (@svcs) {
+      my $svc_export_machine = FS::svc_export_machine->new({
+          'exportnum'   => $exportnum,
+          'machinenum'  => $machinenum,
+          'svcnum'      => $cust_svc->svcnum,
+      });
+      my $error = $svc_export_machine->insert;
+      die $error if $error;
+    }
+  }
+
   # pass downstream
   my %exports_in_use;
   $exports_in_use{ref $_} = 1 foreach qsearch('part_export', {});