Commit 979c4f5d authored by Leigh Stoller's avatar Leigh Stoller

Some code to convert between old style geni-lib param bindings and new.

parent b24aeee3
...@@ -2115,9 +2115,9 @@ sub Convert2Genilib($) ...@@ -2115,9 +2115,9 @@ sub Convert2Genilib($)
# #
# Convert data_set in rspec to simplified bindings array. # Convert data_set in rspec to simplified bindings array.
# #
sub GetBindings($$$) sub GetBindings($$$;$)
{ {
my ($rspec, $pbindings, $perrmsg) = @_; my ($rspec, $pbindings, $perrmsg, $asparamdefs) = @_;
if (!ref($rspec)) { if (!ref($rspec)) {
$rspec = GeniXML::Parse($rspec); $rspec = GeniXML::Parse($rspec);
...@@ -2138,6 +2138,19 @@ sub GetBindings($$$) ...@@ -2138,6 +2138,19 @@ sub GetBindings($$$)
$dataset = $rspec; $dataset = $rspec;
} }
# This is silly.
my $getName = sub {
my ($ref) = @_;
my $name = GeniXML::GetText("name", $ref);
# Not sure why the name is in dotted notation. Kill it.
my @tokens = split(/[.]/, $name);
if (@tokens > 1) {
$name = pop(@tokens);
}
return $name;
};
# #
# Convert XML goo to multilevel array of bindings. # Convert XML goo to multilevel array of bindings.
# #
...@@ -2148,62 +2161,110 @@ sub GetBindings($$$) ...@@ -2148,62 +2161,110 @@ sub GetBindings($$$)
# Process each item in the dataset. # Process each item in the dataset.
# #
$processSet = sub { $processSet = sub {
my ($ref, $bindings) = @_; my ($ref) = @_;
my $which = $ref->nodeName(); my $which = $ref->nodeName();
if ($which eq "data_list") { if ($which eq "data_list") {
my $name = GeniXML::GetText("name", $ref);
my @list = (); my @list = ();
foreach my $child ($ref->childNodes()) { foreach my $child ($ref->childNodes()) {
my $nodeName = $child->nodeName(); next
if ($child->nodeName() !~ /^data/);
if ($nodeName eq "data_member_item") {
my $value = $child->findvalue('.'); push(@list, &$processSet($child));
push(@list, $value);
}
elsif ($nodeName eq "data_struct") {
my $b = {};
&$processSet($child, $b);
push(@list, $b);
}
} }
# Not sure why the name is in dotted notation. Kill it. if ($asparamdefs) {
my @tokens = split(/[.]/, $name); return {"value" => \@list};
if (@tokens > 1) {
$name = pop(@tokens);
} }
$bindings->{$name} = \@list; return \@list;
} }
elsif ($which eq "data_struct") { elsif ($which eq "data_struct") {
my $b = {};
foreach my $child ($ref->childNodes()) { foreach my $child ($ref->childNodes()) {
my $nodeName = $child->nodeName(); next
&$processSet($child, $bindings); if ($child->nodeName() !~ /^data/);
my $childname = &$getName($child);
$b->{$childname} = &$processSet($child);
}
if ($asparamdefs) {
return {"value" => $b};
} }
return $b;
} }
elsif ($which eq "data_item" || elsif ($which eq "data_item" ||
$which eq "data_member_item") { $which eq "data_member_item") {
my $name = GeniXML::GetText("name", $ref);
my $value = $ref->findvalue('.'); my $value = $ref->findvalue('.');
# Not sure why the name is in dotted notation. Kill it. if ($asparamdefs) {
my @tokens = split(/[.]/, $name); $value = {"value" => $value};
if (@tokens > 1) {
$name = pop(@tokens);
} }
$bindings->{$name} = $value; return $value;
} }
}; };
foreach my $ref ($dataset->childNodes()) { foreach my $ref ($dataset->childNodes()) {
next next
if ($ref->nodeName() !~ /^data/ || $ref->nodeName eq "data_set"); if ($ref->nodeName() !~ /^data/ || $ref->nodeName eq "data_set");
my $name = &$getName($ref);
my $value = &$processSet($ref);
&$processSet($ref, $bindings); print "$name\n";
print Dumper($value);
#
# This was a bad decision, need to fix. Top level struct.
#
if (!$asparamdefs && $ref->nodeName() eq "struct") {
foreach my $key (keys(%{$value})) {
$bindings->{$key} = $value->{$key};
}
}
else {
$bindings->{$name} = $value;
}
} }
$$pbindings = $bindings; $$pbindings = $bindings;
return 0; return 0;
} }
sub BindingsToParams($)
{
my ($bindings) = @_;
my $paramdefs = {};
my $convert;
$convert = sub {
my ($val) = @_;
if (!ref($val)) {
return {"value" => $val};
}
if (ref($val) eq "ARRAY") {
my @list = ();
foreach my $v (@{$val}) {
push(@list, &$convert($v));
}
return {"value" => \@list};
}
my $b = {};
foreach my $k (keys(%{$val})) {
$b->{$k} = &$convert($val->{$k});
}
return $b;
};
foreach my $key (keys(%{$bindings})) {
my $val = $bindings->{$key};
$paramdefs->{$key} = &$convert($val);
}
return $paramdefs;
}
################################################################### ###################################################################
package APT_Profile::ImageInfo; package APT_Profile::ImageInfo;
use emdb; use emdb;
......
...@@ -45,7 +45,7 @@ sub usage() ...@@ -45,7 +45,7 @@ sub usage()
print("Usage: manage_profile delete -a <profile>\n"); print("Usage: manage_profile delete -a <profile>\n");
print("Usage: manage_profile undelete pid,name:version\n"); print("Usage: manage_profile undelete pid,name:version\n");
print("Usage: manage_profile listimages <profile>\n"); print("Usage: manage_profile listimages <profile>\n");
print("Usage: manage_profile bindings <profile> <instance>\n"); print("Usage: manage_profile bindings <instance>\n");
print("Usage: manage_profile paramset ". print("Usage: manage_profile paramset ".
"[-u user] [-m description] [-b] add <name> <profile> <instance>\n"); "[-u user] [-m description] [-b] add <name> <profile> <instance>\n");
print("Usage: manage_profile paramset ". print("Usage: manage_profile paramset ".
...@@ -1749,7 +1749,8 @@ sub UseNewGenilib($) ...@@ -1749,7 +1749,8 @@ sub UseNewGenilib($)
# #
sub Bindings() sub Bindings()
{ {
my $optlist = ""; my $optlist = "p";
my $asparamdefs= 0;
my $bindings; my $bindings;
my $errmsg; my $errmsg;
...@@ -1757,16 +1758,15 @@ sub Bindings() ...@@ -1757,16 +1758,15 @@ sub Bindings()
if (! getopts($optlist, \%options)) { if (! getopts($optlist, \%options)) {
usage(); usage();
} }
if (defined($options{"p"})) {
$asparamdefs = 1;
}
usage() usage()
if (@ARGV != 2); if (@ARGV != 1);
my $profile = APT_Profile->Lookup($ARGV[0]); my $instance = APT_Instance->Lookup($ARGV[0]);
if (!defined($profile)) {
fatal("No such profile exists: " . $ARGV[0]);
}
my $instance = APT_Instance->Lookup($ARGV[1]);
if (!$instance) { if (!$instance) {
$instance = APT_Instance::History->Lookup($ARGV[1]); $instance = APT_Instance::History->Lookup($ARGV[0]);
if (!$instance) { if (!$instance) {
fatal("No such instance"); fatal("No such instance");
} }
...@@ -1776,7 +1776,7 @@ sub Bindings() ...@@ -1776,7 +1776,7 @@ sub Bindings()
if (! defined($rspec)) { if (! defined($rspec)) {
fatal("Could not parse rspec"); fatal("Could not parse rspec");
} }
if (APT_Profile::GetBindings($rspec, \$bindings, \$errmsg)) { if (APT_Profile::GetBindings($rspec, \$bindings, \$errmsg, $asparamdefs)) {
fatal($errmsg); fatal($errmsg);
} }
if (defined($webtask)) { if (defined($webtask)) {
...@@ -1794,8 +1794,9 @@ sub Bindings() ...@@ -1794,8 +1794,9 @@ sub Bindings()
# #
sub ParamSet() sub ParamSet()
{ {
my $optlist = "u:m:b"; my $optlist = "u:m:bp";
my $bound = 0; my $bound = 0;
my $asparamdefs= 0;
my $user; my $user;
my $description; my $description;
my $bindings; my $bindings;
...@@ -1895,7 +1896,7 @@ sub ParamSet() ...@@ -1895,7 +1896,7 @@ sub ParamSet()
if (! defined($rspec)) { if (! defined($rspec)) {
fatal("Could not parse rspec"); fatal("Could not parse rspec");
} }
if (APT_Profile::GetBindings($rspec, \$bindings, \$errmsg)) { if (APT_Profile::GetBindings($rspec, \$bindings, \$errmsg, 0)) {
fatal($errmsg); fatal($errmsg);
} }
print Dumper($bindings); print Dumper($bindings);
......
...@@ -149,7 +149,7 @@ function Do_GetParameters() ...@@ -149,7 +149,7 @@ function Do_GetParameters()
$retval = SUEXEC($this_user->uid(), "nobody", $retval = SUEXEC($this_user->uid(), "nobody",
"webmanage_profile -t $webtask_id -- ". "webmanage_profile -t $webtask_id -- ".
" bindings $profile_uuid $rerun_uuid ", " bindings $rerun_uuid ",
SUEXEC_ACTION_CONTINUE); SUEXEC_ACTION_CONTINUE);
$webtask->Refresh(); $webtask->Refresh();
...@@ -253,7 +253,7 @@ function Do_GetPreviousBindings() ...@@ -253,7 +253,7 @@ function Do_GetPreviousBindings()
$retval = SUEXEC($this_user->uid(), "nobody", $retval = SUEXEC($this_user->uid(), "nobody",
"webmanage_profile -t $webtask_id -- ". "webmanage_profile -t $webtask_id -- ".
" bindings $profile_uuid $rerun_uuid ", " bindings $rerun_uuid ",
SUEXEC_ACTION_CONTINUE); SUEXEC_ACTION_CONTINUE);
$webtask->Refresh(); $webtask->Refresh();
......
...@@ -85,7 +85,7 @@ function Do_HistoryRecord() ...@@ -85,7 +85,7 @@ function Do_HistoryRecord()
$retval = SUEXEC($this_user->uid(), "nobody", $retval = SUEXEC($this_user->uid(), "nobody",
"webmanage_profile -t $webtask_id -- ". "webmanage_profile -t $webtask_id -- ".
" bindings $profile_uuid $uuid ", " bindings $uuid ",
SUEXEC_ACTION_CONTINUE); SUEXEC_ACTION_CONTINUE);
$webtask->Refresh(); $webtask->Refresh();
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment