--- loncom/lonnet/perl/lonnet.pm 2003/03/14 21:45:20 1.317.2.2 +++ loncom/lonnet/perl/lonnet.pm 2003/01/13 21:52:11 1.318 @@ -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.318 2003/01/13 21:52:11 matthew Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1744,6 +1744,25 @@ sub dump { return %returnhash; } +# --------------------------------------------------------------- dumpcurrent +sub dumpcurrent { + my ($namespace,$udomain,$uname)=@_; + if (!$udomain) { $udomain = $ENV{'user.domain'}; } + if (!$uname) { $uname = $ENV{'user.name'}; } + my $uhome = &homeserver($uname,$udomain); + my $rep=reply("dumpcurrent:$udomain:$uname:$namespace",$uhome); + &logthis("error = ".$rep) if ($rep =~ /^(error|no_such_host)/); + return if ($rep =~ /^(error:|no_such_host)/); + my @pairs=split(/\&/,$rep); + my %returnhash=(); + foreach (@pairs) { + my ($key,$value)=split(/=/,$_); + my ($symb,$param) = split(/:/,$key); + $returnhash{&unescape($symb)}->{&unescape($param)} = &unescape($value); + } + return %returnhash; +} + # --------------------------------------------------------------- put interface sub put { @@ -2766,14 +2785,14 @@ sub EXT { } else { $courseid=$ENV{'request.course.id'}; } + my ($realm,$space,$qualifier,@therest)=split(/\./,$varname); my $rest; - if (defined($therest[0])) { + if ($therest[0]) { $rest=join('.',@therest); } else { $rest=''; } - my $qualifierrest=$qualifier; if ($rest) { $qualifierrest.='.'.$rest; } my $spacequalifierrest=$space; @@ -3032,7 +3051,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