--- loncom/lonnet/perl/lonnet.pm	2015/10/26 16:03:42	1.1295
+++ loncom/lonnet/perl/lonnet.pm	2016/03/02 14:14:14	1.1301
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1295 2015/10/26 16:03:42 raeburn Exp $
+# $Id: lonnet.pm,v 1.1301 2016/03/02 14:14:14 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -1551,17 +1551,33 @@ sub homeserver {
     return 'no_host';
 }
 
-# ------------------------------------- Find the usernames behind a list of IDs
+# ----- Find the usernames behind a list of student/employee IDs or clicker IDs
 
 sub idget {
-    my ($udom,@ids)=@_;
+    my ($udom,$idsref,$namespace)=@_;
     my %returnhash=();
+    my @ids=(); 
+    if (ref($idsref) eq 'ARRAY') {
+        @ids = @{$idsref};
+    } else {
+        return %returnhash; 
+    }
+    if ($namespace eq '') {
+        $namespace = 'ids';
+    }
     
     my %servers = &get_servers($udom,'library');
     foreach my $tryserver (keys(%servers)) {
-	my $idlist=join('&',@ids);
-	$idlist=~tr/A-Z/a-z/; 
-	my $reply=&reply("idget:$udom:".$idlist,$tryserver);
+	my $idlist=join('&', map { &escape($_); } @ids);
+	if ($namespace eq 'ids') {
+	    $idlist=~tr/A-Z/a-z/;
+	}
+	my $reply;
+	if ($namespace eq 'ids') {
+	    $reply=&reply("idget:$udom:".$idlist,$tryserver);
+	} else {
+	    $reply=&reply("getdom:$udom:$namespace:$idlist",$tryserver);
+	}
 	my @answer=();
 	if (($reply ne 'con_lost') && ($reply!~/^error\:/)) {
 	    @answer=split(/\&/,$reply);
@@ -1569,10 +1585,10 @@ sub idget {
 	my $i;
 	for ($i=0;$i<=$#ids;$i++) {
 	    if ($answer[$i]) {
-		$returnhash{$ids[$i]}=$answer[$i];
-	    } 
+		$returnhash{$ids[$i]}=&unescape($answer[$i]);
+	    }
 	}
-    } 
+    }
     return %returnhash;
 }
 
@@ -1587,60 +1603,141 @@ sub idrget {
     return %returnhash;
 }
 
