[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.1299 and 1.1305

version 1.1299, 2016/01/31 16:40:22 version 1.1305, 2016/04/02 04:31:03
Line 1551  sub homeserver { Line 1551  sub homeserver {
     return 'no_host';      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 {  sub idget {
     my ($udom,@ids)=@_;      my ($udom,$idsref,$namespace)=@_;
     my %returnhash=();      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');      my %servers = &get_servers($udom,'library');
     foreach my $tryserver (keys(%servers)) {      foreach my $tryserver (keys(%servers)) {
  my $idlist=join('&', map { &escape($_); } @ids);   my $idlist=join('&', map { &escape($_); } @ids);
  $idlist=~tr/A-Z/a-z/;    if ($namespace eq 'ids') {
  my $reply=&reply("idget:$udom:".$idlist,$tryserver);      $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=();   my @answer=();
  if (($reply ne 'con_lost') && ($reply!~/^error\:/)) {   if (($reply ne 'con_lost') && ($reply!~/^error\:/)) {
     @answer=split(/\&/,$reply);      @answer=split(/\&/,$reply);
Line 1570  sub idget { Line 1586  sub idget {
  for ($i=0;$i<=$#ids;$i++) {   for ($i=0;$i<=$#ids;$i++) {
     if ($answer[$i]) {      if ($answer[$i]) {
  $returnhash{$ids[$i]}=&unescape($answer[$i]);   $returnhash{$ids[$i]}=&unescape($answer[$i]);
     }       }
  }   }
     }       }
     return %returnhash;      return %returnhash;
 }  }
   
Line 1587  sub idrget { Line 1603  sub idrget {
     return %returnhash;      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 {  sub idput {
     my ($udom,%ids)=@_;      my ($udom,$idsref,$uhom,$namespace)=@_;
     my %servers=();      my %servers=();
       my %ids=();
       my %byid = ();
       if (ref($idsref) eq 'HASH') {
           %ids=%{$idsref};
       }
       if ($namespace eq '') {
           $namespace = 'ids'; 
       }
     foreach my $uname (keys(%ids)) {      foreach my $uname (keys(%ids)) {
  &cput('environment',{'id'=>$ids{$uname}},$udom,$uname);   &cput('environment',{'id'=>$ids{$uname}},$udom,$uname);
         my $uhom=&homeserver($uname,$udom);          if ($uhom eq '') {
               $uhom=&homeserver($uname,$udom);
           }
         if ($uhom ne 'no_host') {          if ($uhom ne 'no_host') {
             my $id=&escape($ids{$uname});  
             $id=~tr/A-Z/a-z/;  
             my $esc_unam=&escape($uname);              my $esc_unam=&escape($uname);
     if ($servers{$uhom}) {              if ($namespace eq 'ids') {
  $servers{$uhom}.='&'.$id.'='.$esc_unam;                  my $id=&escape($ids{$uname});
                   $id=~tr/A-Z/a-z/;
                   my $esc_unam=&escape($uname);
                   $servers{$uhom}.=$id.'='.$esc_unam.'&';
             } else {              } 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)) {      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 {  sub iddel {
     my ($udom,$idshashref,$uhome)=@_;      my ($udom,$idshashref,$uhome,$namespace)=@_;
     my %result=();      my %result=();
     unless (ref($idshashref) eq 'HASH') {      my %ids=();
       my %byid = ();
       if (ref($idshashref) eq 'HASH') {
           %ids=%{$idshashref};
       } else {
         return %result;          return %result;
     }      }
       if ($namespace eq '') {
           $namespace = 'ids';
       }
     my %servers=();      my %servers=();
     while (my ($id,$uname) = each(%{$idshashref})) {      while (my ($id,$unamestr) = each(%ids)) {
         my $uhom;          if ($namespace eq 'ids') {
         if ($uhome) {              my $uhom = $uhome;
             $uhom = $uhome;              if ($uhom eq '') { 
         } else {                  $uhom=&homeserver($unamestr,$udom);
             $uhom=&homeserver($uname,$udom);              }
         }              if ($uhom ne 'no_host') {
         if ($uhom ne 'no_host') {  
             if ($servers{$uhom}) {  
                 $servers{$uhom}.='&'.&escape($id);                  $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)) {      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;      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  # ------------------------------dump from db file owned by domainconfig user
 sub dump_dom {  sub dump_dom {
     my ($namespace, $udom, $regexp) = @_;      my ($namespace, $udom, $regexp) = @_;
Line 2093  sub get_domain_defaults { Line 2190  sub get_domain_defaults {
                                   'coursedefaults','usersessions',                                    'coursedefaults','usersessions',
                                   'requestauthor','selfenrollment',                                    'requestauthor','selfenrollment',
                                   'coursecategories'],$domain);                                    'coursecategories'],$domain);
     my @coursetypes = ('official','unofficial','community','textbook');      my @coursetypes = ('official','unofficial','community','textbook','placement');
     if (ref($domconfig{'defaults'}) eq 'HASH') {      if (ref($domconfig{'defaults'}) eq 'HASH') {
         $domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'};           $domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'}; 
         $domdefaults{'auth_def'} = $domconfig{'defaults'}{'auth_def'};          $domdefaults{'auth_def'} = $domconfig{'defaults'}{'auth_def'};
Line 2123  sub get_domain_defaults { Line 2220  sub get_domain_defaults {
         }          }
     }      }
     if (ref($domconfig{'requestcourses'}) eq 'HASH') {      if (ref($domconfig{'requestcourses'}) eq 'HASH') {
         foreach my $item ('official','unofficial','community','textbook') {          foreach my $item ('official','unofficial','community','textbook','placement') {
             $domdefaults{$item} = $domconfig{'requestcourses'}{$item};              $domdefaults{$item} = $domconfig{'requestcourses'}{$item};
         }          }
     }      }
Line 6433  sub usertools_access { Line 6530  sub usertools_access {
                       unofficial => 1,                        unofficial => 1,
                       community  => 1,                        community  => 1,
                       textbook   => 1,                        textbook   => 1,
                         placement  => 1,
                  );                   );
     } elsif ($context eq 'requestauthor') {      } elsif ($context eq 'requestauthor') {
         %tools = (          %tools = (
Line 7166  sub allowed { Line 7264  sub allowed {
        my $unamedom=$env{'user.name'}.':'.$env{'user.domain'};         my $unamedom=$env{'user.name'}.':'.$env{'user.domain'};
        if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.roles.denied'}         if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.roles.denied'}
    =~/\Q$rolecode\E/) {     =~/\Q$rolecode\E/) {
    if (($priv ne 'pch') && ($priv ne 'plc')) {      if (($priv ne 'pch') && ($priv ne 'plc') && ($priv ne 'pac')) {
        &logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'.         &logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'.
  'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode.' in '.   'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode.' in '.
  $env{'request.course.id'});   $env{'request.course.id'});
Line 7176  sub allowed { Line 7274  sub allowed {
   
        if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.users.denied'}         if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.users.denied'}
    =~/\Q$unamedom\E/) {     =~/\Q$unamedom\E/) {
    if (($priv ne 'pch') && ($priv ne 'plc')) {      if (($priv ne 'pch') && ($priv ne 'plc') && ($priv ne 'pac')) {
        &logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.         &logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.
  'Denied by user: '.$priv.' for '.$uri.' as '.$unamedom.' in '.   'Denied by user: '.$priv.' for '.$uri.' as '.$unamedom.' in '.
  $env{'request.course.id'});   $env{'request.course.id'});
Line 8180  sub auto_crsreq_update { Line 8278  sub auto_crsreq_update {
     return \%crsreqresponse;      return \%crsreqresponse;
 }  }
   
   sub auto_export_grades {
       my ($cnum,$cdom,$gradesref) = @_;
       return;
   }
   
 sub check_instcode_cloning {  sub check_instcode_cloning {
     my ($codedefaults,$code_order,$cloner,$clonefromcode,$clonetocode) = @_;      my ($codedefaults,$code_order,$cloner,$clonefromcode,$clonetocode) = @_;
     unless ((ref($codedefaults) eq 'HASH') && (ref($code_order) eq 'ARRAY')) {      unless ((ref($codedefaults) eq 'HASH') && (ref($code_order) eq 'ARRAY')) {
Line 8401  sub plaintext { Line 8504  sub plaintext {
     my %rolenames = (      my %rolenames = (
                       Course    => 'std',                        Course    => 'std',
                       Community => 'alt1',                        Community => 'alt1',
                         Placement => 'std',
                     );                      );
     if ($cid ne '') {      if ($cid ne '') {
         if ($env{'course.'.$cid.'.'.$short.'.plaintext'} ne '') {          if ($env{'course.'.$cid.'.'.$short.'.plaintext'} ne '') {
Line 8813  sub modifyuser { Line 8917  sub modifyuser {
                   'current user id "'.$uidhash{$uname}.'".';                    'current user id "'.$uidhash{$uname}.'".';
           }            }
        } else {         } else {
   &idput($udom,($uname => $uid));    &idput($udom,{$uname => $uid},$uhome,'ids');
        }         }
     }      }
 # -------------------------------------------------------------- Add names, etc  # -------------------------------------------------------------- Add names, etc
Line 10215  sub get_userresdata { Line 10319  sub get_userresdata {
 #     $name      - Course/user name.  #     $name      - Course/user name.
 #     $domain    - Name of the domain the user/course is registered on.  #     $domain    - Name of the domain the user/course is registered on.
 #     $type      - Type of thing $name is (must be 'course' or 'user'  #     $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.  #     @which     - Array of names of resources desired.
 #  Returns:  #  Returns:
 #     The value of the first reasource in @which that is found in the  #     The value of the first reasource in @which that is found in the
Line 10224  sub get_userresdata { Line 10335  sub get_userresdata {
 #     'user', an undefined  reference is returned.  #     'user', an undefined  reference is returned.
 #     If none of the resources are found, an undef is returned  #     If none of the resources are found, an undef is returned
 sub resdata {  sub resdata {
     my ($name,$domain,$type,@which)=@_;      my ($name,$domain,$type,$mapp,$recursed,$recurseup,$courseid,
           $modifier,$what,@which)=@_;
     my $result;      my $result;
     if ($type eq 'course') {      if ($type eq 'course') {
  $result=&get_courseresdata($name,$domain);   $result=&get_courseresdata($name,$domain);
Line 10233  sub resdata { Line 10345  sub resdata {
     }      }
     if (!ref($result)) { return $result; }          if (!ref($result)) { return $result; }    
     foreach my $item (@which) {      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,$courseid);
                       $$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 [$result->{$item->[0]},$item->[1]];
  }   }
     }      }
Line 10283  sub get_numsuppfiles { Line 10409  sub get_numsuppfiles {
 # EXT resource caching routines  # EXT resource caching routines
 #  #
   
   {
   # Cache (5 seconds) of map hierarchy for speedup of navmaps display
   #
   # The course for which we cache
   my $cachedmapkey='';
   # The cached recursive maps for this course
   my %cachedmaps=();
   # When this was last done
   my $cachedmaptime='';
   
 sub clear_EXT_cache_status {  sub clear_EXT_cache_status {
     &delenv('cache.EXT.');      &delenv('cache.EXT.');
 }  }
Line 10460  sub EXT { Line 10596  sub EXT {
             }              }
         }          }
   
  my ($section, $group, @groups);   my ($section, $group, @groups, @recurseup, $recursed);
  my ($courselevelm,$courselevel);   my ($courselevelm,$courseleveli,$courselevel,$mapp);
         if (($courseid eq '') && ($cid)) {          if (($courseid eq '') && ($cid)) {
             $courseid = $cid;              $courseid = $cid;
         }          }
Line 10472  sub EXT { Line 10608  sub EXT {
   
 # ----------------------------------------------------- Cascading lookup scheme  # ----------------------------------------------------- Cascading lookup scheme
     my $symbp=$symbparm;      my $symbp=$symbparm;
     my $mapp=&deversion((&decode_symb($symbp))[0]);      $mapp=&deversion((&decode_symb($symbp))[0]);
   
     my $symbparm=$symbp.'.'.$spacequalifierrest;      my $symbparm=$symbp.'.'.$spacequalifierrest;
               my $recurseparm=$mapp.'___(rec).'.$spacequalifierrest;
     my $mapparm=$mapp.'___(all).'.$spacequalifierrest;      my $mapparm=$mapp.'___(all).'.$spacequalifierrest;
   
     if (($env{'user.name'} eq $uname) &&      if (($env{'user.name'} eq $uname) &&
  ($env{'user.domain'} eq $udom)) {   ($env{'user.domain'} eq $udom)) {
  $section=$env{'request.course.sec'};   $section=$env{'request.course.sec'};
Line 10493  sub EXT { Line 10628  sub EXT {
   
     my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest;      my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest;
     my $seclevelr=$courseid.'.['.$section.'].'.$symbparm;      my $seclevelr=$courseid.'.['.$section.'].'.$symbparm;
               my $secleveli=$courseid.'.['.$section.'].'.$recurseparm;
     my $seclevelm=$courseid.'.['.$section.'].'.$mapparm;      my $seclevelm=$courseid.'.['.$section.'].'.$mapparm;
   
     $courselevel=$courseid.'.'.$spacequalifierrest;      $courselevel=$courseid.'.'.$spacequalifierrest;
     my $courselevelr=$courseid.'.'.$symbparm;      my $courselevelr=$courseid.'.'.$symbparm;
               $courseleveli=$courseid.'.'.$recurseparm;
     $courselevelm=$courseid.'.'.$mapparm;      $courselevelm=$courseid.'.'.$mapparm;
   
 # ----------------------------------------------------------- first, check user  # ----------------------------------------------------------- first, check user
   
     my $userreply=&resdata($uname,$udom,'user',      my $userreply=&resdata($uname,$udom,'user',$mapp,\$recursed,
                                      \@recurseup,$courseid,'.',$spacequalifierrest, 
        ([$courselevelr,'resource'],         ([$courselevelr,'resource'],
  [$courselevelm,'map'     ],   [$courselevelm,'map'     ],
                                           [$courseleveli,'map'     ],
  [$courselevel, 'course'  ]));   [$courselevel, 'course'  ]));
     if (defined($userreply)) { return &get_reply($userreply); }      if (defined($userreply)) { return &get_reply($userreply); }
   
Line 10511  sub EXT { Line 10650  sub EXT {
             my $coursereply;              my $coursereply;
             if (@groups > 0) {              if (@groups > 0) {
                 $coursereply = &check_group_parms($courseid,\@groups,$symbparm,                  $coursereply = &check_group_parms($courseid,\@groups,$symbparm,
                                        $mapparm,$spacequalifierrest);                                         $recurseparm,$mapparm,$spacequalifierrest,
                 if (defined($coursereply)) { return &get_reply($coursereply); }                                         $mapp,\$recursed,\@recurseup);
                   if (defined($coursereply)) { return &get_reply($coursereply); } 
             }              }
   
     $coursereply=&resdata($env{'course.'.$courseid.'.num'},      $coursereply=&resdata($env{'course.'.$courseid.'.num'},
   $env{'course.'.$courseid.'.domain'},    $env{'course.'.$courseid.'.domain'},
   'course',    'course',$mapp,\$recursed,\@recurseup,
                                     $courseid,'.['.$section.'].',$spacequalifierrest,
   ([$seclevelr,   'resource'],    ([$seclevelr,   'resource'],
    [$seclevelm,   'map'     ],     [$seclevelm,   'map'     ],
                                      [$secleveli,   'map'     ],
    [$seclevel,    'course'  ],     [$seclevel,    'course'  ],
    [$courselevelr,'resource']));     [$courselevelr,'resource']));
     if (defined($coursereply)) { return &get_reply($coursereply); }      if (defined($coursereply)) { return &get_reply($coursereply); }
Line 10536  sub EXT { Line 10678  sub EXT {
     if ($thisparm) { return &get_reply([$thisparm,'resource']); }      if ($thisparm) { return &get_reply([$thisparm,'resource']); }
  }   }
 # ------------------------------------------ fourth, look in resource metadata  # ------------------------------------------ fourth, look in resource metadata
    
  $spacequalifierrest=~s/\./\_/;          my $what = $spacequalifierrest;
    $what=~s/\./\_/;
  my $filename;   my $filename;
  if (!$symbparm) { $symbparm=&symbread(); }   if (!$symbparm) { $symbparm=&symbread(); }
  if ($symbparm) {   if ($symbparm) {
Line 10545  sub EXT { Line 10688  sub EXT {
  } else {   } else {
     $filename=$env{'request.filename'};      $filename=$env{'request.filename'};
  }   }
  my $metadata=&metadata($filename,$spacequalifierrest);   my $metadata=&metadata($filename,$what);
  if (defined($metadata)) { return &get_reply([$metadata,'resource']); }   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']); }   if (defined($metadata)) { return &get_reply([$metadata,'resource']); }
   
 # ---------------------------------------------- fourth, look in rest of course  # ----------------------------------------------- fifth, look in rest of course
  if ($symbparm && defined($courseid) &&    if ($symbparm && defined($courseid) && 
     $courseid eq $env{'request.course.id'}) {      $courseid eq $env{'request.course.id'}) {
     my $coursereply=&resdata($env{'course.'.$courseid.'.num'},      my $coursereply=&resdata($env{'course.'.$courseid.'.num'},
      $env{'course.'.$courseid.'.domain'},       $env{'course.'.$courseid.'.domain'},
      'course',       'course',$mapp,\$recursed,\@recurseup,
                                        $courseid,'.',$spacequalifierrest,
      ([$courselevelm,'map'   ],       ([$courselevelm,'map'   ],
                                         [$courseleveli,'map'   ],
       [$courselevel, 'course']));        [$courselevel, 'course']));
     if (defined($coursereply)) { return &get_reply($coursereply); }      if (defined($coursereply)) { return &get_reply($coursereply); }
  }   }
Line 10613  sub get_reply { Line 10758  sub get_reply {
 }  }
   
 sub check_group_parms {  sub check_group_parms {
     my ($courseid,$groups,$symbparm,$mapparm,$what) = @_;      my ($courseid,$groups,$symbparm,$recurseparm,$mapparm,$what,$mapp,
     my @groupitems = ();          $recursed,$recurseupref) = @_;
     my $resultitem;      my @levels = ([$symbparm,'resource'],[$mapparm,'map'],[$recurseparm,'map'],
     my @levels = ([$symbparm,'resource'],[$mapparm,'map'],[$what,'course']);                    [$what,'course']);
       my $coursereply;
     foreach my $group (@{$groups}) {      foreach my $group (@{$groups}) {
           my @groupitems = ();
         foreach my $level (@levels) {          foreach my $level (@levels) {
              my $item = $courseid.'.['.$group.'].'.$level->[0];               my $item = $courseid.'.['.$group.'].'.$level->[0];
              push(@groupitems,[$item,$level->[1]]);               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;      return $coursereply;
 }  }
   
   sub get_map_hierarchy {
       my ($mapname,$courseid) = @_;
       my @recurseup = ();
       if ($mapname) {
           if (($cachedmapkey eq $courseid) &&
               (abs($cachedmaptime-time)<5)) {
               if (ref($cachedmaps{$mapname}) eq 'ARRAY') {
                   return @{$cachedmaps{$mapname}};
               }
           }
           my $navmap = Apache::lonnavmaps::navmap->new();
           if (ref($navmap)) {
               @recurseup = $navmap->recurseup_maps($mapname);
               undef($navmap);
               $cachedmaps{$mapname} = \@recurseup;
               $cachedmaptime=time;
               $cachedmapkey=$courseid;
           }
       }
       return @recurseup;
   }
   
   }
   
 sub sort_course_groups { # Sort groups based on defined rankings. Default is sort().  sub sort_course_groups { # Sort groups based on defined rankings. Default is sort().
     my ($courseid,@groups) = @_;      my ($courseid,@groups) = @_;
     @groups = sort(@groups);      @groups = sort(@groups);
Line 12917  BEGIN { Line 13091  BEGIN {
                 my $name = $token->[2]{'name'};                  my $name = $token->[2]{'name'};
                 my $value = $token->[2]{'value'};                  my $value = $token->[2]{'value'};
                 my $valuematch = $token->[2]{'valuematch'};                  my $valuematch = $token->[2]{'valuematch'};
                 if ($item ne '' && $name ne '' && ($value ne '' || $valuematch ne '')) {                  my $namematch = $token->[2]{'namematch'};
                   if ($item eq 'parameter') {
                       if (($namematch ne '') || (($name ne '') && ($value ne '' || $valuematch ne ''))) {
                           my $release = $parser->get_text();
                           $release =~ s/(^\s*|\s*$ )//gx;
                           $needsrelease{$item.':'.$name.':'.$value.':'.$valuematch.':'.$namematch} = $release;
                       }
                   } elsif ($item ne '' && $name ne '') {
                     my $release = $parser->get_text();                      my $release = $parser->get_text();
                     $release =~ s/(^\s*|\s*$ )//gx;                      $release =~ s/(^\s*|\s*$ )//gx;
                     $needsrelease{$item.':'.$name.':'.$value.':'.$valuematch} = $release;                      $needsrelease{$item.':'.$name.':'.$value} = $release;
                 }                  }
             }              }
         }          }
Line 13190  the answer, and also caches if there is Line 13371  the answer, and also caches if there is
   
 =item *  =item *
 X<idget()>  X<idget()>
 B<idget($udom,@ids)>: find the usernames behind a list of IDs  B<idget($udom,$idsref,$namespace)>: find the usernames behind either 
 (IDs are a unique resource in a domain, there must be only 1 ID per  a list of student/employee IDs or clicker IDs
 username, and only 1 username per ID in a specific domain) (returns  (student/employee IDs are a unique resource in a domain, there must be 
 hash: id=>name,id=>name)  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 *  =item *
 X<idrget()>  X<idrget()>
Line 13202  usernames (returns hash: name=>id,name=> Line 13385  usernames (returns hash: name=>id,name=>
   
 =item *  =item *
 X<idput()>  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 *  =item *
 X<rolesinit()>  X<rolesinit()>
Line 13958  requestcourses: ability to request cours Line 14161  requestcourses: ability to request cours
 =over  =over
   
 =item  =item
 official, unofficial, community, textbook  official, unofficial, community, textbook, placement
   
 =back  =back
   
Line 13980  for course's uploaded content. Line 14183  for course's uploaded content.
   
 =item  =item
 canuse_pdfforms, officialcredits, unofficialcredits, textbookcredits, officialquota, unofficialquota,   canuse_pdfforms, officialcredits, unofficialcredits, textbookcredits, officialquota, unofficialquota, 
 communityquota, textbookquota  communityquota, textbookquota, placementquota
   
 =back  =back
   
Removed from v.1.1299  
changed lines
  Added in v.1.1305

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