add option for exports to avoid suspending services, #20739

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

diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm
index 7819a7c..d6357fd 100644 (file)
--- a/FS/FS/part_export.pm
+++ b/FS/FS/part_export.pm
@@ -58,6 +58,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
@@ -337,6 +343,7 @@ 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' ) {
@@ -535,23 +542,6 @@ sub default_export_machine {
   die "no default export hostname for export ".$self->exportnum;
 }
 
-=item svc_role SVC_X
-
-Returns the role that SVC_X 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;
-} 
-
 #these should probably all go away, just let the subclasses define em
 
 =item export_insert SVC_OBJECT
@@ -753,6 +743,61 @@ sub get_dids_npa_select   { 1; }
 # 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