--- loncom/lonnet/perl/lonnet.pm	2013/05/21 18:57:45	1.1223
+++ loncom/lonnet/perl/lonnet.pm	2013/09/02 14:40:18	1.1238
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1223 2013/05/21 18:57:45 raeburn Exp $
+# $Id: lonnet.pm,v 1.1238 2013/09/02 14:40:18 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -1578,6 +1578,36 @@ sub idput {
     }
 }
 
+# ---------------------------------------- Delete unwanted IDs from ids.db file 
+
+sub iddel {
+    my ($udom,$idshashref,$uhome)=@_;
+    my %result=();
+    unless (ref($idshashref) eq 'HASH') {
+        return %result;
+    }
+    my %servers=();
+    while (my ($id,$uname) = each(%{$idshashref})) {
+        my $uhom;
+        if ($uhome) {
+            $uhom = $uhome;
+        } else {
+            $uhom=&homeserver($uname,$udom);
+        }
+        if ($uhom ne 'no_host') {
+            if ($servers{$uhom}) {
+                $servers{$uhom}.='&'.&escape($id);
+            } else {
+                $servers{$uhom}=&escape($id);
+            }
+        }
+    }
+    foreach my $server (keys(%servers)) {
+        $result{$server} = &critical('iddel:'.$udom.':'.$servers{$server},$uhome);
+    }
+    return %result;
+}
+
 # ------------------------------dump from db file owned by domainconfig user
 sub dump_dom {
     my ($namespace, $udom, $regexp) = @_;
@@ -1985,13 +2015,16 @@ sub get_domain_defaults {
             $domdefaults{'defaultquota'} = $domconfig{'quotas'}{'defaultquota'};
         } else {
             $domdefaults{'defaultquota'} = $domconfig{'quotas'};
-        } 
+        }
         my @usertools = ('aboutme','blog','webdav','portfolio');
         foreach my $item (@usertools) {
             if (ref($domconfig{'quotas'}{$item}) eq 'HASH') {
                 $domdefaults{$item} = $domconfig{'quotas'}{$item};
             }
         }
