service dependencies: part_pkg_restrict / part_pkg_restrict_soft, RT#33685

7 files changed, 121 insertions, 12 deletions

diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm
index 114acb8..93220ad 100644
--- a/FS/FS/Schema.pm
+++ b/FS/FS/Schema.pm
@@ -3630,7 +3630,7 @@ sub tables_hashref {
       ],
       'primary_key'  => 'svclinknum',
       'unique'       => [ ['agentnum','src_svcpart','dst_svcpart','link_type'] ],
-      'index'        => [ [ 'src_svcpart' ] ],
+      'index'        => [ [ 'src_svcpart' ], [ 'src_svcpart', 'link_type' ], [ 'disabled' ] ],
       'foreign_keys' => [
                           { columns    => [ 'src_svcpart' ],
                             table      => 'part_svc',
diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm
index 540919e..2fba2f4 100644
--- a/FS/FS/part_pkg.pm
+++ b/FS/FS/part_pkg.pm
@@ -301,6 +301,12 @@ sub insert {
       }
     }
 
+    my $error = $self->check_pkg_svc(%options);
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+
   }
 
   if ( $options{'cust_pkg'} ) {
@@ -514,6 +520,7 @@ sub replace {
   my $hidden_svc = $options->{'hidden_svc'} || {};
   my $bulk_skip  = $options->{'bulk_skip'} || {};
   if ( $pkg_svc ) { # if it wasn't passed, don't change existing pkg_svcs
+
     foreach my $part_svc ( qsearch('part_svc', {} ) ) {
       my $quantity  = $pkg_svc->{$part_svc->svcpart} || 0;
       my $hidden    = $hidden_svc->{$part_svc->svcpart} || '';
@@ -564,6 +571,13 @@ sub replace {
         return $error;
       }
     } #foreach $part_svc
+
+    my $error = $new->check_pkg_svc(%$options);
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+
   } #if $options->{pkg_svc}
   
   my @part_pkg_vendor = $old->part_pkg_vendor;
@@ -722,6 +736,84 @@ sub check {
   '';
 }
 
+=item check_pkg_svc
+
+Checks pkg_svc records as a whole (for part_svc_link dependencies).
+
+If there is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub check_pkg_svc {
+  my( $self, %opt ) = @_;
+
+  my $agentnum = $self->agentnum;
+
+  my %pkg_svc = map { $_->svcpart => $_ } $self->pkg_svc;
+
+  foreach my $svcpart ( keys %pkg_svc ) {
+
+    warn 'checking '. $pkg_svc{$svcpart}->svcpart;
+
+    foreach my $part_svc_link ( $self->part_svc_link(
+                                  'src_svcpart' => $svcpart,
+                                  'link_type'   => 'part_pkg_restrict',
+                                )
+    ) {
+
+      use Data::Dumper;
+      warn 'checking '. Dumper($part_svc_link);
+
+      return $part_svc_link->dst_svc. ' must be included with '.
+             $part_svc_link->src_svc
+        unless $pkg_svc{ $part_svc_link->dst_svcpart };
+    }
+
+  }
+
+  return '' if $opt{part_pkg_restrict_soft_override};
+
+  foreach my $svcpart ( keys %pkg_svc ) {
+
+    foreach my $part_svc_link ( $self->part_svc_link(
+                                  'src_svcpart' => $svcpart,
+                                  'link_type'   => 'part_pkg_restrict_soft',
+                                )
+    ) {
+      return $part_svc_link->dst_svc. ' is suggested with '.
+             $part_svc_link->src_svc
+        unless $pkg_svc{ $part_svc_link->dst_svcpart };
+    }
+
+  }
+
+  '';
+}
+
+=item part_svc_link OPTION => VALUE ...
+
+Returns the service dependencies (see L<FS::part_svc_link>) for the given
+search options, taking into account this package definition's agent.
+
+Available options are any field in part_svc_link.  Typically used options are
+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',
+         });
+}
+
 =item supersede OLD [, OPTION => VALUE ... ]
 
 Inserts this package as a successor to the package OLD.  All options are as
diff --git a/FS/FS/part_svc_link.pm b/FS/FS/part_svc_link.pm
index cf82a90..af70d8f 100644
--- a/FS/FS/part_svc_link.pm
+++ b/FS/FS/part_svc_link.pm
@@ -64,15 +64,14 @@ Link type:
 
 # XXX false laziness w/edit/part_svc_link.html
 
-=item part_svc_restrict
+=item part_pkg_restrict
 
 In package defintions, require the destination service definition when the
 source service definition is included
 
-=item part_svc_restrict_soft
+=item part_pkg_restrict_soft
 
-Soft order block: in package definitions, warn if the destination service
-definition is included without the source service definition
+Soft order block: in package definitions,  suggest the destination service definition when the source service definition is included
 
 =item cust_svc_provision_restrict
 
