[LON-CAPA-cvs] cvs: loncom /lonnet/perl lonnet.pm
albertel
lon-capa-cvs@mail.lon-capa.org
Tue, 16 May 2006 18:25:00 -0000
albertel Tue May 16 14:25:00 2006 EDT
Modified files:
/loncom/lonnet/perl lonnet.pm
Log:
- metadata :pacakages was ending up with duplicate package definitions
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.736 loncom/lonnet/perl/lonnet.pm:1.737
--- loncom/lonnet/perl/lonnet.pm:1.736 Tue May 16 11:42:15 2006
+++ loncom/lonnet/perl/lonnet.pm Tue May 16 14:24:58 2006
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.736 2006/05/16 15:42:15 albertel Exp $
+# $Id: lonnet.pm,v 1.737 2006/05/16 18:24:58 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -5509,14 +5509,14 @@
}
}
my ($extension) = ($uri =~ /\.(\w+)$/);
- foreach my $key (sort(keys(%packagetab))) {
+ foreach my $key (keys(%packagetab)) {
#no specific packages #how's our extension
if ($key!~/^extension_\Q$extension\E&/) { next; }
&metadata_create_package_def($uri,$key,'extension_'.$extension,
\%metathesekeys);
}
if (!exists($metaentry{':packages'})) {
- foreach my $key (sort(keys(%packagetab))) {
+ foreach my $key (keys(%packagetab)) {
#no specific packages well let's get default then
if ($key!~/^default&/) { next; }
&metadata_create_package_def($uri,$key,'default',
@@ -5543,7 +5543,13 @@
}
}
}
- $metaentry{':keys'}=join(',',keys %metathesekeys);
+ # uniqifiy package listing
+ my %seen;
+ my @uniq_packages =
+ grep { ! $seen{$_} ++ } (split(',',$metaentry{':packages'}));
+ $metaentry{':packages'} = join(',',@uniq_packages);
+
+ $metaentry{':keys'} = join(',',keys(%metathesekeys));
&metadata_generate_part0(\%metathesekeys,\%metaentry,$uri);
$metaentry{':allpossiblekeys'}=join(',',keys %metathesekeys);
&do_cache_new('meta',$uri,\%metaentry,60*60);
@@ -5579,7 +5585,7 @@
sub metadata_generate_part0 {
my ($metadata,$metacache,$uri) = @_;
my %allnames;
- foreach my $metakey (sort keys %$metadata) {
+ foreach my $metakey (keys(%$metadata)) {
if ($metakey=~/^parameter\_(.*)/) {
my $part=$$metacache{':'.$metakey.'.part'};
my $name=$$metacache{':'.$metakey.'.name'};