-# ------------------------------- Store away a list of names and associated IDs
+# Store away a list of names and associated student/employee IDs or clicker IDs
 
 sub idput {
-    my ($udom,%ids)=@_;
+    my ($udom,$idsref,$uhom,$namespace)=@_;
     my %servers=();
+    my %ids=();
+    my %byid = ();
+    if (ref($idsref) eq 'HASH') {
+        %ids=%{$idsref};
+    }
+    if ($namespace eq '') {
+        $namespace = 'ids'; 
+    }
     foreach my $uname (keys(%ids)) {
 	&cput('environment',{'id'=>$ids{$uname}},$udom,$uname);
-        my $uhom=&homeserver($uname,$udom);
+        if ($uhom eq '') {
+            $uhom=&homeserver($uname,$udom);
+        }
         if ($uhom ne 'no_host') {
-            my $id=&escape($ids{$uname});
-            $id=~tr/A-Z/a-z/;
             my $esc_unam=&escape($uname);
-	    if ($servers{$uhom}) {
-		$servers{$uhom}.='&'.$id.'='.$esc_unam;
+            if ($namespace eq 'ids') {
+                my $id=&escape($ids{$uname});
+                $id=~tr/A-Z/a-z/;
+                my $esc_unam=&escape($uname);
+                $servers{$uhom}.=$id.'='.$esc_unam.'&';
             } else {
-                $servers{$uhom}=$id.'='.$esc_unam;
+                my @currids = split(/,/,$ids{$uname});
+                foreach my $id (@currids) {
+                    $byid{$uhom}{$id} .= $uname.',';
+                }
+            }
+        }
+    }
+    if ($namespace eq 'clickers') {
+        foreach my $server (keys(%byid)) {
+            if (ref($byid{$server}) eq 'HASH') {
+                foreach my $id (keys(%{$byid{$server}})) {
+                    $byid{$server} =~ s/,$//;
+                    $servers{$uhom}.=&escape($id).'='.&escape($byid{$server}).'&'; 
+                }
             }
         }
     }
     foreach my $server (keys(%servers)) {
-        &critical('idput:'.$udom.':'.$servers{$server},$server);
+        $servers{$server} =~ s/\&$//;
+        if ($namespace eq 'ids') {     
+            &critical('idput:'.$udom.':'.$servers{$server},$server);
+        } else {
+            &critical('updateclickers:'.$udom.':add:'.$servers{$server},$server);
+        }
     }
 }
 
-# ---------------------------------------- Delete unwanted IDs from ids.db file 
+# ------------- Delete unwanted student/employee IDs or clicker IDs from domain
 
 sub iddel {
-    my ($udom,$idshashref,$uhome)=@_;
+    my ($udom,$idshashref,$uhome,$namespace)=@_;
     my %result=();
-    unless (ref($idshashref) eq 'HASH') {
+    my %ids=();
+    my %byid = ();
+    if (ref($idshashref) eq 'HASH') {
+        %ids=%{$idshashref};
+    } else {
         return %result;
     }
+    if ($namespace eq '') {
+        $namespace = 'ids';
+    }
     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}) {
+    while (my ($id,$unamestr) = each(%ids)) {
+        if ($namespace eq 'ids') {
+            my $uhom = $uhome;
+            if ($uhom eq '') { 
+                $uhom=&homeserver($unamestr,$udom);
+            }
+            if ($uhom ne 'no_host') {
                 $servers{$uhom}.='&'.&escape($id);
-            } else {
-                $servers{$uhom}=&escape($id);
+            }
+         } else {
+            my @curritems = split(/,/,$ids{$id});
+            foreach my $uname (@curritems) {
+                my $uhom = $uhome;
+                if ($uhom eq '') {
+                    $uhom=&homeserver($uname,$udom);
+                }
+                if ($uhom ne 'no_host') { 
+                    $byid{$uhom}{$id} .= $uname.',';
+                }
+            }
+        }
+    }
+    if ($namespace eq 'clickers') {
+        foreach my $server (keys(%byid)) {
+            if (ref($byid{$server}) eq 'HASH') {
+                foreach my $id (keys(%{$byid{$server}})) {
+                    $byid{$server}{$id} =~ s/,$//;
+                    $servers{$server}.=&escape($id).'='.&escape($byid{$server}{$id}).'&';
+                }
             }
         }
     }
     foreach my $server (keys(%servers)) {
-        $result{$server} = &critical('iddel:'.$udom.':'.$servers{$server},$uhome);
+        $servers{$server} =~ s/\&$//;
+        if ($namespace eq 'ids') {
+            $result{$server} = &critical('iddel:'.$udom.':'.$servers{$server},$uhome);
+        } elsif ($namespace eq 'clickers') {
+            $result{$server} = &critical('updateclickers:'.$udom.':del:'.$servers{$server},$server);
+        }
     }
     return %result;
 }
 
+# ----- Update clicker ID-to-username look-ups in clickers.db on library server 
+
+sub updateclickers {
+    my ($udom,$action,$idshashref,$uhome,$critical) = @_;
+    my %clickers;
+    if (ref($idshashref) eq 'HASH') {
+        %clickers=%{$idshashref};
+    } else {
+        return;
+    }
+    my $items='';
+    foreach my $item (keys(%clickers)) {
+        $items.=&escape($item).'='.&escape($clickers{$item}).'&';
+    }
+    $items=~s/\&$//;
+    my $request = "updateclickers:$udom:$action:$items";
+    if ($critical) {
+        return &critical($request,$uhome);
+    } else {
+        return &reply($request,$uhome);
+    }
+}
+
 # ------------------------------dump from db file owned by domainconfig user
 sub dump_dom {
     my ($namespace, $udom, $regexp) = @_;
@@ -2980,6 +3077,14 @@ sub can_edit_resource {
                         $forceedit = 1;
                     }
                     $cfile = $resurl;
+                } elsif ($resurl =~ m{^/adm/wrapper/adm/$cdom/$cnum/\d+/exttools?$}) {
+                    $incourse = 1;
+                    if ($env{'form.forceedit'}) {
+                        $forceview = 1;
+                    } else {
+                        $forceedit = 1;
+                    }
+                    $cfile = $resurl;
                 } elsif ($resurl =~ m{^/?adm/viewclasslist$}) {
                     $incourse = 1;
                     if ($env{'form.forceedit'}) {
@@ -3004,6 +3109,14 @@ sub can_edit_resource {
                         $forceedit = 1;
                     }
                     $cfile = $resurl;
+            } elsif (($resurl =~ m{^/adm/wrapper/adm/$cdom/$cnum/\d+/exttools?$}) && ($env{'form.folderpath'} =~ /^supplemental/)) {
+                $incourse = 1;
+                if ($env{'form.forceedit'}) {
+                    $forceview = 1;
+                } else {
+                    $forceedit = 1;
+                }
+                $cfile = $resurl;
             } elsif (($resurl eq '/adm/extresedit') && ($symb || $env{'form.folderpath'})) {
                 $incourse = 1;
                 $forceview = 1;
@@ -3013,8 +3126,13 @@ sub can_edit_resource {
                     $cfile = &clutter($res);
                 } else {
                     $cfile = $env{'form.suppurl'};
-                    $cfile =~ s{^http://}{};
-                    $cfile = '/adm/wrapper/ext/'.$cfile;
+                    my $escfile = &unescape($cfile);
+                    if ($escfile =~ m{^/adm/$cdom/$cnum/\d+/exttools?$}) {
+                        $cfile = '/adm/wrapper'.$escfile;
+                    } else {
+                        $escfile =~ s{^http://}{};
+                        $cfile = &escape("/adm/wrapper/ext/$escfile");
+                    }
                 }
             } elsif ($resurl =~ m{^/?adm/viewclasslist$}) {
                 if ($env{'form.forceedit'}) {
@@ -7213,7 +7331,7 @@ sub constructaccess {
     my ($ownername,$ownerdomain,$ownerhome);
 
     ($ownerdomain,$ownername) =
-        ($url=~ m{^(?:\Q$perlvar{'lonDocRoot'}\E|)/priv/($match_domain)/($match_username)/});
+        ($url=~ m{^(?:\Q$perlvar{'lonDocRoot'}\E|)(?:/daxepage|/daxeopen)?/priv/($match_domain)/($match_username)/});
 
 # The URL does not really point to any authorspace, forget it
     unless (($ownername) && ($ownerdomain)) { return ''; }
@@ -8792,7 +8910,7 @@ sub modifyuser {
                   'current user id "'.$uidhash{$uname}.'".';
           }
        } else {
-	  &idput($udom,($uname => $uid));
+	  &idput($udom,{$uname => $uid},$uhome,'ids');
        }
     }
 # -------------------------------------------------------------- Add names, etc
@@ -10194,6 +10312,13 @@ sub get_userresdata {
 #     $name      - Course/user name.
 #     $domain    - Name of the domain the user/course is registered on.
 #     $type      - Type of thing $name is (must be 'course' or 'user'
+#     $mapp      - decluttered URL of enclosing map  
+#     $recursed  - Ref to scalar -- set to 1, if nested maps have been recursed.
+#     $recurseup - Ref to array of map URLs, starting with map containing
+#                  $mapp up through hierarchy of nested maps to top level map.  
+#     $courseid  - CourseID (first part of param identifier).
+#     $modifier  - Middle part of param identifier.
+#     $what      - Last part of param identifier.
 #     @which     - Array of names of resources desired.
 #  Returns:
 #     The value of the first reasource in @which that is found in the
@@ -10203,7 +10328,8 @@ sub get_userresdata {
 #     'user', an undefined  reference is returned.
 #     If none of the resources are found, an undef is returned
 sub resdata {
-    my ($name,$domain,$type,@which)=@_;
+    my ($name,$domain,$type,$mapp,$recursed,$recurseup,$courseid,
+        $modifier,$what,@which)=@_;
     my $result;
     if ($type eq 'course') {
 	$result=&get_courseresdata($name,$domain);
@@ -10212,13 +10338,46 @@ sub resdata {
     }
     if (!ref($result)) { return $result; }    
     foreach my $item (@which) {
-	if (defined($result->{$item->[0]})) {
+        if ($item->[1] eq 'course') {
+            if ((ref($recurseup) eq 'ARRAY') && (ref($recursed) eq 'SCALAR')) {
+                unless ($$recursed) {
+                    @{$recurseup} = &get_map_hierarchy($mapp);
+                    $$recursed = 1;
+                }
+                foreach my $item (@${recurseup}) {
+                    my $norecursechk=$courseid.$modifier.$item.'___(all).'.$what;
+                    last if (defined($result->{$norecursechk}));
+                    my $recursechk=$courseid.$modifier.$item.'___(rec).'.$what;
+                    if (defined($result->{$recursechk})) { return [$result->{$recursechk},'map']; }
+                }
+            }
+        }
+        if (defined($result->{$item->[0]})) {
 	    return [$result->{$item->[0]},$item->[1]];
 	}
     }
     return undef;
 }
 
+sub get_domain_ltitools {
+    my ($cdom) = @_;
+    my %ltitools;
+    my ($result,$cached)=&is_cached_new('ltitools',$cdom);
+    if (defined($cached)) {
+        if (ref($result) eq 'HASH') {
+            %ltitools = %{$result};
+        }
+    } else {
+        my %domconfig = &get_dom('configuration',['ltitools'],$cdom);
+        if (ref($domconfig{'ltitools'}) eq 'HASH') {
+            %ltitools = %{$domconfig{'ltitools'}};
+        }
+        my $cachetime = 24*60*60;
+        &do_cache_new('ltitools',$cdom,\%ltitools,$cachetime);
+    }
+    return %ltitools;
+}
+
 sub get_numsuppfiles {
     my ($cnum,$cdom,$ignorecache)=@_;
     my $hashid=$cnum.':'.$cdom;
@@ -10420,8 +10579,8 @@ sub EXT {
             }
         }
 
-	my ($section, $group, @groups);
-	my ($courselevelm,$courselevel);
+	my ($section, $group, @groups, @recurseup, $recursed);
+	my ($courselevelm,$courseleveli,$courselevel,$mapp);
         if (($courseid eq '') && ($cid)) {
             $courseid = $cid;
         }
@@ -10432,11 +10591,11 @@ sub EXT {
 
 # ----------------------------------------------------- Cascading lookup scheme
 	    my $symbp=$symbparm;
-	    my $mapp=&deversion((&decode_symb($symbp))[0]);
-
+	    $mapp=&deversion((&decode_symb($symbp))[0]);
+            @recurseup=();
 	    my $symbparm=$symbp.'.'.$spacequalifierrest;
+            my $recurseparm=$mapp.'___(rec).'.$spacequalifierrest;
 	    my $mapparm=$mapp.'___(all).'.$spacequalifierrest;
-
 	    if (($env{'user.name'} eq $uname) &&
 		($env{'user.domain'} eq $udom)) {
 		$section=$env{'request.course.sec'};
@@ -10453,17 +10612,21 @@ sub EXT {
 
 	    my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest;
 	    my $seclevelr=$courseid.'.['.$section.'].'.$symbparm;
+            my $secleveli=$courseid.'.['.$section.'].'.$recurseparm;
 	    my $seclevelm=$courseid.'.['.$section.'].'.$mapparm;
 
 	    $courselevel=$courseid.'.'.$spacequalifierrest;
 	    my $courselevelr=$courseid.'.'.$symbparm;
+            $courseleveli=$courseid.'.'.$recurseparm;
 	    $courselevelm=$courseid.'.'.$mapparm;
 
 # ----------------------------------------------------------- first, check user
 
-	    my $userreply=&resdata($uname,$udom,'user',
+	    my $userreply=&resdata($uname,$udom,'user',$mapp,\$recursed,
+                                   \@recurseup,$courseid,'.',$spacequalifierrest, 
 				       ([$courselevelr,'resource'],
 					[$courselevelm,'map'     ],
+                                        [$courseleveli,'map'     ],
 					[$courselevel, 'course'  ]));
 	    if (defined($userreply)) { return &get_reply($userreply); }
 
@@ -10471,15 +10634,18 @@ sub EXT {
             my $coursereply;
             if (@groups > 0) {
                 $coursereply = &check_group_parms($courseid,\@groups,$symbparm,
-                                       $mapparm,$spacequalifierrest);
-                if (defined($coursereply)) { return &get_reply($coursereply); }
+                                       $recurseparm,$mapparm,$spacequalifierrest,
+                                       $mapp,\$recursed,\@recurseup);
+                if (defined($coursereply)) { return &get_reply($coursereply); } 
             }
 
 	    $coursereply=&resdata($env{'course.'.$courseid.'.num'},
 				  $env{'course.'.$courseid.'.domain'},
-				  'course',
+				  'course',$mapp,\$recursed,\@recurseup,
+                                  $courseid,'.['.$section.'].',$spacequalifierrest,
 				  ([$seclevelr,   'resource'],
 				   [$seclevelm,   'map'     ],
+                                   [$secleveli,   'map'     ],
 				   [$seclevel,    'course'  ],
 				   [$courselevelr,'resource']));
 	    if (defined($coursereply)) { return &get_reply($coursereply); }
@@ -10496,8 +10662,9 @@ sub EXT {
 	    if ($thisparm) { return &get_reply([$thisparm,'resource']); }
 	}
 # ------------------------------------------ fourth, look in resource metadata
-
-	$spacequalifierrest=~s/\./\_/;
+ 
+        my $what = $spacequalifierrest;
+	$what=~s/\./\_/;
 	my $filename;
 	if (!$symbparm) { $symbparm=&symbread(); }
 	if ($symbparm) {
@@ -10505,18 +10672,20 @@ sub EXT {
 	} else {
 	    $filename=$env{'request.filename'};
 	}
-	my $metadata=&metadata($filename,$spacequalifierrest);
+	my $metadata=&metadata($filename,$what);
 	if (defined($metadata)) { return &get_reply([$metadata,'resource']); }
-	$metadata=&metadata($filename,'parameter_'.$spacequalifierrest);
+	$metadata=&metadata($filename,'parameter_'.$what);
 	if (defined($metadata)) { return &get_reply([$metadata,'resource']); }
 
-# ---------------------------------------------- fourth, look in rest of course
+# ----------------------------------------------- fifth, look in rest of course
 	if ($symbparm && defined($courseid) && 
 	    $courseid eq $env{'request.course.id'}) {
 	    my $coursereply=&resdata($env{'course.'.$courseid.'.num'},
 				     $env{'course.'.$courseid.'.domain'},
-				     'course',
+				     'course',$mapp,\$recursed,\@recurseup,
+                                     $courseid,'.',$spacequalifierrest,
 				     ([$courselevelm,'map'   ],
+                                      [$courseleveli,'map'   ],
 				      [$courselevel, 'course']));
 	    if (defined($coursereply)) { return &get_reply($coursereply); }
 	}
@@ -10573,22 +10742,40 @@ sub get_reply {
 }
 
 sub check_group_parms {
-    my ($courseid,$groups,$symbparm,$mapparm,$what) = @_;
-    my @groupitems = ();
-    my $resultitem;
-    my @levels = ([$symbparm,'resource'],[$mapparm,'map'],[$what,'course']);
+    my ($courseid,$groups,$symbparm,$recurseparm,$mapparm,$what,$mapp,
+        $recursed,$recurseupref) = @_;
+    my @levels = ([$symbparm,'resource'],[$mapparm,'map'],[$recurseparm,'map'],
+                  [$what,'course']);
+    my $coursereply;
     foreach my $group (@{$groups}) {
+        my @groupitems = ();
         foreach my $level (@levels) {
              my $item = $courseid.'.['.$group.'].'.$level->[0];
              push(@groupitems,[$item,$level->[1]]);
         }
+        my $coursereply = &resdata($env{'course.'.$courseid.'.num'},
+                                   $env{'course.'.$courseid.'.domain'},
+                                   'course',$mapp,$recursed,$recurseupref,
+                                   $courseid,'.['.$group.'].',$what,
+                                   @groupitems);
+        last if (defined($coursereply));
     }
-    my $coursereply = &resdata($env{'course.'.$courseid.'.num'},
-                            $env{'course.'.$courseid.'.domain'},
-                                     'course',@groupitems);
     return $coursereply;
 }
 
+sub get_map_hierarchy {
+    my ($mapname) = @_;
+    my @recurseup = (); 
+    if ($mapname) {
+        my $navmap = Apache::lonnavmaps::navmap->new();
+        if (ref($navmap)) {
+            @recurseup = $navmap->recurseup_maps($mapname);
+            undef($navmap);
+        }
+    }
+    return @recurseup;
+}
+
 sub sort_course_groups { # Sort groups based on defined rankings. Default is sort().
     my ($courseid,@groups) = @_;
     @groups = sort(@groups);
@@ -10673,7 +10860,7 @@ sub metadata {
     # if it is a non metadata possible uri return quickly
     if (($uri eq '') || 
 	(($uri =~ m|^/*adm/|) && 
-	     ($uri !~ m|^adm/includes|) && ($uri !~ m{/(smppg|bulletinboard)$})) ||
+	     ($uri !~ m|^adm/includes|) && ($uri !~ m{/(smppg|bulletinboard|exttools?)$})) ||
         ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ m{^/*uploaded/.+\.sequence$})) {
 	return undef;
     }
@@ -12206,6 +12393,8 @@ sub clutter {
 #		&logthis("Got a blank emb style");
 	    }
 	}
+    } elsif ($thisfn =~ m{^/adm/$match_domain/$match_courseid/\d+/exttools?$}) {
+        $thisfn='/adm/wrapper'.$thisfn;
     }
     return $thisfn;
 }
@@ -13148,10 +13337,12 @@ the answer, and also caches if there is
 
 =item *
 X<idget()>
-B<idget($udom,@ids)>: find the usernames behind a list of IDs
-(IDs are a unique resource in a domain, there must be only 1 ID per
-username, and only 1 username per ID in a specific domain) (returns
-hash: id=>name,id=>name)
+B<idget($udom,$idsref,$namespace)>: find the usernames behind either 
+a list of student/employee IDs or clicker IDs
+(student/employee IDs are a unique resource in a domain, there must be 
+only 1 ID per username, and only 1 username per ID in a specific domain).
+clickerIDs are not necessarily unique, as students might share clickers.
+(returns hash: id=>name,id=>name)
 
 =item *
 X<idrget()>
@@ -13160,7 +13351,27 @@ usernames (returns hash: name=>id,name=>
 
 =item *
 X<idput()>
-B<idput($udom,%ids)>: store away a list of names and associated IDs
+B<idput($udom,$idsref,$uhome,$namespace)>: store away a list of 
+names and associated student/employee IDs or clicker IDs.
+
+=item *
+X<iddel()>
+B<iddel($udom,$idshashref,$uhome,$namespace)>: delete unwanted 
+student/employee ID or clicker ID username look-ups from domain.
+The homeserver ($uhome) and namespace ($namespace) are optional.
+If no $uhome is provided, it will be determined usig &homeserver()
+for each user.  If no $namespace is provided, the default is ids.
+
+=item *
+X<updateclickers()>
+B<updateclickers($udom,$action,$idshashref,$uhome,$critical)>: update 
+clicker ID-to-username look-ups in clickers.db on library server.
+Permitted actions are add or del (i.e., add or delete). The 
+clickers.db contains clickerID as keys (escaped), and each corresponding
+value is an escaped comma-separated list of usernames (for whom the
+library server is the homeserver), who registered that particular ID.
+If $critical is true, the update will be sent via &critical, otherwise
+&reply() will be used.
 
 =item *
 X<rolesinit()>