[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.76 and 1.79

version 1.76, 2000/12/06 19:58:31 version 1.79, 2000/12/12 23:43:05
Line 81 Line 81
 # 10/06,10/09,10/10,10/11,10/14,10/20,10/23,10/25,10/26,10/27,10/28,10/29,   # 10/06,10/09,10/10,10/11,10/14,10/20,10/23,10/25,10/26,10/27,10/28,10/29, 
 # 10/30,10/31,  # 10/30,10/31,
 # 11/2,11/14,11/15,11/16,11/20,11/21,11/22,11/25,11/27,  # 11/2,11/14,11/15,11/16,11/20,11/21,11/22,11/25,11/27,
 # 12/02 Gerd Kortemeyer  # 12/02,12/12 Gerd Kortemeyer
   
 package Apache::lonnet;  package Apache::lonnet;
   
Line 90  use Apache::File; Line 90  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 $unique);  qw(%perlvar %hostname %homecache %spareid %hostdom %libserv %pr %prp %fe %fd $readit %metacache);
 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 1426  sub EXT { Line 1426  sub EXT {
         my $reply=&reply('get:'.          my $reply=&reply('get:'.
               $ENV{'course.'.$ENV{'request.course.id'}.$section.'.domain'}.':'.                $ENV{'course.'.$ENV{'request.course.id'}.$section.'.domain'}.':'.
               $ENV{'course.'.$ENV{'request.course.id'}.$section.'.num'}.                $ENV{'course.'.$ENV{'request.course.id'}.$section.'.num'}.
               ':resourcedata:'.        ':resourcedata:'.
  escape($seclevelr).':'.escape($seclevelm).':'.escape($seclevel).':'.     &escape($seclevelr).'&'.&escape($seclevelm).'&'.&escape($seclevel).'&'.
  escape($courselevelr).':'.escape($courselevelm).':'.escape($courselevel),     &escape($courselevelr).'&'.&escape($courselevelm).'&'.&escape($courselevel),
    $ENV{'course.'.$ENV{'request.course.id'}.$section.'.home'});     $ENV{'course.'.$ENV{'request.course.id'}.$section.'.home'});
       if ($reply!~/^error\:/) {        if ($reply!~/^error\:/) {
         map {    map {
            my ($name,$value)=split(/\=/,$_);        if ($_) { return &unescape($_); }
            $resourcedata{unescape($name)}=unescape($value);              } split(/\&/,$reply);
         } split(/\&/,$reply);  
   
        if ($resourcedata{$seclevelr}) { return $resourcedata{$seclevelr}; }  
        if ($resourcedata{$seclevelm}) { return $resourcedata{$seclevelm}; }    
        if ($resourcedata{$seclevel}) { return $resourcedata{$seclevel}; }  
   
        if ($resourcedata{$courselevelr}) {   
           return $resourcedata{$courselevelr}; }  
        if ($resourcedata{$courselevelm}) {   
           return $resourcedata{$courselevelm}; }  
        if ($resourcedata{$courselevel}) { return $resourcedata{$courselevel}; }  
   
       }        }
   
 # ------------------------------------------------------ third, check map parms  # ------------------------------------------------------ third, check map parms
Line 1461  sub EXT { Line 1449  sub EXT {
             
 # --------------------------------------------- last, look in resource metadata  # --------------------------------------------- last, look in resource metadata
   
         $spacequalifierrest=~s/\./\_/;
       my $metadata=&metadata($ENV{'request.filename'},$spacequalifierrest);        my $metadata=&metadata($ENV{'request.filename'},$spacequalifierrest);
       if ($metadata) { return $metadata; }        if ($metadata) { return $metadata; }
         $metadata=&metadata($ENV{'request.filename'},
                                            'parameter_'.$spacequalifierrest);
         if ($metadata) { return $metadata; }
   
 # ---------------------------------------------------- Any other user namespace  # ---------------------------------------------------- Any other user namespace
     } elsif ($realm eq 'environment') {      } elsif ($realm eq 'environment') {
Line 1481  sub EXT { Line 1473  sub EXT {
   
 sub metadata {  sub metadata {
     my ($uri,$what)=@_;      my ($uri,$what)=@_;
   
     $uri=&declutter($uri);      $uri=&declutter($uri);
     my $filename=$uri;      my $filename=$uri;
     $uri=~s/\.meta$//;      $uri=~s/\.meta$//;
Line 1507  sub metadata { Line 1500  sub metadata {
               map {                map {
   $metacache{$uri.':'.$unikey.'.'.$_}=$token->[2]->{$_};    $metacache{$uri.':'.$unikey.'.'.$_}=$token->[2]->{$_};
               } @{$token->[3]};                } @{$token->[3]};
               $metacache{$uri.':'.$unikey}=$parser->get_text('/'.$entry);                unless (
                    $metacache{$uri.':'.$unikey}=$parser->get_text('/'.$entry)
         ) { $metacache{$uri.':'.$unikey}=
         $metacache{$uri.':'.$unikey.'.default'};
         }
           }            }
        }         }
     }      }
Line 1639  sub ireceipt { Line 1636  sub ireceipt {
     my $cudom=unpack("%32C*",$fudom);      my $cudom=unpack("%32C*",$fudom);
     my $cucourseid=unpack("%32C*",$fucourseid);      my $cucourseid=unpack("%32C*",$fucourseid);
     my $cusymb=unpack("%32C*",$fusymb);      my $cusymb=unpack("%32C*",$fusymb);
     my $cunique=unpack("%32C*",$unique);      my $cunique=unpack("%32C*",$perlvar{'lonReceipt'});
     return unpack("%32C*",$perlvar{'lonHostID'}).'-'.      return unpack("%32C*",$perlvar{'lonHostID'}).'-'.
            ($cunique%$cuname+             ($cunique%$cuname+
             $cunique%$cudom+              $cunique%$cudom+
Line 1800  if ($readit ne 'done') { Line 1797  if ($readit ne 'done') {
     }      }
 }  }
   
 # --------------------------------------------------- Get CPU data as unique ID  
 {  
    my @contents;  
    {  
     my $fh=Apache::File->new('/proc/cpuinfo');  
     @contents=<$fh>;  
    }  
    $unique='';  
    map {  
        my ($name,$value)=split(/\s*\:\s*/,$_);  
        if (($name eq 'vendor_id') || ($name=~/^model/) ||  
            ($name=~/^cpu/) || ($name eq 'stepping')) {  
    $unique.=$value;  
        }   
    } @contents;  
    $unique=~s/\W//g;  
 }  
   
 %metacache=();  %metacache=();
   
 $readit='done';  $readit='done';
Removed from v.1.76  
changed lines
  Added in v.1.79

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