--- loncom/lonnet/perl/lonnet.pm 2003/03/06 21:08:21 1.333 +++ loncom/lonnet/perl/lonnet.pm 2003/03/06 22:41:41 1.334 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.333 2003/03/06 21:08:21 albertel Exp $ +# $Id: lonnet.pm,v 1.334 2003/03/06 22:41:41 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -3041,6 +3041,22 @@ sub EXT { return ''; } +sub add_prefix_and_part { + my ($prefix,$part)=@_; + my $keyroot; + if (defined($prefix) && $prefix !~ /^__/) { + # prefix that has a part already + $keyroot=$prefix; + } elsif (defined($prefix)) { + # prefix that is missing a part + if (defined($part)) { $keyroot='_'.$part.substr($prefix,1); } + } else { + # no prefix at all + if (defined($part)) { $keyroot='_'.$part; } + } + return $keyroot; +} + # ---------------------------------------------------------------- Get metadata sub metadata { @@ -3080,21 +3096,7 @@ sub metadata { # This is a package - get package info # my $package=$token->[2]->{'package'}; - my $keyroot=''; - 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'}; - } - } + my $keyroot=&add_prefix_and_part($prefix,$token->[2]->{'part'}); if (defined($token->[2]->{'id'})) { $keyroot.='_'.$token->[2]->{'id'}; } @@ -3135,13 +3137,8 @@ sub metadata { } else { $unikey=$entry; } - if ($prefix) { - $unikey.=$prefix; - } else { - if (defined($token->[2]->{'part'})) { - $unikey.='_'.$token->[2]->{'part'}; - } - } + $unikey.=&add_prefix_and_part($prefix,$token->[2]->{'part'}); + if (defined($token->[2]->{'id'})) { $unikey.='_'.$token->[2]->{'id'}; }