Diff for /loncom/Lond.pm between versions 1.4 and 1.8.2.2

version 1.4, 2012/07/17 14:49:39 version 1.8.2.2, 2021/02/10 15:08:14
Line 333  sub dump_course_id_handler { Line 333  sub dump_course_id_handler {
     my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter,      my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter,
         $typefilter,$regexp_ok,$rtn_as_hash,$selfenrollonly,$catfilter,$showhidden,          $typefilter,$regexp_ok,$rtn_as_hash,$selfenrollonly,$catfilter,$showhidden,
         $caller,$cloner,$cc_clone_list,$cloneonly,$createdbefore,$createdafter,          $caller,$cloner,$cc_clone_list,$cloneonly,$createdbefore,$createdafter,
         $creationcontext,$domcloner) = split(/:/,$tail);          $creationcontext,$domcloner,$hasuniquecode,$reqcrsdom,$reqinstcode) = split(/:/,$tail);
     my $now = time;      my $now = time;
     my ($cloneruname,$clonerudom,%cc_clone);      my ($cloneruname,$clonerudom,%cc_clone);
     if (defined($description)) {      if (defined($description)) {
Line 406  sub dump_course_id_handler { Line 406  sub dump_course_id_handler {
     } else {      } else {
         $creationcontext = '.';          $creationcontext = '.';
     }      }
       unless ($hasuniquecode) {
           $hasuniquecode = '.';
       }
       if ($reqinstcode ne '') {
           $reqinstcode = &unescape($reqinstcode);
       }
     my $unpack = 1;      my $unpack = 1;
     if ($description eq '.' && $instcodefilter eq '.' && $ownerfilter eq '.' &&       if ($description eq '.' && $instcodefilter eq '.' && $ownerfilter eq '.' && 
         $typefilter eq '.') {          $typefilter eq '.') {
         $unpack = 0;          $unpack = 0;
     }      }
     if (!defined($since)) { $since=0; }      if (!defined($since)) { $since=0; }
       my (%gotcodedefaults,%otcodedefaults);
     my $qresult='';      my $qresult='';
   
     my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT())      my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT())