@@ -167,10 +166,10 @@ 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_svc_restrict'
+  $self->link_type eq 'part_pkg_restrict'
    and return "In package definitions, $dst is required when $src is included";
 
-  $self->link_type eq 'part_svc_restrict_soft'
+  $self->link_type 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'
@@ -219,7 +218,6 @@ L<FS::part_svc>).
 
 =cut
 
-
 sub dst_part_svc {
   my $self = shift;
   qsearchs('part_svc', { svcpart=>$self->dst_svcpart } );
@@ -232,7 +230,7 @@ Returns the destination service definition name (part_svc.svc).
 =cut
 
 sub dst_svc {
-  shift->src_part_svc->svc;
+  shift->dst_part_svc->svc;
 }
 
 =back
diff --git a/httemplate/edit/elements/edit.html b/httemplate/edit/elements/edit.html
index 5a7920b..76df820 100644
--- a/httemplate/edit/elements/edit.html
+++ b/httemplate/edit/elements/edit.html
@@ -132,6 +132,9 @@ Example:
 
     'html_init'   => '', #after the header/menubar
 
+    'form_init'   => '', #after html_init, error and the opening <FORM>, but
+                         #before any other form contents
+
     #string or coderef of additional HTML to add before </TABLE>
     'html_table_bottom' => '',
 
@@ -244,6 +247,14 @@ Example:
   <INPUT TYPE="hidden" NAME="svcdb" VALUE="<% $table %>">
   <INPUT TYPE="hidden" NAME="<% $pkey %>" VALUE="<% $clone ? '' : $object->$pkey() %>">
 
+  <% defined($opt{'form_init'}) 
+        ? ( ref($opt{'form_init'})
+              ? &{$opt{'form_init'}}()
+              : $opt{'form_init'}
+          )
+        : ''
+  %>
+
 %   unless ( $opt{'no_pkey_display'} ) {
 
       <FONT SIZE="+1"><B>
diff --git a/httemplate/edit/part_pkg.cgi b/httemplate/edit/part_pkg.cgi
index 6629407..fbc19c3 100755
--- a/httemplate/edit/part_pkg.cgi
+++ b/httemplate/edit/part_pkg.cgi
@@ -559,6 +559,11 @@ my $error_callback = sub {
     'cgiparam'
   );
 
+  if ( $cgi->param('error') =~ / is suggested with / ) {
+    #yeah, detection is a shitty kludge, but we don't have exception objects
+    $opt->{form_init} = '<INPUT TYPE="checkbox" NAME="part_pkg_restrict_soft_override" VALUE="Y"> Override suggestion<BR><BR>';
+  }
+
 };
 
 my $new_hashref_callback = sub { { 'plan' => 'flat' }; };
diff --git a/httemplate/edit/part_svc_link.html b/httemplate/edit/part_svc_link.html
index 64a99d6..c8c385d 100644
--- a/httemplate/edit/part_svc_link.html
+++ b/httemplate/edit/part_svc_link.html
@@ -25,13 +25,13 @@ my @fields = (
     type        => 'select',
     #XXX false laziness w/part_svc_link POD documentation
     options     =>[ qw(
-      part_svc_restrict part_svc_restrict_soft
+      part_pkg_restrict part_pkg_restrict_soft
       cust_svc_provision_restrict cust_svc_unprovision_restrict
       cust_svc_unprovision_cascade cust_svc_suspend_cascade
     )],
     labels      => {
-      part_svc_restrict => 'In package defintions, prevent including the destination service definition unless the source service definition is also included',
-      part_svc_restrict_soft => 'Soft order block: in package definitions, warn if the destination service definition is included without the source service definition',
+      part_pkg_restrict => 'In package defintions, require the destination service definition when the source service definition is included',
+      part_pkg_restrict_soft => 'In package definitions, suggest the destination service definition when the source service definition is included',
       cust_svc_provision_restrict => 'Require the target service to be provisioned before the source service',
       cust_svc_unprovision_restrict => 'Require the target service to be unprovisioned before the source service',
       cust_svc_unprovision_cascade => 'Automatically unprovision the target service when the source service is unprovisioned',
diff --git a/httemplate/edit/process/part_pkg.cgi b/httemplate/edit/process/part_pkg.cgi
index 0343cc0..eda3f33 100755
--- a/httemplate/edit/process/part_pkg.cgi
+++ b/httemplate/edit/process/part_pkg.cgi
@@ -188,6 +188,9 @@ my $args_callback = sub {
     push @args, 'part_pkg_vendor' => \%part_pkg_vendor;
   }
 
+  push @args, 'part_pkg_restrict_soft_override' => 1
+    if $cgi->param('part_pkg_restrict_soft_override');
+
   #warn "args: ".join('/', @args). "\n";
 
   @args;