--- loncom/lonnet/perl/lonnet.pm 2003/03/01 15:13:58 1.332 +++ loncom/lonnet/perl/lonnet.pm 2003/03/06 21:08:21 1.333 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.332 2003/03/01 15:13:58 www Exp $ +# $Id: lonnet.pm,v 1.333 2003/03/06 21:08:21 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -3081,12 +3081,19 @@ sub metadata { # my $package=$token->[2]->{'package'}; my $keyroot=''; - if ($prefix) { - $keyroot.=$prefix; - } else { - if (defined($token->[2]->{'part'})) { - $keyroot.='_'.$token->[2]->{'part'}; - } + if (defined($prefix) && $prefix !~ /^__/) { + # prefix that has a part already + $keyroot=$prefix; + } elsif (defined($prefix)) { + # prefix that is missing a part + if (defined($token->[2]->{'part'})) { + $keyroot='_'.$token->[2]->{'part'}.substr($prefix,1); + } + } else { + # no prefix at all + if (defined($token->[2]->{'part'})) { + $keyroot='_'.$token->[2]->{'part'}; + } } if (defined($token->[2]->{'id'})) { $keyroot.='_'.$token->[2]->{'id'};