[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.523.2.8 and 1.530

version 1.523.2.8, 2004/09/27 19:02:11 version 1.530, 2004/08/24 06:43:21
Line 50  use Fcntl qw(:flock); Line 50  use Fcntl qw(:flock);
 use Apache::loncoursedata;  use Apache::loncoursedata;
 use Apache::lonlocal;  use Apache::lonlocal;
 use Storable qw(lock_store lock_nstore lock_retrieve freeze thaw);  use Storable qw(lock_store lock_nstore lock_retrieve freeze thaw);
 use Time::HiRes qw( gettimeofday tv_interval );  use Time::HiRes();
 my $readit;  my $readit;
   
 =pod  =pod
Line 795  sub getsection { Line 795  sub getsection {
         if ($key eq $courseid.'_st') { $section=''; }          if ($key eq $courseid.'_st') { $section=''; }
         my ($dummy,$end,$start)=split(/\_/,&unescape($value));          my ($dummy,$end,$start)=split(/\_/,&unescape($value));
         my $now=time;          my $now=time;
         if (defined($end) && $end && ($now > $end)) {          if (defined($end) && ($now > $end)) {
             $Expired{$end}=$section;              $Expired{$end}=$section;
             next;              next;
         }          }
         if (defined($start) && $start && ($now < $start)) {          if (defined($start) && ($now < $start)) {
             $Pending{$start}=$section;              $Pending{$start}=$section;
             next;              next;
         }          }
Line 826  my $disk_caching_disabled=1; Line 826  my $disk_caching_disabled=1;
 sub devalidate_cache {  sub devalidate_cache {
     my ($cache,$id,$name) = @_;      my ($cache,$id,$name) = @_;
     delete $$cache{$id.'.time'};      delete $$cache{$id.'.time'};
     delete $$cache{$id.'.file'};  
     delete $$cache{$id};      delete $$cache{$id};
     if (1 || $disk_caching_disabled) { return; }      if ($disk_caching_disabled) { return; }
     my $filename=$perlvar{'lonDaemons'}.'/tmp/lonnet_internal_cache_'.$name.".db";      my $filename=$perlvar{'lonDaemons'}.'/tmp/lonnet_internal_cache_'.$name.".db";
     if (!-e $filename) { return; }      open(DB,"$filename.lock");
     open(DB,">$filename.lock");  
     flock(DB,LOCK_EX);      flock(DB,LOCK_EX);
     my %hash;      my %hash;
     if (tie(%hash,'GDBM_File',$filename,&GDBM_WRCREAT(),0640)) {      if (tie(%hash,'GDBM_File',$filename,&GDBM_WRCREAT(),0640)) {
Line 858  sub is_cached { Line 856  sub is_cached {
     my ($cache,$id,$name,$time) = @_;      my ($cache,$id,$name,$time) = @_;
     if (!$time) { $time=300; }      if (!$time) { $time=300; }
     if (!exists($$cache{$id.'.time'})) {      if (!exists($$cache{$id.'.time'})) {
  &load_cache_item($cache,$name,$id,$time);   &load_cache_item($cache,$name,$id);
     }      }
     if (!exists($$cache{$id.'.time'})) {      if (!exists($$cache{$id.'.time'})) {
 # &logthis("Didn't find $id");  # &logthis("Didn't find $id");
  return (undef,undef);   return (undef,undef);
     } else {      } else {
  if (time-($$cache{$id.'.time'})>$time) {   if (time-($$cache{$id.'.time'})>$time) {
     if (exists($$cache{$id.'.file'})) {  #    &logthis("Devalidating $id - ".time-($$cache{$id.'.time'}));
  foreach my $filename (@{ $$cache{$id.'.file'} }) {      &devalidate_cache($cache,$id,$name);
     my $mtime=(stat($filename))[9];      return (undef,undef);
     #+1 is to take care of edge effects  
     if ($mtime && (($mtime+1) < ($$cache{$id.'.time'}))) {  
 # &logthis("Upping $mtime - ".$$cache{$id.'.time'}.  
 # "$id because of $filename");  
     } else {  
 # &logthis("Devalidating $filename $id - ".(time-($$cache{$id.'.time'})));  
  &devalidate_cache($cache,$id,$name);  
  return (undef,undef);  
     }  
  }  
  $$cache{$id.'.time'}=time;  
     } else {  
 # &logthis("Devalidating $id - ".time-($$cache{$id.'.time'}));  
  &devalidate_cache($cache,$id,$name);  
  return (undef,undef);  
     }  
  }   }
     }      }
     return ($$cache{$id},1);      return ($$cache{$id},1);
Line 899  sub do_cache { Line 881  sub do_cache {
     $$cache{$id};      $$cache{$id};
 }  }
   
 my %do_save_item;  
 my %do_save;  
 sub save_cache_item {  sub save_cache_item {
     my ($cache,$name,$id)=@_;      my ($cache,$name,$id)=@_;
     if ($disk_caching_disabled) { return; }      if ($disk_caching_disabled) { return; }
     $do_save{$name}=$cache;      my $starttime=&Time::HiRes::time();
     if (!exists($do_save_item{$name})) { $do_save_item{$name}={} }  #    &logthis("Saving :$name:$id");
     $do_save_item{$name}->{$id}=1;      my %hash;
     return;      my $filename=$perlvar{'lonDaemons'}.'/tmp/lonnet_internal_cache_'.$name.".db";
 }      open(DB,"$filename.lock");
       flock(DB,LOCK_EX);
 sub save_cache {      if (tie(%hash,'GDBM_File',$filename,&GDBM_WRCREAT(),0640)) {
     if ($disk_caching_disabled) { return; }   eval <<'EVALBLOCK';
     my ($cache,$name,$id);      $hash{$id.'.time'}=$$cache{$id.'.time'};
     foreach $name (keys(%do_save)) {      $hash{$id}=freeze({'item'=>$$cache{$id}});
  $cache=$do_save{$name};  
   
  my $starttime=&Time::HiRes::time();  
  &logthis("Saving :$name:");  
  my %hash;  
  my $filename=$perlvar{'lonDaemons'}.'/tmp/lonnet_internal_cache_'.$name.".db";  
  open(DB,">$filename.lock");  
  flock(DB,LOCK_EX);  
  if (tie(%hash,'GDBM_File',$filename,&GDBM_WRCREAT(),0640)) {  
     foreach $id (keys(%{ $do_save_item{$name} })) {  
  eval <<'EVALBLOCK';  
  $hash{$id.'.time'}=$$cache{$id.'.time'};  
  $hash{$id}=freeze({'item'=>$$cache{$id}});  
  if (exists($$cache{$id.'.file'})) {  
     $hash{$id.'.file'}=freeze({'item'=>$$cache{$id.'.file'}});  
  }  
 EVALBLOCK  EVALBLOCK
                 if ($@) {          if ($@) {
     &logthis("<font color='red'>save_cache blew up :$@:$name</font>");      &logthis("<font color='red'>save_cache blew up :$@:$name</font>");
     unlink($filename);      unlink($filename);
     last;   }
  }      } else {
     }   if (-e $filename) {
  } else {      &logthis("Unable to tie hash (save cache item): $name ($!)");
     if (-e $filename) {      unlink($filename);
  &logthis("Unable to tie hash (save cache): $name ($!)");  
  unlink($filename);  
     }  
  }   }
  untie(%hash);  
  flock(DB,LOCK_UN);  
  close(DB);  
  &logthis("save_cache $name took ".(&Time::HiRes::time()-$starttime));  
     }      }
     undef(%do_save);      untie(%hash);
     undef(%do_save_item);      flock(DB,LOCK_UN);
       close(DB);
   #    &logthis("save_cache_item $name took ".(&Time::HiRes::time()-$starttime));
 }  }
   
 sub load_cache_item {  sub load_cache_item {
     my ($cache,$name,$id,$time)=@_;      my ($cache,$name,$id)=@_;
     if ($disk_caching_disabled) { return; }      if ($disk_caching_disabled) { return; }
     my $starttime=&Time::HiRes::time();      my $starttime=&Time::HiRes::time();
 #    &logthis("Before Loading $name  for $id size is ".scalar(%$cache));  #    &logthis("Before Loading $name  for $id size is ".scalar(%$cache));
     my %hash;      my %hash;
     my $filename=$perlvar{'lonDaemons'}.'/tmp/lonnet_internal_cache_'.$name.".db";      my $filename=$perlvar{'lonDaemons'}.'/tmp/lonnet_internal_cache_'.$name.".db";
     if (!-e $filename) { return; }      open(DB,"$filename.lock");
     open(DB,">$filename.lock");  
     flock(DB,LOCK_SH);      flock(DB,LOCK_SH);
     if (tie(%hash,'GDBM_File',$filename,&GDBM_READER(),0640)) {      if (tie(%hash,'GDBM_File',$filename,&GDBM_READER(),0640)) {
  eval <<'EVALBLOCK';   eval <<'EVALBLOCK';
Line 978  sub load_cache_item { Line 935  sub load_cache_item {
  }   }
 #    &logthis("Initial load: $count");  #    &logthis("Initial load: $count");
     } else {      } else {
  if (($$cache{$id.'.time'}+$time) < time) {   my $hashref=thaw($hash{$id});
     $$cache{$id.'.time'}=$hash{$id.'.time'};   $$cache{$id}=$hashref->{'item'};
     {   $$cache{$id.'.time'}=$hash{$id.'.time'};
  my $hashref=thaw($hash{$id});  
  $$cache{$id}=$hashref->{'item'};  
     }  
     if (exists($hash{$id.'.file'})) {  
  my $hashref=thaw($hash{$id.'.file'});  
  $$cache{$id.'.file'}=$hashref->{'item'};  
     }  
  }  
     }      }
 EVALBLOCK  EVALBLOCK
         if ($@) {          if ($@) {
Line 1098  sub currentversion { Line 1047  sub currentversion {
 sub subscribe {  sub subscribe {
     my $fname=shift;      my $fname=shift;
     if ($fname=~/\/(aboutme|syllabus|bulletinboard|smppg)$/) { return ''; }      if ($fname=~/\/(aboutme|syllabus|bulletinboard|smppg)$/) { return ''; }
     $fname=~s/[\n\r]//g;  
     my $author=$fname;      my $author=$fname;
     $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;      $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
     my ($udom,$uname)=split(/\//,$author);      my ($udom,$uname)=split(/\//,$author);
Line 1119  sub repcopy { Line 1067  sub repcopy {
     my $filename=shift;      my $filename=shift;
     $filename=~s/\/+/\//g;      $filename=~s/\/+/\//g;
     if ($filename=~/^\/home\/httpd\/html\/adm\//) { return OK; }      if ($filename=~/^\/home\/httpd\/html\/adm\//) { return OK; }
     $filename=~s/[\n\r]//g;  
     my $transname="$filename.in.transfer";      my $transname="$filename.in.transfer";
     if ((-e $filename) || (-e $transname)) { return OK; }      if ((-e $filename) || (-e $transname)) { return OK; }
     my $remoteurl=subscribe($filename);      my $remoteurl=subscribe($filename);
Line 1184  sub ssi_body { Line 1131  sub ssi_body {
     my ($filelink,%form)=@_;      my ($filelink,%form)=@_;
     my $output=($filelink=~/^http\:/?&externalssi($filelink):      my $output=($filelink=~/^http\:/?&externalssi($filelink):
                                      &ssi($filelink,%form));                                       &ssi($filelink,%form));
     $output=~s/^.*?\<body[^\>]*\>//si;  
     $output=~s/(.*)\<\/body\s*\>.*?$/$1/si;  
     $output=~      $output=~
             s/\/\/ BEGIN LON\-CAPA Internal.+\/\/ END LON\-CAPA Internal\s//gs;              s/\/\/ BEGIN LON\-CAPA Internal.+\/\/ END LON\-CAPA Internal\s//gs;
       $output=~s/^.*?\<body[^\>]*\>//si;
       $output=~s/(.*)\<\/body\s*\>.*?$/$1/si;
     return $output;      return $output;
 }  }
   
Line 1425  sub removeuserfile { Line 1372  sub removeuserfile {
     return &reply("removeuserfile:$docudom/$docuname/$fname",$home);      return &reply("removeuserfile:$docudom/$docuname/$fname",$home);
 }  }
   
   sub mkdiruserfile {
       my ($docuname,$docudom,$dir)=@_;
       my $home=&homeserver($docuname,$docudom);
       return &reply("mkdiruserfile:".&escape("$docudom/$docuname/$dir"),$home);
   }
   
 # ------------------------------------------------------------------------- Log  # ------------------------------------------------------------------------- Log
   
 sub log {  sub log {
Line 2644  sub put { Line 2597  sub put {
    return &reply("put:$udomain:$uname:$namespace:$items",$uhome);     return &reply("put:$udomain:$uname:$namespace:$items",$uhome);
 }  }
   
   # ---------------------------------------------------------- putstore interface
                                                                                        
   sub putstore {
      my ($namespace,$storehash,$udomain,$uname)=@_;
      if (!$udomain) { $udomain=$ENV{'user.domain'}; }
      if (!$uname) { $uname=$ENV{'user.name'}; }
      my $uhome=&homeserver($uname,$udomain);
      my $items='';
      my %allitems = ();
      foreach (keys %$storehash) {
          if ($_ =~ m/^([^\:]+):([^\:]+):([^\:]+)$/) {
              my $key = $1.':keys:'.$2;
              $allitems{$key} .= $3.':';
          }
          $items.=$_.'='.&escape($$storehash{$_}).'&';
      }
      foreach (keys %allitems) {
          $allitems{$_} =~ s/\:$//;
          $items.= $_.'='.$allitems{$_}.'&';
      }
      $items=~s/\&$//;
      return &reply("put:$udomain:$uname:$namespace:$items",$uhome);
   }
   
 # ------------------------------------------------------ critical put interface  # ------------------------------------------------------ critical put interface
   
 sub cput {  sub cput {
Line 2726  sub allowed { Line 2703  sub allowed {
   
     if (defined($ENV{'allowed.'.$priv})) { return $ENV{'allowed.'.$priv}; }      if (defined($ENV{'allowed.'.$priv})) { return $ENV{'allowed.'.$priv}; }
 # Free bre access to adm and meta resources  # Free bre access to adm and meta resources
       if (((($uri=~/^adm\//) && ($uri !~ m|/bulletinboard$|)) 
     if ((($uri=~/^adm\//) || ($uri=~/\.meta$/)) && ($priv eq 'bre')) {   || ($uri=~/\.meta$/)) && ($priv eq 'bre')) {
  return 'F';   return 'F';
     }      }
   
Line 3132  sub log_query { Line 3109  sub log_query {
 sub fetch_enrollment_query {  sub fetch_enrollment_query {
     my ($context,$affiliatesref,$replyref,$dom,$cnum) = @_;      my ($context,$affiliatesref,$replyref,$dom,$cnum) = @_;
     my $homeserver;      my $homeserver;
     my $maxtries = 1;  
     if ($context eq 'automated') {      if ($context eq 'automated') {
         $homeserver = $perlvar{'lonHostID'};          $homeserver = $perlvar{'lonHostID'};
         $maxtries = 10; # will wait for up to 2000s for retrieval of classlist data before timeout  
     } else {      } else {
         $homeserver = &homeserver($cnum,$dom);          $homeserver = &homeserver($cnum,$dom);
     }      }
Line 3148  sub fetch_enrollment_query { Line 3123  sub fetch_enrollment_query {
     $cmd = &escape($cmd);      $cmd = &escape($cmd);
     my $query = 'fetchenrollment';      my $query = 'fetchenrollment';
     my $queryid=&reply("querysend:".$query.':'.$dom.':'.$ENV{'user.name'}.':'.$cmd,$homeserver);      my $queryid=&reply("querysend:".$query.':'.$dom.':'.$ENV{'user.name'}.':'.$cmd,$homeserver);
     unless ($queryid=~/^\Q$host\E\_/) { return 'error: '.$queryid; }      unless ($queryid=~/^\Q$host\E\_/) { 
     my $reply = &get_query_reply($queryid);          &logthis('fetch_enrollment_query: invalid queryid: '.$queryid.' for host: '.$host.' and homeserver: '.$homeserver.' context: '.$context.' '.$cnum); 
     my $tries = 1;          return 'error: '.$queryid;
     while (($reply=~/^timeout/) && ($tries < $maxtries)) {  
  $reply = &get_query_reply($queryid);  
  $tries++;  
     }      }
       my $reply = &get_query_reply($queryid);
     if ( ($reply =~/^timeout/) || ($reply =~/^error/) ) {      if ( ($reply =~/^timeout/) || ($reply =~/^error/) ) {
  &logthis('fetch_enrollment_query error: '.$reply.' for '.$dom.' '.          &logthis('fetch_enrollment_query error: '.$reply.' for '.$dom.' '.$ENV{'user.name'}.' for '.$queryid.' context: '.$context.' '.$cnum);
  $ENV{'user.name'}.' for '.$queryid.' context: '.$context.' '.      } else {
  $cnum.' maxtries: '.$maxtries.' tries: '.$tries);  
     }  
     unless ( ($reply =~/^timeout/) || ($reply =~/^error/) ) {  
         my @responses = split/:/,$reply;          my @responses = split/:/,$reply;
         if ($homeserver eq $perlvar{'lonHostID'}) {          if ($homeserver eq $perlvar{'lonHostID'}) {
             foreach (@responses) {              foreach (@responses) {
Line 3177  sub fetch_enrollment_query { Line 3147  sub fetch_enrollment_query {
                         my $filename = $dom.'_'.$key.'_'.$_.'_classlist.xml';                          my $filename = $dom.'_'.$key.'_'.$_.'_classlist.xml';
                         my $destname = $pathname.'/'.$filename;                          my $destname = $pathname.'/'.$filename;
                         my $xml_classlist = &reply("autoretrieve:".$filename,$homeserver);                          my $xml_classlist = &reply("autoretrieve:".$filename,$homeserver);
                         unless ($xml_classlist =~ /^error/) {                          if ($xml_classlist =~ /^error/) {
                               &logthis('fetch_enrollment_query - autoretrieve error: '.$xml_classlist.' for '.$filename.' from server: '.$homeserver.' '.$context.' '.$cnum);
                           } else {
                             if ( open(FILE,">$destname") ) {                              if ( open(FILE,">$destname") ) {
                                 print FILE &unescape($xml_classlist);                                  print FILE &unescape($xml_classlist);
                                 close(FILE);                                  close(FILE);
                               } else {
                                   &logthis('fetch_enrollment_query - error opening classlist file '.$destname.' '.$context.' '.$cnum);
                             }                              }
                         }                          }
                     }                      }
Line 4059  sub EXT { Line 4033  sub EXT {
   
  my $section;   my $section;
  if (defined($courseid) && $courseid eq $ENV{'request.course.id'}) {   if (defined($courseid) && $courseid eq $ENV{'request.course.id'}) {
     if (!$symbparm) { $symbparm=&symbread(); }  
  }  
  if ($symbparm && defined($courseid) &&   
     $courseid eq $ENV{'request.course.id'}) {  
   
     #print '<br>'.$space.' - '.$qualifier.' - '.$spacequalifierrest;      #print '<br>'.$space.' - '.$qualifier.' - '.$spacequalifierrest;
   
 # ----------------------------------------------------- Cascading lookup scheme  # ----------------------------------------------------- Cascading lookup scheme
       if (!$symbparm) { $symbparm=&symbread(); }
     my $symbp=$symbparm;      my $symbp=$symbparm;
     my $mapp=(&decode_symb($symbp))[0];      my $mapp=(&decode_symb($symbp))[0];
   
Line 4077  sub EXT { Line 4048  sub EXT {
  ($ENV{'user.domain'} eq $udom)) {   ($ENV{'user.domain'} eq $udom)) {
  $section=$ENV{'request.course.sec'};   $section=$ENV{'request.course.sec'};
     } else {      } else {
  if (! defined($usection)) {                  if (! defined($usection)) {
     $section=&usection($udom,$uname,$courseid);                      $section=&usection($udom,$uname,$courseid);
  } else {                  } else {
     $section = $usection;                      $section = $usection;
  }                  }
     }      }
   
     my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest;      my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest;
Line 4119  sub EXT { Line 4090  sub EXT {
  $uname." at ".$udom.": ".   $uname." at ".$udom.": ".
  $tmp."</font>");   $tmp."</font>");
     } elsif ($tmp=~/error: 2 /) {      } elsif ($tmp=~/error: 2 /) {
  &EXT_cache_set($udom,$uname);                          &EXT_cache_set($udom,$uname);
     } elsif ($tmp =~ /^(con_lost|no_such_host)/) {      } elsif ($tmp =~ /^(con_lost|no_such_host)/) {
  return $tmp;   return $tmp;
     }      }
Line 4129  sub EXT { Line 4100  sub EXT {
 # -------------------------------------------------------- second, check course  # -------------------------------------------------------- second, check course
   
     my $coursereply=&courseresdata($ENV{'course.'.$courseid.'.num'},      my $coursereply=&courseresdata($ENV{'course.'.$courseid.'.num'},
    $ENV{'course.'.$courseid.'.domain'},    $ENV{'course.'.$courseid.'.domain'},
    ($seclevelr,$seclevelm,$seclevel,    ($seclevelr,$seclevelm,$seclevel,
     $courselevelr,$courselevelm,     $courselevelr,$courselevelm,
     $courselevel));     $courselevel));
     if (defined($coursereply)) { return $coursereply; }      if (defined($coursereply)) { return $coursereply; }
   
 # ------------------------------------------------------ third, check map parms  # ------------------------------------------------------ third, check map parms
Line 4232  sub metadata { Line 4203  sub metadata {
     my ($uri,$what,$liburi,$prefix,$depthcount)=@_;      my ($uri,$what,$liburi,$prefix,$depthcount)=@_;
     $uri=&declutter($uri);      $uri=&declutter($uri);
     # if it is a non metadata possible uri return quickly      # if it is a non metadata possible uri return quickly
     if (($uri eq '') || (($uri =~ m|^/*adm/|) && ($uri !~ m|^adm/includes|)) ||      if (($uri eq '') || 
    (($uri =~ m|^/*adm/|) && 
        ($uri !~ m|^adm/includes|) && ($uri !~ m|/bulletinboard$|)) ||
         ($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 4265  sub metadata { Line 4238  sub metadata {
         unless ($filename=~/\.meta$/) { $filename.='.meta'; }          unless ($filename=~/\.meta$/) { $filename.='.meta'; }
  my $metastring;   my $metastring;
  if ($uri !~ m|^uploaded/|) {   if ($uri !~ m|^uploaded/|) {
     my $file=&filelocation('',&clutter($filename));      $metastring=&getfile(&filelocation('',&clutter($filename)));
     push(@{$metacache{$uri.'.file'}},$file);  
     $metastring=&getfile($file);  
  }   }
         my $parser=HTML::LCParser->new(\$metastring);          my $parser=HTML::LCParser->new(\$metastring);
         my $token;          my $token;
Line 4632  sub deversion { Line 4603  sub deversion {
   
 sub symbread {  sub symbread {
     my ($thisfn,$donotrecurse)=@_;      my ($thisfn,$donotrecurse)=@_;
     my $cache_str='request.symbread.cached.'.$thisfn;  
     if (defined($ENV{$cache_str})) { return $ENV{$cache_str}; }  
 # no filename provided? try from environment  # no filename provided? try from environment
     unless ($thisfn) {      unless ($thisfn) {
         if ($ENV{'request.symb'}) {          if ($ENV{'request.symb'}) { return &symbclean($ENV{'request.symb'}); }
     return $ENV{$cache_str}=&symbclean($ENV{'request.symb'});  
  }  
  $thisfn=$ENV{'request.filename'};   $thisfn=$ENV{'request.filename'};
     }      }
 # is that filename actually a symb? Verify, clean, and return  # is that filename actually a symb? Verify, clean, and return
     if ($thisfn=~/\_\_\_\d+\_\_\_(.*)$/) {      if ($thisfn=~/\_\_\_\d+\_\_\_(.*)$/) {
  if (&symbverify($thisfn,$1)) {   if (&symbverify($thisfn,$1)) { return &symbclean($thisfn); }
     return $ENV{$cache_str}=&symbclean($thisfn);  
  }  
     }      }
     $thisfn=declutter($thisfn);      $thisfn=declutter($thisfn);
     my %hash;      my %hash;
Line 4666  sub symbread { Line 4631  sub symbread {
            unless ($syval=~/\_\d+$/) {             unless ($syval=~/\_\d+$/) {
        unless ($ENV{'form.request.prefix'}=~/\.(\d+)\_$/) {         unless ($ENV{'form.request.prefix'}=~/\.(\d+)\_$/) {
                   &appenv('request.ambiguous' => $thisfn);                    &appenv('request.ambiguous' => $thisfn);
   return $ENV{$cache_str}='';                    return '';
                }                     }    
                $syval.=$1;                 $syval.=$1;
    }     }
Line 4713  sub symbread { Line 4678  sub symbread {
            }             }
         }          }
         if ($syval) {          if ($syval) {
     return $ENV{$cache_str}=&symbclean($syval.'___'.$thisfn);             return &symbclean($syval.'___'.$thisfn); 
         }          }
     }      }
     &appenv('request.ambiguous' => $thisfn);      &appenv('request.ambiguous' => $thisfn);
     return $ENV{$cache_str}='';      return '';
 }  }
   
 # ---------------------------------------------------------- Return random seed  # ---------------------------------------------------------- Return random seed
Line 5103  sub filelocation { Line 5068  sub filelocation {
     $location = $file;      $location = $file;
     $location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:;      $location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:;
   } elsif ($file=~/^\/*uploaded/) { # is an uploaded file    } elsif ($file=~/^\/*uploaded/) { # is an uploaded file
     $location=$file;        if ($file=~/^\/uploaded\/([^\/]+)\/([^\/]+)\/(\/)?simplepage\/([^\/]+)$/) {
     $location=&Apache::loncommon::propath($1,$2).'/userfiles/simplepage/'.$4;
     if (not -e $location) {
         $file=~/^\/uploaded\/(.*)$/;
         $location=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles/'.$1;
     }
         } elsif ($file=~/^\/uploaded\/([^\/]+)\/([^\/]+)\/aboutme\/([^\/]+)$/) {
     $location=&Apache::loncommon::propath($1,$2).'/userfiles/aboutme/'.$3;
            if (not -e $location) {
        $file=~/^\/uploaded\/(.*)$/;
        $location=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles/'.$1;
            }
         } else {
     $location=$file;
         }
   } else {    } else {
     $file=~s/^\Q$perlvar{'lonDocRoot'}\E//;      $file=~s/^\Q$perlvar{'lonDocRoot'}\E//;
     $file=~s:^/res/:/:;      $file=~s:^/res/:/:;
Line 5994  put($namespace,$storehash,$udom,$uname) Line 5973  put($namespace,$storehash,$udom,$uname)
   
 =item *  =item *
   
   putstore($namespace,$storehash,$udomain,$uname) : stores hash in namesp
   keys used in storehash include version information (e.g., 1:$symb:message etc.) as
   used in records written by &store and retrieved by &restore.  This function 
   was created for use in editing discussion posts, without incrementing the
   version number included in the key for a particular post. The colon 
   separated list of attribute names (e.g., the value associated with the key 
   1:keys:$symb) is also generated and passed in the ampersand separated 
   items sent to lonnet::reply().  
   
   =item *
   
 cput($namespace,$storehash,$udom,$uname) : critical put  cput($namespace,$storehash,$udom,$uname) : critical put
 ($udom and $uname are optional)  ($udom and $uname are optional)
   
Removed from v.1.523.2.8  
changed lines
  Added in v.1.530

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