service dependencies: cust_svc_provision_restrict, RT#33685

3 files changed, 72 insertions, 22 deletions

diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm
index 96409c3..a7aeada 100644
--- a/FS/FS/cust_svc.pm
+++ b/FS/FS/cust_svc.pm
@@ -11,6 +11,7 @@ use FS::Record qw( qsearch qsearchs dbh str2time_sql str2time_sql_closing );
 use FS::part_pkg;
 use FS::part_svc;
 use FS::pkg_svc;
+use FS::part_svc_link;
 use FS::domain_record;
 use FS::part_export;
 use FS::cdr;
@@ -431,11 +432,47 @@ sub check {
            " services for pkgnum ". $self->pkgnum
       if $num_avail <= 0;
 
+    #part_svc_link rules (only make sense in pkgpart context, and 
+    # skipping this when ignore_quantity is set DTRT when we're "forcing"
+    # an implicit change here (location change triggered pkgpart change, 
+    # ->overlimit, bulk customer service changes)
+    foreach my $part_svc_link ( $self->part_svc_link(
+                                  link_type   => 'cust_svc_provision_restrict',
+                                )
+    ) {
+      return $part_svc_link->dst_svc. ' must be provisioned before '.
+             $part_svc_link->src_svc
+        unless qsearchs({
+          'table'    => 'cust_svc',
+          'hashref'  => { 'pkgnum'  => $self->pkgnum,
+                          'svcpart' => $part_svc_link->dst_svcpart,
+                        },
+          'order_by' => 'LIMIT 1',
+        });
+    }
+
   }
 
   $self->SUPER::check;
 }
 
+=item part_svc_link
+
+Returns the service dependencies (see L<FS::part_svc_link>) for the given
+search options, taking into account this service definition as source and
+this customer's agent.
+
+Available options are any field in part_svc_link.  Typically used options are
+link_type.
+
+=cut
+
+sub part_svc_link {
+  my $self = shift;
+  my $agentnum = $self->pkgnum ? $self->cust_pkg->cust_main->agentnum : '';
+  FS::part_svc_link->by_agentnum($agentnum, src_svcpart=>$self->svcpart, @_);
+}
+
 =item display_svcnum 
 
 Returns the displayed service number for this service: agent_svcid if it has a
diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm
index e473d09..4407ec6 100644
--- a/FS/FS/part_pkg.pm
+++ b/FS/FS/part_pkg.pm
@@ -797,17 +797,7 @@ src_svcpart and link_type.
 =cut
 
 sub part_svc_link {
-  my( $self, %opt ) = @_;
-
-  my $agentnum = $self->agentnum;
-
-  qsearch({ 'table'     => 'part_svc_link',
-            'hashref'   => \%opt,
-            'extra_sql' =>
-              $agentnum
-                ? "AND ( agentnum IS NULL OR agentnum = $agentnum )"
-                : 'AND agentnum IS NULL',
-         });
+  FS::part_svc_link->by_agentnum( shift->agentnum, @_ );
 }
 
 =item supersede OLD [, OPTION => VALUE ... ]
diff --git a/FS/FS/part_svc_link.pm b/FS/FS/part_svc_link.pm
index af70d8f..a7f1b0f 100644
--- a/FS/FS/part_svc_link.pm
+++ b/FS/FS/part_svc_link.pm
@@ -2,7 +2,7 @@ package FS::part_svc_link;
 use base qw( FS::Record );
 
 use strict;
-use FS::Record qw( qsearchs ); # qw( qsearch qsearchs );
+use FS::Record qw( qsearch qsearchs );
 
 =head1 NAME
 
@@ -107,10 +107,31 @@ points to.  You can ask the object for a copy with the I<hash> method.
 
 =cut
 
-# the new method can be inherited from FS::Record, if a table method is defined
-
 sub table { 'part_svc_link'; }
 
+=item by_agentnum AGENTNUM, KEY => VALUE, ...
+
+Alternate search consructor.  Given an agentnum then a list of keys and values,
+searches for part_svc_link records with the given agentnum (or no agentnum).
+
+Additional keys and values are searched for in the part_pkg_link table
+(typically src_svcpart and link_type).
+
+=cut
+
+sub by_agentnum {
+  my( $class, $agentnum, %opt ) = @_;
+
+  qsearch({ 'table'     => 'part_svc_link', #$class->table,
+            'hashref'   => \%opt,
+            'extra_sql' =>
+              $agentnum
+                ? "AND ( agentnum IS NULL OR agentnum = $agentnum )"
+                : 'AND agentnum IS NULL',
+         });
+
+}
+
 =item insert
 
 Adds this record to the database.  If there is an error, returns the error,
@@ -166,26 +187,28 @@ sub description {
   #  (and hooks each place we have manual checks for the various rules)
   # but this will do for now
 
-  $self->link_type eq 'part_pkg_restrict'
+  my $l = $self->link_type;
+
+  $l eq 'part_pkg_restrict'
    and return "In package definitions, $dst is required when $src is included";
 
-  $self->link_type eq 'part_pkg_restrict_soft'
+  $l eq 'part_pkg_restrict_soft'
    and return "In package definitions, $dst is suggested when $src is included";
 
-  $self->link_type eq 'cust_svc_provision_restrict'
+  $l eq 'cust_svc_provision_restrict'
    and return "Require $dst provisioning before $src";
 
-  $self->link_type eq 'cust_svc_unprovision_restrict'
+  $l eq 'cust_svc_unprovision_restrict'
    and return "Require $dst unprovisioning before $src";
 
-  $self->link_type eq 'cust_svc_unprovision_cascade'
+  $l eq 'cust_svc_unprovision_cascade'
    and return "Automatically unprovision $dst when $src is unprovisioned";
 
-  $self->link_type eq 'cust_svc_suspend_cascade'
+  $l eq 'cust_svc_suspend_cascade'
    and return "Suspend $dst before $src";
 
-  warn "WARNING: unknown part_svc_link.link_type ". $self->link_type. "\n";
-  return "$src (unknown link_type ". $self->link_type. ") $dst";
+  warn "WARNING: unknown part_svc_link.link_type $l\n";
+  return "$src (unknown link_type $l) $dst";
 
 }