+        if (ref($domconfig{'quotas'}{'authorquota'}) eq 'HASH') {
+            $domdefaults{'authorquota'} = $domconfig{'quotas'}{'authorquota'};
+        }
     }
     if (ref($domconfig{'requestcourses'}) eq 'HASH') {
         foreach my $item ('official','unofficial','community') {
@@ -2007,13 +2040,16 @@ sub get_domain_defaults {
         }
     }
     if (ref($domconfig{'coursedefaults'}) eq 'HASH') {
-        foreach my $item ('canuse_pdfforms') {
-            $domdefaults{$item} = $domconfig{'coursedefaults'}{$item};
-        }
+        $domdefaults{'canuse_pdfforms'} = $domconfig{'coursedefaults'}{'canuse_pdfforms'};
         if (ref($domconfig{'coursedefaults'}{'coursecredits'}) eq 'HASH') {
             $domdefaults{'officialcredits'} = $domconfig{'coursedefaults'}{'coursecredits'}{'official'};
             $domdefaults{'unofficialcredits'} = $domconfig{'coursedefaults'}{'coursecredits'}{'unofficial'};
         }
+        if (ref($domconfig{'coursedefaults'}{'uploadquota'}) eq 'HASH') {
+            $domdefaults{'officialquota'} = $domconfig{'coursedefaults'}{'uploadquota'}{'official'};
+            $domdefaults{'unofficialquota'} = $domconfig{'coursedefaults'}{'uploadquota'}{'unofficial'};
+            $domdefaults{'communityquota'} = $domconfig{'coursedefaults'}{'uploadquota'}{'community'};           
+        }
     }
     if (ref($domconfig{'usersessions'}) eq 'HASH') {
         if (ref($domconfig{'usersessions'}{'remote'}) eq 'HASH') {
@@ -2816,6 +2852,13 @@ sub can_edit_resource {
                     $cfile =~ s{^http://}{};
                     $cfile = '/adm/wrapper/ext/'.$cfile;
                 }
+            } elsif ($resurl =~ m{^/?adm/viewclasslist$}) {
+                if ($env{'form.forceedit'}) {
+                    $forceview = 1;
+                } else {
+                    $forceedit = 1;
+                }
+                $cfile = ($resurl =~ m{^/} ? $resurl : "/$resurl");
             }
         }
         if ($uploaded || $incourse) {
@@ -4796,9 +4839,12 @@ sub restore {
     if ($stuname) { $home=&homeserver($stuname,$domain); }
 
     if (!$symb) {
-      unless ($symb=escape(&symbread())) { return ''; }
+        return if ($namespace eq 'courserequests');
+        unless ($symb=escape(&symbread())) { return ''; }
     } else {
-      $symb=&escape(&symbclean($symb));
+        unless ($namespace eq 'courserequests') {
+            $symb=&escape(&symbclean($symb));
+        }
     }
     if (!$namespace) { 
        unless ($namespace=$env{'request.course.id'}) { 
@@ -5495,7 +5541,7 @@ sub dump {
     if (grep { $_ eq $uhome } current_machine_ids()) {
         # user is hosted on this machine
         $reply = LONCAPA::Lond::dump_with_regexp(join(":", ($udomain,
-                    $uname, $namespace, $regexp, $range)), $loncaparevs{$uhome});
+                    $uname, $namespace, $regexp, $range)), $perlvar{'lonVersion'});
         return %{unserialize($reply, $escapedkeys)};
     }
     if ($regexp) {
@@ -7244,19 +7290,23 @@ sub definerole {
 # ---------------- Make a metadata query against the network of library servers
 
 sub metadata_query {
-    my ($query,$custom,$customshow,$server_array)=@_;
+    my ($query,$custom,$customshow,$server_array,$domains_hash)=@_;
     my %rhash;
     my %libserv = &all_library();
     my @server_list = (defined($server_array) ? @$server_array
                                               : keys(%libserv) );
     for my $server (@server_list) {
+        my $domains = ''; 
+        if (ref($domains_hash) eq 'HASH') {
+            $domains = $domains_hash->{$server}; 
+        }
 	unless ($custom or $customshow) {
-	    my $reply=&reply("querysend:".&escape($query),$server);
+	    my $reply=&reply("querysend:".&escape($query).':::'.&escape($domains),$server);
 	    $rhash{$server}=$reply;
 	}
 	else {
 	    my $reply=&reply("querysend:".&escape($query).':'.
-			     &escape($custom).':'.&escape($customshow),
+			     &escape($custom).':'.&escape($customshow).':'.&escape($domains),
 			     $server);
 	    $rhash{$server}=$reply;
 	}
@@ -8455,7 +8505,7 @@ sub modifystudent {
          $desiredhome,$email,$inststatus);
     unless ($reply eq 'ok') { return $reply; }
     # This will cause &modify_student_enrollment to get the uid from the
-    # students environment
+    # student's environment
     $uid = undef if (!$forceid);
     $reply = &modify_student_enrollment($udom,$uname,$uid,$first,$middle,$last,
                                         $gene,$usec,$end,$start,$type,$locktype,
@@ -8766,6 +8816,9 @@ sub store_userdata {
                     $namevalue.=&escape($key).'='.&freeze_escape($$storehash{$key}).'&';
                 }
                 $namevalue=~s/\&$//;
+                unless ($namespace eq 'courserequests') {
+                    $datakey = &escape($datakey);
+                }
                 $result =  &reply("store:$udom:$uname:$namespace:$datakey:".
                                   $namevalue,$uhome);
             }
@@ -9588,6 +9641,26 @@ sub resdata {
     return undef;
 }
 
+sub get_numsuppfiles {
+    my ($cnum,$cdom,$ignorecache)=@_;
+    my $hashid=$cnum.':'.$cdom;
+    my ($suppcount,$cached);
+    unless ($ignorecache) {
+        ($suppcount,$cached) = &is_cached_new('suppcount',$hashid);
+    }
+    unless (defined($cached)) {
+        my $chome=&homeserver($cnum,$cdom);
+        unless ($chome eq 'no_host') {
+            ($suppcount,my $errors) = (0,0);
+            my $suppmap = 'supplemental.sequence';
+            ($suppcount,$errors) = 
+                &Apache::loncommon::recurse_supplemental($cnum,$cdom,$suppmap,$suppcount,$errors);
+        }
+        &do_cache_new('suppcount',$hashid,$suppcount,600);
+    }
+    return $suppcount;
+}
+
 #
 # EXT resource caching routines
 #
@@ -9616,7 +9689,7 @@ sub EXT_cache_set {
 # --------------------------------------------------------- Value of a Variable
 sub EXT {
 
-    my ($varname,$symbparm,$udom,$uname,$usection,$recurse)=@_;
+    my ($varname,$symbparm,$udom,$uname,$usection,$recurse,$cid)=@_;
     unless ($varname) { return ''; }
     #get real user name/domain, courseid and symb
     my $courseid;
@@ -9731,26 +9804,51 @@ sub EXT {
 	    if (!$symbparm) { $symbparm=&symbread(); }
 	}
 
-	if ($space eq 'title') {
-	    if (!$symbparm) { $symbparm = $env{'request.filename'}; }
-	    return &gettitle($symbparm);
-	}
+        if ($qualifier eq '') {
+	    if ($space eq 'title') {
+	        if (!$symbparm) { $symbparm = $env{'request.filename'}; }
+	        return &gettitle($symbparm);
+	    }
 	
-	if ($space eq 'map') {
-	    my ($map) = &decode_symb($symbparm);
-	    return &symbread($map);
-	}
-	if ($space eq 'filename') {
-	    if ($symbparm) {
-		return &clutter((&decode_symb($symbparm))[2]);
+	    if ($space eq 'map') {
+	        my ($map) = &decode_symb($symbparm);
+	        return &symbread($map);
+	    }
+            if ($space eq 'maptitle') {
+                my ($map) = &decode_symb($symbparm);
+                return &gettitle($map);
+            }
+	    if ($space eq 'filename') {
+	        if ($symbparm) {
+		    return &clutter((&decode_symb($symbparm))[2]);
+	        }
+	        return &hreflocation('',$env{'request.filename'});
 	    }
-	    return &hreflocation('',$env{'request.filename'});
-	}
+
+            if ((defined($courseid)) && ($courseid eq $env{'request.course.id'}) && $symbparm) {
+                if ($space eq 'visibleparts') {
+                    my $navmap = Apache::lonnavmaps::navmap->new();
+                    my $item;
+                    if (ref($navmap)) {
+                        my $res = $navmap->getBySymb($symbparm);
+                        my $parts = $res->parts();
+                        if (ref($parts) eq 'ARRAY') {
+                            $item = join(',',@{$parts});
+                        }
+                        undef($navmap);
+                    }
+                    return $item;
+                }
+            }
+        }
 
 	my ($section, $group, @groups);
 	my ($courselevelm,$courselevel);
-	if ($symbparm && defined($courseid) && 
-	    $courseid eq $env{'request.course.id'}) {
+        if (($courseid eq '') && ($cid)) {
+            $courseid = $cid;
+        }
+	if (($symbparm && $courseid) && 
+	    (($courseid eq $env{'request.course.id'}) || ($courseid eq $cid)))  {
 
 	    #print '<br>'.$space.' - '.$qualifier.' - '.$spacequalifierrest;
 
@@ -11610,30 +11708,12 @@ sub parse_dns_checksums_tab {
     my (%chksum,%revnum);
     if (ref($lines) eq 'ARRAY') {
         chomp(@{$lines});
-        my $versions = shift(@{$lines});
-        my %supported;
-        if ($versions =~ /^VERSIONS\:([\w\.\,]+)$/) {
-            my $releaseslist = $1;
-            if ($releaseslist =~ /,/) {
-                map { $supported{$_} = 1; } split(/,/,$releaseslist);
-            } elsif ($releaseslist) {
-                $supported{$releaseslist} = 1;
-            }
-        }
-        if ($supported{$release}) {  
-            my $matchthis = 0;
+        my $version = shift(@{$lines});
+        if ($version eq $release) {  
             foreach my $line (@{$lines}) {
-                if ($line =~ /^(\d[\w\.]+)$/) {
-                    if ($matchthis) {
-                        last;
-                    } elsif ($1 eq $release) {
-                        $matchthis = 1;
-                    }
-                } elsif ($matchthis) {
-                    my ($file,$version,$shasum) = split(/,/,$line);
-                    $chksum{$file} = $shasum;
-                    $revnum{$file} = $version;
-                }
+                my ($file,$version,$shasum) = split(/,/,$line);
+                $chksum{$file} = $shasum;
+                $revnum{$file} = $version;
             }
             if (ref($hashref) eq 'HASH') {
                 %{$hashref} = (
@@ -11647,8 +11727,11 @@ sub parse_dns_checksums_tab {
 }
 
 sub fetch_dns_checksums {
-    my %checksums; 
-    &get_dns('/adm/dns/checksums',\&parse_dns_checksums_tab,1,1,
+    my %checksums;
+    my $machine_dom = &Apache::lonnet::host_domain($perlvar{'lonHostID'});
+    my $loncaparev = &get_server_loncaparev($machine_dom);
+    my ($release,$timestamp) = split(/\-/,$loncaparev);
+    &get_dns("/adm/dns/checksums/$release",\&parse_dns_checksums_tab,1,1,
              \%checksums);
     return \%checksums;
 }
@@ -12029,6 +12112,39 @@ sub all_loncaparevs {
     return qw(1.1 1.2 1.3 2.0 2.1 2.2 2.3 2.4 2.5 2.6 2.7 2.8 2.9 2.10);
 }
 
+# ---------------------------------------------------------- Read loncaparev table
+{
+    sub load_loncaparevs { 
+        if (-e "$perlvar{'lonTabDir'}/loncaparevs.tab") {
+            if (open(my $config,"<$perlvar{'lonTabDir'}/loncaparevs.tab")) {
+                while (my $configline=<$config>) {
+                    chomp($configline);
+                    my ($hostid,$loncaparev)=split(/:/,$configline);
+                    $loncaparevs{$hostid}=$loncaparev;
+                }
+                close($config);
+            }
+        }
+    }
+}
+
+# ---------------------------------------------------------- Read serverhostID table
+{
+    sub load_serverhomeIDs {
+        if (-e "$perlvar{'lonTabDir'}/serverhomeIDs.tab") {
+            if (open(my $config,"<$perlvar{'lonTabDir'}/serverhomeIDs.tab")) {
+                while (my $configline=<$config>) {
+                    chomp($configline);
+                    my ($name,$id)=split(/:/,$configline);
+                    $serverhomeIDs{$name}=$id;
+                }
+                close($config);
+            }
+        }
+    }
+}
+
+
 BEGIN {
 
 # ----------------------------------- Read loncapa.conf and loncapa_apache.conf
@@ -12105,33 +12221,14 @@ BEGIN {
 }
 
 # ---------------------------------------------------------- Read loncaparev table
-{
-    if (-e "$perlvar{'lonTabDir'}/loncaparevs.tab") {
-        if (open(my $config,"<$perlvar{'lonTabDir'}/loncaparevs.tab")) {
-            while (my $configline=<$config>) {
-                chomp($configline);
-                my ($hostid,$loncaparev)=split(/:/,$configline);
-                $loncaparevs{$hostid}=$loncaparev;
-            }
-            close($config);
-        }
-    }
-}
+
+&load_loncaparevs();
 
 # ---------------------------------------------------------- Read serverhostID table
-{
-    if (-e "$perlvar{'lonTabDir'}/serverhomeIDs.tab") {
-        if (open(my $config,"<$perlvar{'lonTabDir'}/serverhomeIDs.tab")) {
-            while (my $configline=<$config>) {
-                chomp($configline);
-                my ($name,$id)=split(/:/,$configline);
-                $serverhomeIDs{$name}=$id;
-            }
-            close($config);
-        }
-    }
-}
 
+&load_serverhomeIDs();
+
+# ---------------------------------------------------------- Read releaseslist XML
 {
     my $file = $Apache::lonnet::perlvar{'lonTabDir'}.'/releaseslist.xml';
     if (-e $file) {
@@ -12341,8 +12438,8 @@ were new keys. I.E. 1:foo will become 1:
 
 Calling convention:
 
- my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$uname,$home);
- &Apache::lonnet::cstore(\%newrecord,$symb,$courseid,$domain,$uname,$home);
+ my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$uname);
+ &Apache::lonnet::cstore(\%newrecord,$symb,$courseid,$domain,$uname);
 
 For more detailed information, see lonnet specific documentation.
 
@@ -12609,8 +12706,8 @@ or when Autoupdate.pl is run by cron in
 modifystudent
 
 modify a student's enrollment and identification information.
-The course id is resolved based on the current users environment.  
-This means the envoking user must be a course coordinator or otherwise
+The course id is resolved based on the current user's environment.  
+This means the invoking user must be a course coordinator or otherwise
 associated with a course.
 
 This call is essentially a wrapper for lonnet::modifyuser and
@@ -12670,20 +12767,20 @@ Inputs:
 
 modify_student_enrollment
 
-Change a students enrollment status in a class.  The environment variable
+Change a student's enrollment status in a class.  The environment variable
 'role.request.course' must be defined for this function to proceed.
 
 Inputs:
 
 =over 4
 
-=item $udom, students domain
+=item $udom, student's domain
 
-=item $uname, students name
+=item $uname, student's name
 
-=item $uid, students user id
+=item $uid, student's user id
 
-=item $first, students first name
+=item $first, student's first name
 
 =item $middle
 
@@ -12765,7 +12862,7 @@ If defined, the supplied username is use
 resdata($name,$domain,$type,@which) : request for current parameter
 setting for a specific $type, where $type is either 'course' or 'user',
 @what should be a list of parameters to ask about. This routine caches
-answers for 5 minutes.
+answers for 10 minutes.
 
 =item *
 
@@ -12774,6 +12871,10 @@ data base, returning a hash that is keye
 values that are the resource value.  I believe that the timestamps and
 versions are also returned.
 
+get_numsuppfiles($cnum,$cdom) : retrieve number of files in a course's
+supplemental content area. This routine caches the number of files for 
+10 minutes.
+
 =back
 
 =head2 Course Modification
@@ -12833,10 +12934,15 @@ resource. Expects the local filesystem p
 
 =item *
 
-EXT($varname,$symb,$udom,$uname) : evaluates and returns the value of
-a vairety of different possible values, $varname should be a request
-string, and the other parameters can be used to specify who and what
-one is asking about.
+EXT($varname,$symb,$udom,$uname,$usection,$recurse,$cid) : evaluates 
+and returns the value of a variety of different possible values,
+$varname should be a request string, and the other parameters can be
+used to specify who and what one is asking about. Ordinarily, $cid 
+does not need to be specified, as it is retrived from 
+$env{'request.course.id'}, but &Apache::lonnet::EXT() is called
+within lonuserstate::loadmap() when initializing a course, before
+$env{'request.course.id'} has been set, so it needs to be provided
+in that one case.
 
 Possible values for $varname are environment.lastname (or other item
 from the envirnment hash), user.name (or someother aspect about the