Merge pull request #42 from wtsi-npg/devel

merge from devel for release 0.08

bin/viv.pl

@@ -114,7 +114,7 @@
 			$data_xfer_name = $from_node->{name};
 		}
 		else {
-			croak q[Edges must start or terminate in an EXEC node];
+			croak q[Edges must start or terminate in an EXEC node; from: ], $from_node->{id}, q[, to: ], $to_node->{id};
 		}
 	}
 
@@ -236,10 +236,17 @@ sub _update_node_data_xfer {
 
 	if($node->{type} eq q[EXEC] and $data_xfer_name ne q[]) {
 		if(defined $port) {
+			if(my($inout) = grep {$_} $port=~/_(IN|OUT)__\z/smx , $port=~/\A__(IN|OUT)_/smx ){ # if port has _{IN,OUT}_ {suf,pre}fix convention
+				#ensure port is connected to in manner suggested by naming convention
+				croak 'Node '.($node->{'id'})." port $port connected as ".($edge_side == $FROM?q("from"):q("to")) if (($inout eq q(OUT))^($edge_side == $FROM));
+			} else {
+				$logger->($VLMED, 'Node '.($node->{'id'})." has poorly described port $port (no _{IN,OUT}__ {suf,pre}fix)\n");
+			}
 			my $cmd = $node->{'cmd'};
 			for my$cmd_part ( ref $cmd eq 'ARRAY' ? @{$cmd}[1..$#{$cmd}] : ($node->{'cmd'}) ){
-				$cmd_part =~ s/\Q$port\E/$data_xfer_name/;
-			}
+				return if ($cmd_part =~ s/\Q$port\E/$data_xfer_name/smx);
+			} #if link for port has not been made (port never defined, or already substituted, in node cmd) bail out
+			croak 'Node '.($node->{'id'})." has no port $port";
 		}
 		else {
 			my $node_edge_std = $edge_side == $FROM? q[STDOUT]: q[STDIN];

bin/vtfp.pl

@@ -16,6 +16,7 @@
 use File::Slurp;
 use JSON;
 
+use Storable 'dclone';
 use Carp;
 use Readonly;
 
@@ -124,13 +125,32 @@
 			my $portkey = $1;
 			$portkey ||= q[_stdin_];
 
-			my $port;
-			unless(($port = $subgraph_nodes_in->{$portkey})) {
+			my $ports = $subgraph_nodes_in->{$portkey};
+			unless($ports) {
 				$logger->($VLFATAL, q[Failed to map port in subgraph: ], $vtnode->{id}, q[:], $portkey);
 			}
+			my $pt = ref $ports;
+			if($pt) {
+				if($pt ne q[ARRAY]) {
+					$logger->($VLFATAL, q[Input ports specification values in subgraphs must be string or array ref. Type ], $pt, q[ not allowed]);
+				}
+			}
+			else {
+				$ports = [ $ports ];
+			}
 
 			# do check for existence of port in 
-			$edge->{to} = sprintf "%03d_%s", $arbitrary_prefix, $port;
+			for my $i (0..$#$ports) {
+				my $mod_edge;
+				if($i > 0) {
+					$mod_edge = dclone $edge;
+					push @{$cfg->{edges}}, $mod_edge;
+				}
+				else {
+					$mod_edge = $edge;
+				}
+				$mod_edge->{to} = sprintf "%03d_%s", $arbitrary_prefix, $ports->[$i];
+			}
 		}
 		else {
 			$logger->($VLMIN, q[Currently only edges to stdin processed when remapping VTFILE edges. Not processing: ], $edge->{to}, q[ in edge: ], $edge->{id});