Line 431  sub dump_course_id_handler { Line 438  sub dump_course_id_handler {
                 $lasttime = $hashref->{$lasttime_key};                  $lasttime = $hashref->{$lasttime_key};
                 next if ($lasttime<$since);                  next if ($lasttime<$since);
             }              }
             my ($canclone,$valchange);              my ($canclone,$valchange,$clonefromcode);
             my $items = &Apache::lonnet::thaw_unescape($value);              my $items = &Apache::lonnet::thaw_unescape($value);
             if (ref($items) eq 'HASH') {              if (ref($items) eq 'HASH') {
                 if ($hashref->{$lasttime_key} eq '') {                  if ($hashref->{$lasttime_key} eq '') {
                     next if ($since > 1);                      next if ($since > 1);
                 }                  }
                   if ($items->{'inst_code'}) {
                       $clonefromcode = $items->{'inst_code'};
                   }
                 $is_hash =  1;                  $is_hash =  1;
                 if ($domcloner) {                  if ($domcloner) {
                     $canclone = 1;                      $canclone = 1;
Line 462  sub dump_course_id_handler { Line 472  sub dump_course_id_handler {
                                 }                                  }
                             }                              }
                         }                          }
                           unless ($canclone) {
                               if (($reqcrsdom eq $udom) && ($reqinstcode) && ($clonefromcode)) {
                                   if (grep(/\=/,@cloneable))  {
                                       foreach my $cloner (@cloneable) {
                                           if (($cloner ne '*') && ($cloner !~ /^\*\:$LONCAPA::match_domain$/) &&
                                               ($cloner !~ /^$LONCAPA::match_username\:$LONCAPA::match_domain$/) && ($cloner ne '')) {
                                               if ($cloner =~ /=/) {
                                                   my (%codedefaults,@code_order);
                                                   if (ref($gotcodedefaults{$udom}) eq 'HASH') {
                                                       if (ref($gotcodedefaults{$udom}{'defaults'}) eq 'HASH') {
                                                           %codedefaults = %{$gotcodedefaults{$udom}{'defaults'}};
                                                       }
                                                       if (ref($gotcodedefaults{$udom}{'order'}) eq 'ARRAY') {
                                                           @code_order = @{$gotcodedefaults{$udom}{'order'}};
                                                       }
                                                   } else {
                                                       &Apache::lonnet::auto_instcode_defaults($udom,
                                                                                               \%codedefaults,
                                                                                               \@code_order);
                                                       $gotcodedefaults{$udom}{'defaults'} = \%codedefaults;
                                                       $gotcodedefaults{$udom}{'order'} = \@code_order;
                                                   }
                                                   if (@code_order > 0) {
                                                       if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
                                                                                                   $cloner,$clonefromcode,$reqinstcode)) {
                                                           $canclone = 1;
                                                           last;
                                                       }
                                                   }
                                               }
                                           }
                                       }
                                   }
                               }
                           }
                     } elsif (defined($cloneruname)) {                      } elsif (defined($cloneruname)) {
                         if ($cc_clone{$unesc_key}) {                          if ($cc_clone{$unesc_key}) {
                             $canclone = 1;                              $canclone = 1;
Line 482  sub dump_course_id_handler { Line 527  sub dump_course_id_handler {
                             }                              }
                         }                          }
                     }                      }
                       unless (($canclone) || ($items->{'cloners'})) {
                           my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
                           if ($domdefs{'canclone'}) {
                               unless ($domdefs{'canclone'} eq 'none') {
                                   if ($domdefs{'canclone'} eq 'domain') {
                                       if ($clonerudom eq $udom) {
                                           $canclone = 1;
                                       }
                                   } elsif (($clonefromcode) && ($reqinstcode) &&
                                            ($udom eq $reqcrsdom)) {
                                       if (&Apache::lonnet::default_instcode_cloning($udom,$domdefs{'canclone'},
                                                                                     $clonefromcode,$reqinstcode)) {
                                           $canclone = 1;
                                       }
                                   }
                               }
                           }
                       }
                 }                  }
                 if ($unpack || !$rtn_as_hash) {                  if ($unpack || !$rtn_as_hash) {
                     $unesc_val{'descr'} = $items->{'description'};                      $unesc_val{'descr'} = $items->{'description'};
Line 530  sub dump_course_id_handler { Line 593  sub dump_course_id_handler {
                         next if !$showhidden;                          next if !$showhidden;
                     }                      }
                 }                  }
                   if ($hasuniquecode ne '.') {
                       next unless ($items->{'uniquecode'});
                   }
             } else {              } else {
                 next if ($catfilter ne '');                  next if ($catfilter ne '');
                 next if ($selfenrollonly);                  next if ($selfenrollonly);
Line 716  sub dump_profile_database { Line 782  sub dump_profile_database {
     return $qresult;      return $qresult;
 }  }
   
   sub is_course {
       my ($cdom,$cnum) = @_;
   
       return unless (($cdom =~ /^$LONCAPA::match_domain$/) &&
                      ($cnum =~ /^$LONCAPA::match_courseid$/));
       my $hashid = $cdom.':'.$cnum;
       my ($iscourse,$cached) =
           &Apache::lonnet::is_cached_new('iscourse',$hashid);
       unless (defined($cached)) {
           my $hashref =
               &tie_domain_hash($cdom, "nohist_courseids", &GDBM_WRCREAT());
           if (ref($hashref) eq 'HASH') {
               my $esc_key = &escape($cdom.'_'.$cnum);
               if (exists($hashref->{$esc_key})) {
                   $iscourse = 1;
               } else {
                   $iscourse = 0;
               }
               &Apache::lonnet::do_cache_new('iscourse',$hashid,$iscourse,3600);
               unless (&untie_domain_hash($hashref)) {
                   &logthis("Failed to untie tied hash for nohist_courseids.db for $cdom");
               }
           } else {
               &logthis("Failed to tie hash for nohist_courseids.db for $cdom");
           }
       }
       return $iscourse;
   }
   
   sub get_dom {
       my ($userinput) = @_;
       my ($cmd,$udom,$namespace,$what) =split(/:/,$userinput,4);
       my $hashref = &tie_domain_hash($udom,$namespace,&GDBM_READER()) or
           return "error: ".($!+0)." tie(GDBM) Failed while attempting $cmd";
       my $qresult='';
       if (ref($hashref)) {
           chomp($what);
           my @queries=split(/\&/,$what);
           for (my $i=0;$i<=$#queries;$i++) {
               $qresult.="$hashref->{$queries[$i]}&";
           }
           $qresult=~s/\&$//;
       }
       &untie_user_hash($hashref) or
           return "error: ".($!+0)." untie(GDBM) Failed while attempting $cmd";
       return $qresult;
   }
   
 1;  1;
   
Line 776  Returns: 1 (Continue processing). Line 889  Returns: 1 (Continue processing).
   
 Side effects: response is written to $client.    Side effects: response is written to $client.  
   
 =item dump_couse_id_handler  =item dump_course_id_handler
   
 #TODO copy from lond  #TODO copy from lond
   
Line 839  courseID -- for the course for which the Line 952  courseID -- for the course for which the
 The contents of the inner hash, for that single item in the outer hash  The contents of the inner hash, for that single item in the outer hash
 are returned (and cached in memcache for 10 minutes).  are returned (and cached in memcache for 10 minutes).
   
   =item get_dom ( $userinput )
   
   get_dom() will retrieve domain configuration information from a GDBM file
   in /home/httpd/lonUsers/$dom on the primary library server in a domain.
   The single argument passed is the string: $cmd:$udom:$namespace:$what
   where $cmd is the command historically passed to lond - i.e., getdom
   or egetdom, $udom is the domain, $namespace is the name of the GDBM file
   (encconfig or configuration), and $what is a string containing names of
   items to retrieve from the db file (each item name is escaped and separated
   from the next item name with an ampersand). The return value is either:
   error: followed by an error message, or a string containing the value (escaped)
   for each item, again separated from the next item with an ampersand.
   
 =back  =back
   

Removed from v.1.4  
changed lines
  Added in v.1.8.2.2


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