[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.683.2.7 and 1.683.2.13

version 1.683.2.7, 2006/01/11 07:33:45 version 1.683.2.13, 2006/01/26 06:34:33
Line 4930  sub EXT { Line 4930  sub EXT {
  if ($space eq 'time') {   if ($space eq 'time') {
     return time;      return time;
         }          }
       } elsif ($realm eq 'server') {
   # ----------------------------------------------------------------- system.time
    if ($space eq 'name') {
       return $ENV{'SERVER_NAME'};
           }
     }      }
     return '';      return '';
 }  }
Line 4976  sub metadata { Line 4981  sub metadata {
     # if it is a non metadata possible uri return quickly      # if it is a non metadata possible uri return quickly
     if (($uri eq '') ||       if (($uri eq '') || 
  (($uri =~ m|^/*adm/|) &&    (($uri =~ m|^/*adm/|) && 
      ($uri !~ m|^adm/includes|) && ($uri !~ m|/bulletinboard$|)       ($uri !~ m|^adm/includes|) && ($uri !~ m|/bulletinboard$|)) ||
   && ($uri !~ m|^adm/coursedocs/|) && ($uri !~ m|^adm/wrapper/|)) ||  
         ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ /^~/) ||          ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ /^~/) ||
  ($uri =~ m|home/[^/]+/public_html/|)) {   ($uri =~ m|home/[^/]+/public_html/|)) {
  return undef;   return undef;
Line 5162  sub metadata { Line 5166  sub metadata {
  $metaentry{':keys'}=join(',',keys %metathesekeys);   $metaentry{':keys'}=join(',',keys %metathesekeys);
  &metadata_generate_part0(\%metathesekeys,\%metaentry,$uri);   &metadata_generate_part0(\%metathesekeys,\%metaentry,$uri);
  $metaentry{':allpossiblekeys'}=join(',',keys %metathesekeys);   $metaentry{':allpossiblekeys'}=join(',',keys %metathesekeys);
  &do_cache_new('meta',$uri,\%metaentry,60*60*24);   &do_cache_new('meta',$uri,\%metaentry,60*60);
 # this is the end of "was not already recently cached  # this is the end of "was not already recently cached
     }      }
     return $metaentry{':'.$what};      return $metaentry{':'.$what};
Line 5258  sub get_slot { Line 5262  sub get_slot {
  $cdom=$env{'course.'.$courseid.'.domain'};   $cdom=$env{'course.'.$courseid.'.domain'};
  $cnum=$env{'course.'.$courseid.'.num'};   $cnum=$env{'course.'.$courseid.'.num'};
     }      }
     my %slotinfo=&get('slots',[$which],$cdom,$cnum);      my $key=join("\0",'slots',$cdom,$cnum,$which);
     &Apache::lonhomework::showhash(%slotinfo);      my %slotinfo;
     my ($tmp)=keys(%slotinfo);      if (exists($remembered{$key})) {
     if ($tmp=~/^error:/) { return (); }   $slotinfo{$which} = $remembered{$key};
       } else {
    %slotinfo=&get('slots',[$which],$cdom,$cnum);
    &Apache::lonhomework::showhash(%slotinfo);
    my ($tmp)=keys(%slotinfo);
    if ($tmp=~/^error:/) { return (); }
    $remembered{$key} = $slotinfo{$which};
       }
     if (ref($slotinfo{$which}) eq 'HASH') {      if (ref($slotinfo{$which}) eq 'HASH') {
  return %{$slotinfo{$which}};   return %{$slotinfo{$which}};
     }      }
Line 6001  sub filelocation { Line 6012  sub filelocation {
     my ($dir,$file) = @_;      my ($dir,$file) = @_;
     my $location;      my $location;
     $file=~ s/^\s*(\S+)\s*$/$1/; ## strip off leading and trailing spaces      $file=~ s/^\s*(\S+)\s*$/$1/; ## strip off leading and trailing spaces
   
       if ($file =~ m-^/adm/-) {
    $file=~s-^/adm/wrapper/-/-;
    $file=~s-^/adm/coursedocs/showdoc/-/-;
       }
     if ($file=~m:^/~:) { # is a contruction space reference      if ($file=~m:^/~:) { # is a contruction space reference
         $location = $file;          $location = $file;
         $location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:;          $location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:;
Line 6040  sub hreflocation { Line 6056  sub hreflocation {
     my ($dir,$file)=@_;      my ($dir,$file)=@_;
     unless (($file=~m-^http://-i) || ($file=~m-^/-)) {      unless (($file=~m-^http://-i) || ($file=~m-^/-)) {
  $file=filelocation($dir,$file);   $file=filelocation($dir,$file);
       } elsif ($file=~m-^/adm/-) {
    $file=~s-^/adm/wrapper/-/-;
    $file=~s-^/adm/coursedocs/showdoc/-/-;
     }      }
     if ($file=~m-^\Q$perlvar{'lonDocRoot'}\E-) {      if ($file=~m-^\Q$perlvar{'lonDocRoot'}\E-) {
  $file=~s-^\Q$perlvar{'lonDocRoot'}\E--;   $file=~s-^\Q$perlvar{'lonDocRoot'}\E--;
Line 6083  sub declutter { Line 6102  sub declutter {
     if ($thisfn=~m|^/enc/|) { $thisfn=&Apache::lonenc::unencrypted($thisfn); }      if ($thisfn=~m|^/enc/|) { $thisfn=&Apache::lonenc::unencrypted($thisfn); }
     $thisfn=~s/^\Q$perlvar{'lonDocRoot'}\E//;      $thisfn=~s/^\Q$perlvar{'lonDocRoot'}\E//;
     $thisfn=~s/^\///;      $thisfn=~s/^\///;
     $thisfn=~s/^res\///;  
     $thisfn=~s/\?.+$//;  
     $thisfn=~s|^adm/wrapper/||;      $thisfn=~s|^adm/wrapper/||;
     $thisfn=~s|^adm/coursedocs/showdoc/||;      $thisfn=~s|^adm/coursedocs/showdoc/||;
       $thisfn=~s/^res\///;
       $thisfn=~s/\?.+$//;
     return $thisfn;      return $thisfn;
 }  }
   
Line 6103  sub clutter { Line 6122  sub clutter {
  } else {   } else {
     my ($ext) = ($thisfn =~ /\.(\w+)$/);      my ($ext) = ($thisfn =~ /\.(\w+)$/);
     my $embstyle=&Apache::loncommon::fileembstyle($ext);      my $embstyle=&Apache::loncommon::fileembstyle($ext);
     if (($embstyle eq 'img')       if ($embstyle eq 'ssi'
    || ($embstyle eq 'hdn')
    || ($embstyle eq 'rat')
    || ($embstyle eq 'prv')
    || ($embstyle eq 'ign')) {
    #do nothing with these
       } elsif (($embstyle eq 'img') 
  || ($embstyle eq 'emb')   || ($embstyle eq 'emb')
  || ($embstyle eq 'wrp')) {   || ($embstyle eq 'wrp')) {
  $thisfn='/adm/wrapper'.$thisfn;   $thisfn='/adm/wrapper'.$thisfn;
     } elsif ($embstyle eq 'ssi') {      } elsif ($embstyle eq 'unk'
  #do nothing with these       && $thisfn!~/\.(sequence|page)$/) {
     } elsif ($thisfn!~/\.(sequence|page)$/) {  
  $thisfn='/adm/coursedocs/showdoc'.$thisfn;   $thisfn='/adm/coursedocs/showdoc'.$thisfn;
       } else {
    #&logthis("Got a blank emb style");
     }      }
  }   }
     }      }
Removed from v.1.683.2.7  
changed lines
  Added in v.1.683.2.13

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