[BACK]Return to lonnet.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.134 and 1.137

version 1.134, 2001/07/27 20:17:14 version 1.137, 2001/08/04 14:45:28
Line 121 Line 121
 # 5/26,5/28 Gerd Kortemeyer  # 5/26,5/28 Gerd Kortemeyer
 # 5/30 H. K. Ng  # 5/30 H. K. Ng
 # 6/1 Gerd Kortemeyer  # 6/1 Gerd Kortemeyer
 #  # July Guy Albertelli
   # 8/4 Gerd Kortemeyer
   
 package Apache::lonnet;  package Apache::lonnet;
   
Line 130  use Apache::File; Line 131  use Apache::File;
 use LWP::UserAgent();  use LWP::UserAgent();
 use HTTP::Headers;  use HTTP::Headers;
 use vars   use vars 
 qw(%perlvar %hostname %homecache %spareid %hostdom %libserv %pr %prp %fe %fd $readit %metacache);  qw(%perlvar %hostname %homecache %spareid %hostdom %libserv %pr %prp %fe %fd $readit %metacache %packagetab);
 use IO::Socket;  use IO::Socket;
 use GDBM_File;  use GDBM_File;
 use Apache::Constants qw(:common :http);  use Apache::Constants qw(:common :http);
Line 1851  sub metadata { Line 1852  sub metadata {
         my $token;          my $token;
         while ($token=$parser->get_token) {          while ($token=$parser->get_token) {
            if ($token->[0] eq 'S') {             if ($token->[0] eq 'S') {
        if (defined($token->[2]->{'package'})) {
         my $package=$token->[2]->{'package'};
                 my %thispackagekeys=();
         my $keyroot='';
                 if (defined($token->[2]->{'part'})) { 
                    $keyroot.='_'.$token->[2]->{'part'}; 
         }
                 if (defined($token->[2]->{'id'})) { 
                    $keyroot.='_'.$token->[2]->{'id'}; 
         }
                 if ($metacache{$uri.':packages'}) {
                    $metacache{$uri.':packages'}.=','.$package.$keyroot;
                 } else {
                    $metacache{$uri.':packages'}=$package.$keyroot;
         }
                 undef %thispackagekeys;
                 map {
     if ($_=~/^$package\&/) {
         my ($pack,$name,$subp)=split(/\&/,$_);
                         my $unikey='parameter_'.$keyroot.'_'.$name;
                         $thispackagekeys{$unikey}=1;
                         $metacache{$uri.':'.$unikey.'.'.$subp}=$packagetab{$_};
                     }
                 } keys %packagetab;
                 my $addpackagekeys=join(',',keys %thispackagekeys);
                 if ($metacache{$uri.':keys'}) {
                    $metacache{$uri.':keys'}.=','.$addpackagekeys;
                 } else {
                    $metacache{$uri.':keys'}=$addpackagekeys;
         }
                } else {
       my $entry=$token->[1];        my $entry=$token->[1];
               my $unikey=$entry;                my $unikey=$entry;
               if (defined($token->[2]->{'part'})) {                 if (defined($token->[2]->{'part'})) { 
                  $unikey.='_'.$token->[2]->{'part'};                    $unikey.='_'.$token->[2]->{'part'}; 
       }        }
                 if (defined($token->[2]->{'id'})) { 
                    $unikey.='_'.$token->[2]->{'id'}; 
         }
               if (defined($token->[2]->{'name'})) {                 if (defined($token->[2]->{'name'})) { 
                  $unikey.='_'.$token->[2]->{'name'};                    $unikey.='_'.$token->[2]->{'name'}; 
       }        }
Line 1872  sub metadata { Line 1907  sub metadata {
       ) { $metacache{$uri.':'.$unikey}=        ) { $metacache{$uri.':'.$unikey}=
       $metacache{$uri.':'.$unikey.'.default'};        $metacache{$uri.':'.$unikey.'.default'};
       }        }
           }      }
     }
        }         }
     }      }
     return $metacache{$uri.':'.$what};      return $metacache{$uri.':'.$what};
Line 2154  if ($readit ne 'done') { Line 2190  if ($readit ne 'done') {
     }      }
 }  }
   
   # ---------------------------------------------------------- Read package table
   {
       my $config=Apache::File->new("$perlvar{'lonTabDir'}/packages.tab");
   
       while (my $configline=<$config>) {
          chomp($configline);
          my ($short,$plain)=split(/:/,$configline);
          if ($plain ne '') { $packagetab{$short}=$plain; }
       }
   }
   
 # ------------------------------------------------------------- Read file types  # ------------------------------------------------------------- Read file types
 {  {
     my $config=Apache::File->new("$perlvar{'lonTabDir'}/filetypes.tab");      my $config=Apache::File->new("$perlvar{'lonTabDir'}/filetypes.tab");
Removed from v.1.134  
changed lines
  Added in v.1.137

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>