[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.624 and 1.637

version 1.624, 2005/04/15 22:03:23 version 1.637, 2005/06/11 13:38:47
Line 47  use IO::Socket; Line 47  use IO::Socket;
 use GDBM_File;  use GDBM_File;
 use Apache::Constants qw(:common :http);  use Apache::Constants qw(:common :http);
 use HTML::LCParser;  use HTML::LCParser;
   use HTML::Parser;
 use Fcntl qw(:flock);  use Fcntl qw(:flock);
 use Apache::lonlocal;  use Apache::lonlocal;
 use Storable qw(lock_store lock_nstore lock_retrieve freeze thaw nfreeze);  use Storable qw(lock_store lock_nstore lock_retrieve freeze thaw nfreeze);
Line 827  sub getsection { Line 828  sub getsection {
 }  }
   
 sub save_cache {  sub save_cache {
       my ($r)=@_;
       if (! $r->is_initial_req()) { return DECLINED; }
     &purge_remembered();      &purge_remembered();
     undef(%env);      undef(%env);
       return OK;
 }  }
   
 my $to_remember=-1;  my $to_remember=-1;
Line 1129  sub allowuploaded { Line 1133  sub allowuploaded {
   
 # --------- File operations in /home/httpd/html/userfiles/$domain/1/2/3/$course  # --------- File operations in /home/httpd/html/userfiles/$domain/1/2/3/$course
 # input: action, courseID, current domain, home server for course, intended  # input: action, courseID, current domain, home server for course, intended
 #        path to file, source of file.  #        path to file, source of file, instruction to parse file for objects,
   #        ref to hash for embedded objects,
   #        ref to hash for codebase of java objects.
   #
 # output: url to file (if action was uploaddoc),   # output: url to file (if action was uploaddoc), 
 #         ok if successful, or diagnostic message otherwise (if action was propagate or copy)  #         ok if successful, or diagnostic message otherwise (if action was propagate or copy)
 #  #
Line 1152  sub allowuploaded { Line 1159  sub allowuploaded {
 #         /home/httpd/html/userfiles/$domain/1/2/3/$course/$file  #         /home/httpd/html/userfiles/$domain/1/2/3/$course/$file
 #         and will then be copied to /home/httpd/lonUsers/1/2/3/$course/userfiles/$file  #         and will then be copied to /home/httpd/lonUsers/1/2/3/$course/userfiles/$file
 #         in course's home server.  #         in course's home server.
   #
   
 sub process_coursefile {  sub process_coursefile {
     my ($action,$docuname,$docudom,$docuhome,$file,$source)=@_;      my ($action,$docuname,$docudom,$docuhome,$file,$source,$parser,$allfiles,$codebase)=@_;
     my $fetchresult;      my $fetchresult;
     if ($action eq 'propagate') {      if ($action eq 'propagate') {
         $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file          $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file
Line 1166  sub process_coursefile { Line 1173  sub process_coursefile {
         my $fname = $file;          my $fname = $file;
         ($fpath,$fname) = ($file =~ m|^(.*)/([^/]+)$|);          ($fpath,$fname) = ($file =~ m|^(.*)/([^/]+)$|);
         $fpath=$docudom.'/'.$docuname.'/'.$fpath;          $fpath=$docudom.'/'.$docuname.'/'.$fpath;
         my $filepath=$perlvar{'lonDocRoot'}.'/userfiles';          my $filepath = &build_filepath($fpath);
         unless ($fpath eq '') {  
             my @parts=split('/',$fpath);  
             foreach my $part (@parts) {  
                 $filepath.= '/'.$part;  
                 if ((-e $filepath)!=1) {  
                     mkdir($filepath,0777);  
                 }  
             }  
         }  
         if ($action eq 'copy') {          if ($action eq 'copy') {
             if ($source eq '') {              if ($source eq '') {
                 $fetchresult = 'no source file';                  $fetchresult = 'no source file';
Line 1190  sub process_coursefile { Line 1188  sub process_coursefile {
             open(my $fh,'>'.$filepath.'/'.$fname);              open(my $fh,'>'.$filepath.'/'.$fname);
             print $fh $env{'form.'.$source};              print $fh $env{'form.'.$source};
             close($fh);              close($fh);
               if ($parser eq 'parse') {
                   my $parse_result = &extract_embedded_items($filepath,$fname,$allfiles,$codebase);
                   unless ($parse_result eq 'ok') {
                       &logthis('Failed to parse '.$filepath.'/'.$fname.' for embedded media: '.$parse_result);
                   }
               }
             $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file,              $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file,
                                  $docuhome);                                   $docuhome);
             if ($fetchresult eq 'ok') {              if ($fetchresult eq 'ok') {
Line 1208  sub process_coursefile { Line 1212  sub process_coursefile {
     return $fetchresult;      return $fetchresult;
 }  }
   
   sub build_filepath {
       my ($fpath) = @_;
       my $filepath=$perlvar{'lonDocRoot'}.'/userfiles';
       unless ($fpath eq '') {
           my @parts=split('/',$fpath);
           foreach my $part (@parts) {
               $filepath.= '/'.$part;
               if ((-e $filepath)!=1) {
                   mkdir($filepath,0777);
               }
           }
       }
       return $filepath;
   }
   
   sub store_edited_file {
       my ($primary_url,$content,$docudom,$docuname,$docuhome,$fetchresult) = @_;
       my $file = $primary_url;
       $file =~ s#^/uploaded/$docudom/$docuname/##;
       my $fpath = '';
       my $fname = $file;
       ($fpath,$fname) = ($file =~ m|^(.*)/([^/]+)$|);
       $fpath=$docudom.'/'.$docuname.'/'.$fpath;
       my $filepath = &build_filepath($fpath);
       open(my $fh,'>'.$filepath.'/'.$fname);
       print $fh $content;
       close($fh);
       $$fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file,
                                    $docuhome);
       if ($$fetchresult eq 'ok') {
           return '/uploaded/'.$fpath.'/'.$fname;
       } else {
           &logthis('Failed to transfer '.$docudom.'/'.$docuname.'/'.$file.                        ' to host '.$docuhome.': '.$$fetchresult);
           return '/adm/notfound.html';
       }
   }
   
 sub clean_filename {  sub clean_filename {
     my ($fname)=@_;      my ($fname)=@_;
 # Replace Windows backslashes by forward slashes  # Replace Windows backslashes by forward slashes
Line 1230  sub clean_filename { Line 1271  sub clean_filename {
   
   
 sub userfileupload {  sub userfileupload {
     my ($formname,$coursedoc,$subdir)=@_;      my ($formname,$coursedoc,$subdir,$parser,$allfiles,$codebase)=@_;
     if (!defined($subdir)) { $subdir='unknown'; }      if (!defined($subdir)) { $subdir='unknown'; }
     my $fname=$env{'form.'.$formname.'.filename'};      my $fname=$env{'form.'.$formname.'.filename'};
     $fname=&clean_filename($fname);      $fname=&clean_filename($fname);
Line 1263  sub userfileupload { Line 1304  sub userfileupload {
  $docudom=$env{'course.'.$env{'request.course.id'}.'.domain'};   $docudom=$env{'course.'.$env{'request.course.id'}.'.domain'};
  $docuhome=$env{'course.'.$env{'request.course.id'}.'.home'};   $docuhome=$env{'course.'.$env{'request.course.id'}.'.home'};
         if ($env{'form.folder'} =~ m/^default/) {          if ($env{'form.folder'} =~ m/^default/) {
             return &finishuserfileupload($docuname,$docudom,$docuhome,$formname,$fname);              return &finishuserfileupload($docuname,$docudom,$docuhome,$formname,$fname,$parser,$allfiles,$codebase);
         } else {          } else {
             $fname=$env{'form.folder'}.'/'.$fname;              $fname=$env{'form.folder'}.'/'.$fname;
             return &process_coursefile('uploaddoc',$docuname,$docudom,$docuhome,$fname,$formname);              return &process_coursefile('uploaddoc',$docuname,$docudom,$docuhome,$fname,$formname,$parser,$allfiles,$codebase);
         }          }
     } else {      } else {
         $docuname=$env{'user.name'};          $docuname=$env{'user.name'};
         $docudom=$env{'user.domain'};          $docudom=$env{'user.domain'};
         $docuhome=$env{'user.home'};          $docuhome=$env{'user.home'};
         return &finishuserfileupload($docuname,$docudom,$docuhome,$formname,$fname);          return &finishuserfileupload($docuname,$docudom,$docuhome,$formname,$fname,$parser,$allfiles,$codebase);
     }      }
 }  }
   
 sub finishuserfileupload {  sub finishuserfileupload {
     my ($docuname,$docudom,$docuhome,$formname,$fname)=@_;      my ($docuname,$docudom,$docuhome,$formname,$fname,$parser,$allfiles,$codebase) = @_;
     my $path=$docudom.'/'.$docuname.'/';      my $path=$docudom.'/'.$docuname.'/';
     my $filepath=$perlvar{'lonDocRoot'};      my $filepath=$perlvar{'lonDocRoot'};
     my ($fnamepath,$file);      my ($fnamepath,$file);
Line 1300  sub finishuserfileupload { Line 1341  sub finishuserfileupload {
  print FH $env{'form.'.$formname};   print FH $env{'form.'.$formname};
  close(FH);   close(FH);
     }      }
       if ($parser eq 'parse') {
           my $parse_result = &extract_embedded_items($filepath,$file,$allfiles,$codebase);
           unless ($parse_result eq 'ok') {
               &logthis('Failed to parse '.$filepath.$file.' for embedded media: '.$parse_result); 
           }
       }
 # Notify homeserver to grep it  # Notify homeserver to grep it
 #  #
     my $fetchresult= &reply('fetchuserfile:'.$path.$file,$docuhome);      my $fetchresult= &reply('fetchuserfile:'.$path.$file,$docuhome);
Line 1314  sub finishuserfileupload { Line 1361  sub finishuserfileupload {
     }          }    
 }  }
   
   sub extract_embedded_items {
       my ($filepath,$file,$allfiles,$codebase) = @_;
       my @state = ();
       my %javafiles = (
                         codebase => '',
                         code => '',
                         archive => ''
                       );
       my %mediafiles = (
                         src => '',
                         movie => '',
                        );
       my $p = HTML::Parser->new
       (
           xml_mode => 1,
           start_h =>
               [sub {
                    my ($tagname, $attr) = @_;
                    push (@state, $tagname);
                    if (lc($tagname) eq 'img') {
                        if (exists($$allfiles{$attr->{'src'}})) {
                            unless (grep/^src$/,@{$$allfiles{$attr->{'src'}}}) {
                                push (@{$$allfiles{$attr->{'src'}}},&escape('src'));
                            }
                        } else {
                            @{$$allfiles{$attr->{'src'}}} = (&escape('src'));
                        }
                    }
                    if (lc($tagname) eq 'object') {
                        foreach my $item (keys (%javafiles)) {
                            $javafiles{$item} = '';
                        }
                    }
                    if (lc($state[-2]) eq 'object') {
                        if (lc($tagname) eq 'param') {
                            my $name = lc($attr->{'name'});
                            foreach my $item (keys (%mediafiles)) {
                                if ($name eq $item) {
                                    if (exists($$allfiles{$attr->{'value'}})) {
                                        unless(grep/^value$/,@{$$allfiles{$attr->{'value'}}}) {
                                            push(@{$$allfiles{$attr->{'value'}}},&escape('value'));
                                        }
                                    } else {
                                        @{$$allfiles{$attr->{'value'}}} = (&escape('value'));
                                    }
                                    last;
                                }
                            }
                            foreach my $item (keys (%javafiles)) {
                                if ($name eq $item) {
                                    $javafiles{$item} = $attr->{'value'};
                                    last;
                                }
                            }
                        }
                    }
                    if (lc($tagname) eq 'embed') {
                        unless (lc($state[-2]) eq 'object') {
                            foreach my $item (keys (%javafiles)) {
                                $javafiles{$item} = '';
                            }
                        }
                        foreach my $item (keys (%javafiles)) {
                            if ($attr->{$item}) {
                                $javafiles{$item} = $attr->{$item};
                                last;
                            }
                        }
                        foreach my $item (keys (%mediafiles)) {
                            if ($attr->{$item}) {
                                if (exists($$allfiles{$attr->{$item}})) {
                                    unless (grep/^$item$/,@{$$allfiles{$item}}) {
                                        push(@{$$allfiles{$attr->{$item}}},&escape($item));
                                    }
                                } else {
                                    @{$$allfiles{$attr->{$item}}} = (&escape($item));
                                }
                                last;
                            }
                        }
                    }
               }, "tagname, attr"],
           text_h =>
                [sub {
                    my ($text) = @_;
           }, "dtext"],
           end_h =>
                  [sub {
                      my ($tagname) = @_;
                      unless ($javafiles{'codebase'} eq '') {
                          $javafiles{'codebase'} .= '/';
                      }  
                      if (lc($tagname) eq 'object') {
                          &extract_java_items(\%javafiles,$allfiles,$codebase);
                      } 
                      if (lc($tagname) eq 'embed') {
                          unless (lc($state[-2]) eq 'object') {
                              &extract_java_items(\%javafiles,$allfiles,$codebase);
                          }
                      }
                      pop @state;
                   }, "tagname"],
       );
       $p->parse_file($filepath.'/'.$file);
       $p->eof;
       return 'ok';
   }
   
   sub extract_java_items {
       my ($javafiles,$allfiles,$codebase) = @_;
       foreach my $item (keys (%{$javafiles})) {
           unless ($item eq 'codebase') {
               if ($$javafiles{$item} ne '') {
                   if (exists($$allfiles{$$javafiles{'codebase'}.$$javafiles{$item}})) {
                       unless (grep/^$item$/,@{$$allfiles{$$javafiles{'codebase'}.$$javafiles{$item}}}) {
                           push(@{$$allfiles{$$javafiles{'codebase'}.$$javafiles{$item}}},&escape($item));
                       }
                   } else {
                       @{$$allfiles{$$javafiles{'codebase'}.$$javafiles{$item}}} = (&escape($item));
                       $$codebase{$$javafiles{'codebase'}.$$javafiles{$item}} = $$javafiles{'codebase'};
                                                                                   
                   }
               }
           }
       }
   }
   
 sub removeuploadedurl {  sub removeuploadedurl {
     my ($url)=@_;      my ($url)=@_;
     my (undef,undef,$udom,$uname,$fname)=split('/',$url,5);      my (undef,undef,$udom,$uname,$fname)=split('/',$url,5);
Line 2561  sub convert_dump_to_currentdump{ Line 2735  sub convert_dump_to_currentdump{
     return \%returnhash;      return \%returnhash;
 }  }
   
   # ------------------------------------------------------ critical inc interface
   
   sub cinc {
       return &inc(@_,'critical');
   }
   
 # --------------------------------------------------------------- inc interface  # --------------------------------------------------------------- inc interface
   
 sub inc {  sub inc {
     my ($namespace,$store,$udomain,$uname) = @_;      my ($namespace,$store,$udomain,$uname,$critical) = @_;
     if (!$udomain) { $udomain=$env{'user.domain'}; }      if (!$udomain) { $udomain=$env{'user.domain'}; }
     if (!$uname) { $uname=$env{'user.name'}; }      if (!$uname) { $uname=$env{'user.name'}; }
     my $uhome=&homeserver($uname,$udomain);      my $uhome=&homeserver($uname,$udomain);
Line 2582  sub inc { Line 2762  sub inc {
         }          }
     }      }
     $items=~s/\&$//;      $items=~s/\&$//;
     return &reply("inc:$udomain:$uname:$namespace:$items",$uhome);      if ($critical) {
    return &critical("inc:$udomain:$uname:$namespace:$items",$uhome);
       } else {
    return &reply("inc:$udomain:$uname:$namespace:$items",$uhome);
       }
 }  }
   
 # --------------------------------------------------------------- put interface  # --------------------------------------------------------------- put interface
Line 2600  sub put { Line 2784  sub put {
    return &reply("put:$udomain:$uname:$namespace:$items",$uhome);     return &reply("put:$udomain:$uname:$namespace:$items",$uhome);
 }  }
   
 # ---------------------------------------------------------- putstore interface  # ------------------------------------------------------------ newput interface
                                                                                        
   sub newput {
      my ($namespace,$storehash,$udomain,$uname)=@_;
      if (!$udomain) { $udomain=$env{'user.domain'}; }
      if (!$uname) { $uname=$env{'user.name'}; }
      my $uhome=&homeserver($uname,$udomain);
      my $items='';
      foreach my $key (keys(%$storehash)) {
          $items.=&escape($key).'='.&freeze_escape($$storehash{$key}).'&';
      }
      $items=~s/\&$//;
      return &reply("newput:$udomain:$uname:$namespace:$items",$uhome);
   }
   
   # ---------------------------------------------------------  putstore interface
   
 sub putstore {  sub putstore {
    my ($namespace,$storehash,$udomain,$uname)=@_;     my ($namespace,$storehash,$udomain,$uname)=@_;
    if (!$udomain) { $udomain=$env{'user.domain'}; }     if (!$udomain) { $udomain=$env{'user.domain'}; }
Line 3743  sub mark_as_readonly { Line 3942  sub mark_as_readonly {
     my %current_permissions = &dump('file_permissions',$domain,$user);      my %current_permissions = &dump('file_permissions',$domain,$user);
     my ($tmp)=keys(%current_permissions);      my ($tmp)=keys(%current_permissions);
     if ($tmp=~/^error:/) { undef(%current_permissions); }      if ($tmp=~/^error:/) { undef(%current_permissions); }
   
     foreach my $file (@{$files}) {      foreach my $file (@{$files}) {
         push(@{$current_permissions{$file}},$what);          push(@{$current_permissions{$file}},$what);
     }      }
Line 3822  sub files_not_in_path { Line 4020  sub files_not_in_path {
   
 #--------------------------------------------------------------Get Marked as Read Only  #--------------------------------------------------------------Get Marked as Read Only
   
   
 sub get_marked_as_readonly {  sub get_marked_as_readonly {
     my ($domain,$user,$what) = @_;      my ($domain,$user,$what) = @_;
     my %current_permissions = &dump('file_permissions',$domain,$user);      my %current_permissions = &dump('file_permissions',$domain,$user);
     my ($tmp)=keys(%current_permissions);      my ($tmp)=keys(%current_permissions);
     if ($tmp=~/^error:/) { undef(%current_permissions); }      if ($tmp=~/^error:/) { undef(%current_permissions); }
   
     my @readonly_files;      my @readonly_files;
       my $cmp1=$what;
       if (ref($what)) { $cmp1=join('',@{$what}) };
     while (my ($file_name,$value) = each(%current_permissions)) {      while (my ($file_name,$value) = each(%current_permissions)) {
         if (ref($value) eq "ARRAY"){          if (ref($value) eq "ARRAY"){
             foreach my $stored_what (@{$value}) {              foreach my $stored_what (@{$value}) {
                 if ($stored_what eq $what) {                  my $cmp2=$stored_what;
                   if (ref($stored_what)) { $cmp2=join('',@{$stored_what}) };
                   if ($cmp1 eq $cmp2) {
                     push(@readonly_files, $file_name);                      push(@readonly_files, $file_name);
                 } elsif (!defined($what)) {                  } elsif (!defined($what)) {
                     push(@readonly_files, $file_name);                      push(@readonly_files, $file_name);
Line 3867  sub get_marked_as_readonly_hash { Line 4069  sub get_marked_as_readonly_hash {
 # ------------------------------------------------------------ Unmark as Read Only  # ------------------------------------------------------------ Unmark as Read Only
   
 sub unmark_as_readonly {  sub unmark_as_readonly {
     # unmarks all files locked by $what       # unmarks $file_name (if $file_name is defined), or all files locked by $what 
     # for portfolio submissions, $what contains $crsid and $symb      # for portfolio submissions, $what contains [$symb,$crsid] 
     my ($domain,$user,$what) = @_;      my ($domain,$user,$what,$file_name) = @_;
       my $symb_crs = $what;
       if (ref($what)) { $symb_crs=join('',@$what); }
     my %current_permissions = &dump('file_permissions',$domain,$user);      my %current_permissions = &dump('file_permissions',$domain,$user);
     my ($tmp)=keys(%current_permissions);      my ($tmp)=keys(%current_permissions);
     if ($tmp=~/^error:/) { undef(%current_permissions); }      if ($tmp=~/^error:/) { undef(%current_permissions); }
   
     my @readonly_files = &get_marked_as_readonly($domain,$user,$what);      my @readonly_files = &get_marked_as_readonly($domain,$user,$what);
     foreach my $file(@readonly_files){      foreach my $file(@readonly_files){
         my $current_locks = $current_permissions{$file};          my $current_locks = $current_permissions{$file};
Line 3881  sub unmark_as_readonly { Line 4084  sub unmark_as_readonly {
         my @del_keys;          my @del_keys;
         if (ref($current_locks) eq "ARRAY"){          if (ref($current_locks) eq "ARRAY"){
             foreach my $locker (@{$current_locks}) {              foreach my $locker (@{$current_locks}) {
                 unless ($locker eq $what) {                  my $compare=$locker;
                   if (ref($locker)) { $compare=join('',@{$locker}) };
                   if ($compare eq $symb_crs) {
                       if (defined($file_name) && ($file_name ne $file)) {
                           push(@new_locks, $what);
                       }
                   } else {
                     push(@new_locks, $what);                      push(@new_locks, $what);
                 }                  }
             }              }
Line 4107  sub get_courseresdata { Line 4316  sub get_courseresdata {
     return $result;      return $result;
 }  }
   
   sub devalidateuserresdata {
       my ($uname,$udom)=@_;
       my $hashid="$udom:$uname";
       &devalidate_cache_new('userres',$hashid);
   }
   
 sub get_userresdata {  sub get_userresdata {
     my ($uname,$udom)=@_;      my ($uname,$udom)=@_;
     #most student don\'t have any data set, check if there is some data      #most student don\'t have any data set, check if there is some data
Line 4130  sub get_userresdata { Line 4345  sub get_userresdata {
  $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);
    &do_cache_new('userres',$hashid,undef,600);
    undef($tmp); # not really an error so don't send it back
     }      }
     return $tmp;      return $tmp;
 }  }
Line 4174  sub EXT_cache_status { Line 4391  sub EXT_cache_status {
 sub EXT_cache_set {  sub EXT_cache_set {
     my ($target_domain,$target_user) = @_;      my ($target_domain,$target_user) = @_;
     my $cachename = 'cache.EXT.'.$target_user.'.'.$target_domain;      my $cachename = 'cache.EXT.'.$target_user.'.'.$target_domain;
     &appenv($cachename => time);      #&appenv($cachename => time);
 }  }
   
 # --------------------------------------------------------- Value of a Variable  # --------------------------------------------------------- Value of a Variable
Line 4605  sub metadata { Line 4822  sub metadata {
  }   }
  my ($extension) = ($uri =~ /\.(\w+)$/);   my ($extension) = ($uri =~ /\.(\w+)$/);
  foreach my $key (sort(keys(%packagetab))) {   foreach my $key (sort(keys(%packagetab))) {
     #&logthis("extsion1 $extension $key !!");  
     #no specific packages #how's our extension      #no specific packages #how's our extension
     if ($key!~/^extension_\Q$extension\E&/) { next; }      if ($key!~/^extension_\Q$extension\E&/) { next; }
     &metadata_create_package_def($uri,$key,'extension_'.$extension,      &metadata_create_package_def($uri,$key,'extension_'.$extension,
Line 4937  sub symbread { Line 5153  sub symbread {
                  if ($#possibilities==0) {                   if ($#possibilities==0) {
 # ----------------------------------------------- There is only one possibility  # ----------------------------------------------- There is only one possibility
      my ($mapid,$resid)=split(/\./,$ids);       my ($mapid,$resid)=split(/\./,$ids);
                      $syval=declutter($bighash{'map_id_'.$mapid}).'___'.$resid;       $syval=&encode_symb($bighash{'map_id_'.$mapid},
       $resid,$thisfn);
                  } elsif (!$donotrecurse) {                   } elsif (!$donotrecurse) {
 # ------------------------------------------ There is more than one possibility  # ------------------------------------------ There is more than one possibility
                      my $realpossible=0;                       my $realpossible=0;
Line 4947  sub symbread { Line 5164  sub symbread {
              my ($mapid,$resid)=split(/\./,$_);               my ($mapid,$resid)=split(/\./,$_);
                             if ($bighash{'map_type_'.$mapid} ne 'page') {                              if ($bighash{'map_type_'.$mapid} ne 'page') {
  $realpossible++;   $realpossible++;
                                 $syval=declutter($bighash{'map_id_'.$mapid}).                                  $syval=&encode_symb($bighash{'map_id_'.$mapid},
                                        '___'.$resid;      $resid,$thisfn);
                             }                              }
  }   }
                      }                       }
Line 4962  sub symbread { Line 5179  sub symbread {
         }          }
         if ($syval) {          if ($syval) {
     return $env{$cache_str}=$syval;      return $env{$cache_str}=$syval;
     #return $env{$cache_str}=&symbclean($syval.'___'.$thisfn);  
         }          }
     }      }
     &appenv('request.ambiguous' => $thisfn);      &appenv('request.ambiguous' => $thisfn);
Line 6157  revokecustomrole($udom,$uname,$url,$role Line 6373  revokecustomrole($udom,$uname,$url,$role
   
 =item *  =item *
   
 coursedescription($courseid) : course description  coursedescription($courseid) : returns a hash of information about the
   specified course id, including all environment settings for the
   course, the description of the course will be in the hash under the
   key 'description'
   
 =item *  =item *
   
Removed from v.1.624  
changed lines
  Added in v.1.637

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