--- loncom/lonnet/perl/lonnet.pm 2003/03/14 21:45:20 1.317.2.2 +++ loncom/lonnet/perl/lonnet.pm 2003/01/28 00:09:57 1.320 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.317.2.2 2003/03/14 21:45:20 albertel Exp $ +# $Id: lonnet.pm,v 1.320 2003/01/28 00:09:57 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1744,6 +1744,57 @@ sub dump { return %returnhash; } +# --------------------------------------------------------------- currentdump +sub currentdump { + my ($namespace,$udomain,$uname)=@_; + if (!$udomain) { $udomain = $ENV{'user.domain'}; } + if (!$uname) { $uname = $ENV{'user.name'}; } + my $uhome = &homeserver($uname,$udomain); + my $rep=reply("currentdump:$udomain:$uname:$namespace",$uhome); + return if ($rep =~ /^(error:|no_such_host)/); + # + my %returnhash=(); + # + if ($rep eq "unknown_cmd") { + # an old lond will not know currentdump + # Do a dump and make it look like a currentdump + my @tmp = &dump($namespace,$udomain,$uname,'.'); + return if ($tmp[0] =~ /^(error:|no_such_host)/); + my %hash = @tmp; + @tmp=(); + # Code ripped from lond, essentially. The only difference + # here is the unescaping done by lonnet::dump(). Conceivably + # we might run in to problems with parameter names =~ /^v\./ + while (my ($key,$value) = each(%hash)) { + my ($v,$symb,$param) = split(/:/,$key); + next if ($v eq 'version' || $symb eq 'keys'); + next if (exists($returnhash{$symb}) && + exists($returnhash{$symb}->{$param}) && + $returnhash{$symb}->{'v.'.$param} > $v); + $returnhash{$symb}->{$param}=$value; + $returnhash{$symb}->{'v.'.$param}=$v; + } + # + # Remove all of the keys in the hashes which keep track of + # the version of the parameter. + while (my ($symb,$param_hash) = each(%returnhash)) { + # use a foreach because we are going to delete from the hash. + foreach my $key (keys(%$param_hash)) { + delete($param_hash->{$key}) if ($key =~ /^v\./); + } + } + } else { + my @pairs=split(/\&/,$rep); + foreach (@pairs) { + my ($key,$value)=split(/=/,$_); + my ($symb,$param) = split(/:/,$key); + $returnhash{&unescape($symb)}->{&unescape($param)} = + &unescape($value); + } + } + return %returnhash; +} + # --------------------------------------------------------------- put interface sub put { @@ -3032,7 +3083,6 @@ sub metadata { $value.=' [Part: '.$part.']'; } my $unikey='parameter'.$keyroot.'_'.$name; - if ($subp eq 'default') { $unikey='parameter_0_'.$name; } $metathesekeys{$unikey}=1; $metacache{$uri.':'.$unikey.'.part'}=$part; unless