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($)
#
# 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)) {
$rspec = GeniXML::Parse($rspec);
......@@ -2138,6 +2138,19 @@ sub GetBindings($$$)
$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.
#
......@@ -2148,62 +2161,110 @@ sub GetBindings($$$)
# Process each item in the dataset.
#
$processSet = sub {
my ($ref, $bindings) = @_;
my ($ref) = @_;
my $which = $ref->nodeName();
if ($which eq "data_list") {
my $name = GeniXML::GetText("name", $ref);
my @list = ();
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, $value);
}
elsif ($nodeName eq "data_struct") {
my $b = {};
&$processSet($child, $b);
push(@list, $b);
}
push(@list, &$processSet($child));
}
# Not sure why the name is in dotted notation. Kill it.
my @tokens = split(/[.]/, $name);
if (@tokens > 1) {
$name = pop(@tokens);
if ($asparamdefs) {
return {"value" => \@list};
}
$bindings->{$name} = \@list;
return \@list;
}
elsif ($which eq "data_struct") {
my $b = {};
foreach my $child ($ref->childNodes()) {
my $nodeName = $child->nodeName();
&$processSet($child, $bindings);
next
if ($child->nodeName() !~ /^data/);
my $childname = &$getName($child);
$b->{$childname} = &$processSet($child);
}
if ($asparamdefs) {
return {"value" => $b};
}
return $b;
}
elsif ($which eq "data_item" ||
$which eq "data_member_item") {
my $name = GeniXML::GetText("name", $ref);
my $value = $ref->findvalue('.');
# Not sure why the name is in dotted notation. Kill it.
my @tokens = split(/[.]/, $name);
if (@tokens > 1) {
$name = pop(@tokens);
if ($asparamdefs) {
$value = {"value" => $value};
}
$bindings->{$name} = $value;
return $value;
}
};
foreach my $ref ($dataset->childNodes()) {
next
if ($ref->nodeName() !~ /^data/ || $ref->nodeName eq "data_set");
&$processSet($ref, $bindings);
my $name = &$getName($ref);
my $value = &$processSet($ref);
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;
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;
use emdb;
......
......@@ -45,7 +45,7 @@ sub usage()
print("Usage: manage_profile delete -a <profile>\n");
print("Usage: manage_profile undelete pid,name:version\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 ".
"[-u user] [-m description] [-b] add <name> <profile> <instance>\n");
print("Usage: manage_profile paramset ".
......@@ -1749,7 +1749,8 @@ sub UseNewGenilib($)
#
sub Bindings()
{
my $optlist = "";
my $optlist = "p";
my $asparamdefs= 0;
my $bindings;
my $errmsg;
......@@ -1757,16 +1758,15 @@ sub Bindings()
if (! getopts($optlist, \%options)) {
usage();
}
if (defined($options{"p"})) {
$asparamdefs = 1;
}
usage()
if (@ARGV != 2);
if (@ARGV != 1);
my $profile = APT_Profile->Lookup($ARGV[0]);
if (!defined($profile)) {
fatal("No such profile exists: " . $ARGV[0]);
}
my $instance = APT_Instance->Lookup($ARGV[1]);
my $instance = APT_Instance->Lookup($ARGV[0]);
if (!$instance) {
$instance = APT_Instance::History->Lookup($ARGV[1]);
$instance = APT_Instance::History->Lookup($ARGV[0]);
if (!$instance) {
fatal("No such instance");
}
......@@ -1776,7 +1776,7 @@ sub Bindings()
if (! defined($rspec)) {
fatal("Could not parse rspec");
}
if (APT_Profile::GetBindings($rspec, \$bindings, \$errmsg)) {
if (APT_Profile::GetBindings($rspec, \$bindings, \$errmsg, $asparamdefs)) {
fatal($errmsg);
}
if (defined($webtask)) {
......@@ -1794,8 +1794,9 @@ sub Bindings()
#
sub ParamSet()
{
my $optlist = "u:m:b";
my $optlist = "u:m:bp";
my $bound = 0;
my $asparamdefs= 0;
my $user;
my $description;
my $bindings;
......@@ -1895,7 +1896,7 @@ sub ParamSet()
if (! defined($rspec)) {
fatal("Could not parse rspec");
}
if (APT_Profile::GetBindings($rspec, \$bindings, \$errmsg)) {
if (APT_Profile::GetBindings($rspec, \$bindings, \$errmsg, 0)) {
fatal($errmsg);
}
print Dumper($bindings);
......
......@@ -149,7 +149,7 @@ function Do_GetParameters()
$retval = SUEXEC($this_user->uid(), "nobody",
"webmanage_profile -t $webtask_id -- ".
" bindings $profile_uuid $rerun_uuid ",
" bindings $rerun_uuid ",
SUEXEC_ACTION_CONTINUE);
$webtask->Refresh();
......@@ -253,7 +253,7 @@ function Do_GetPreviousBindings()
$retval = SUEXEC($this_user->uid(), "nobody",
"webmanage_profile -t $webtask_id -- ".
" bindings $profile_uuid $rerun_uuid ",
" bindings $rerun_uuid ",
SUEXEC_ACTION_CONTINUE);
$webtask->Refresh();
......
......@@ -85,7 +85,7 @@ function Do_HistoryRecord()
$retval = SUEXEC($this_user->uid(), "nobody",
"webmanage_profile -t $webtask_id -- ".
" bindings $profile_uuid $uuid ",
" bindings $uuid ",
SUEXEC_ACTION_CONTINUE);
$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