Annotation of loncom/Lond.pm, revision 1.8.2.3.2.1

1.1       droeschl    1: # The LearningOnline Network
                      2: #
1.8.2.3.2.1! raeburn     3: # $Id: Lond.pm,v 1.8.2.3 2022/01/19 16:47:51 raeburn Exp $
1.1       droeschl    4: #
                      5: # Copyright Michigan State University Board of Trustees
                      6: #
                      7: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      8: #
                      9: # LON-CAPA is free software; you can redistribute it and/or modify
                     10: # it under the terms of the GNU General Public License as published by
                     11: # the Free Software Foundation; either version 2 of the License, or
                     12: # (at your option) any later version.
                     13: #
                     14: # LON-CAPA is distributed in the hope that it will be useful,
                     15: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     16: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     17: # GNU General Public License for more details.
                     18: #
                     19: # You should have received a copy of the GNU General Public License
                     20: # along with LON-CAPA; if not, write to the Free Software
                     21: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     22: #
                     23: # /home/httpd/html/adm/gpl.txt
                     24: #
                     25: # http://www.lon-capa.org/
                     26: #
                     27: ###
                     28: 
                     29: #NOTE perldoc at the end of file
1.4       droeschl   30: #TODO move remaining lond functions into this
1.1       droeschl   31: 
                     32: package LONCAPA::Lond;
                     33: 
                     34: use strict;
                     35: use lib '/home/httpd/lib/perl/';
                     36: 
                     37: use LONCAPA;
                     38: use Apache::lonnet;
                     39: use GDBM_File;
1.8.2.3.2.1! raeburn    40: use Net::OAuth;
1.1       droeschl   41: 
                     42: sub dump_with_regexp {
1.4       droeschl   43:     my ( $tail, $clientversion ) = @_;
1.2       droeschl   44:     my ( $udom, $uname, $namespace, $regexp, $range ) = 
                     45:         split /:/, $tail;
1.1       droeschl   46: 
1.4       droeschl   47:     $regexp = $regexp ? unescape($regexp) : '.';
1.1       droeschl   48: 
                     49:     my ($start,$end);
1.2       droeschl   50: 
1.1       droeschl   51:     if (defined($range)) {
1.2       droeschl   52:         if ($range =~ /^(\d+)\-(\d+)$/) {
                     53:             ($start,$end) = ($1,$2);
                     54:         } elsif ($range =~/^(\d+)$/) {
                     55:             ($start,$end) = (0,$1);
                     56:         } else {
                     57:             undef($range);
                     58:         }
                     59:     }
                     60: 
                     61:     my $hashref = &tie_user_hash($udom, $uname, $namespace, &GDBM_READER()) or 
                     62:         return "error: ".($!+0)." tie(GDBM) Failed while attempting dump";
                     63: 
                     64:     my $qresult = '';
                     65:     my $count = 0;
1.1       droeschl   66: #
                     67: # When dump is for roles.db, determine if LON-CAPA version checking is needed.
1.2       droeschl   68: # Sessions on 2.10 and later do not require version checking, as that occurs
1.1       droeschl   69: # on the server hosting the user session, when constructing the roles/courses 
                     70: # screen).
                     71: # 
1.2       droeschl   72:     my $skipcheck;
                     73:     my @ids = &Apache::lonnet::current_machine_ids();
                     74:     my (%homecourses, $major, $minor, $now);
1.1       droeschl   75: # 
                     76: # If dump is for roles.db from a pre-2.10 server, determine the LON-CAPA   
1.2       droeschl   77: # version on the server which requested the data. 
1.1       droeschl   78: # 
1.2       droeschl   79:     if ($namespace eq 'roles') {
                     80:         if ($clientversion =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?/) {
                     81:             $major = $1;
                     82:             $minor = $2;
1.4       droeschl   83: 
1.2       droeschl   84:         }
                     85:         if (($major > 2) || (($major == 2) && ($minor > 9))) {
                     86:             $skipcheck = 1;
1.1       droeschl   87:         }
1.2       droeschl   88:         $now = time;
                     89:     }
                     90:     while (my ($key,$value) = each(%$hashref)) {
                     91:             if ($namespace eq 'roles' && (!$skipcheck)) {
1.1       droeschl   92:                 if ($key =~ m{^/($LONCAPA::match_domain)/($LONCAPA::match_courseid)(/?[^_]*)_(cc|co|in|ta|ep|ad|st|cr)$}) {
                     93:                     my $cdom = $1;
                     94:                     my $cnum = $2;
1.2       droeschl   95:                     my ($role,$roleend,$rolestart) = split(/\_/,$value);
                     96:                     if (!$roleend || $roleend > $now) {
1.1       droeschl   97: #
                     98: # For active course roles, check that requesting server is running a LON-CAPA
                     99: # version which meets any version requirements for the course. Do not include
                    100: # the role amongst the results returned if the requesting server's version is
                    101: # too old.
                    102: #
                    103: # This determination is handled differently depending on whether the course's 
                    104: # homeserver is the current server, or whether it is a different server.
                    105: # In both cases, the course's version requirement needs to be retrieved.
                    106: # 
1.2       droeschl  107:                         next unless (&releasereqd_check($cnum,$cdom,$key,$value,$major,
                    108:                                                         $minor,\%homecourses,\@ids));
1.1       droeschl  109:                     }
                    110:                 }
                    111:             }
1.2       droeschl  112:         if ($regexp eq '.') {
                    113:             $count++;
                    114:             if (defined($range) && $count >= $end)   { last; }
                    115:             if (defined($range) && $count <  $start) { next; }
                    116:             $qresult.=$key.'='.$value.'&';
                    117:         } else {
                    118:             my $unescapeKey = &unescape($key);
                    119:             if (eval('$unescapeKey=~/$regexp/')) {
                    120:                 $count++;
                    121:                 if (defined($range) && $count >= $end)   { last; }
                    122:                 if (defined($range) && $count <  $start) { next; }
                    123:                 $qresult.="$key=$value&";
                    124:             }
                    125:         }
                    126:     }
                    127: 
                    128:     &untie_user_hash($hashref) or 
                    129:         return "error: ".($!+0)." untie(GDBM) Failed while attempting dump";
1.1       droeschl  130: #
                    131: # If dump is for roles.db from a pre-2.10 server, check if the LON-CAPA
                    132: # version requirements for courses for which the current server is the home
                    133: # server permit course roles to be usable on the client server hosting the
                    134: # user's session. If so, include those role results in the data returned to  
                    135: # the client server.
                    136: #
1.2       droeschl  137:     if (($namespace eq 'roles') && (!$skipcheck)) {
                    138:         if (keys(%homecourses) > 0) {
                    139:             $qresult .= &check_homecourses(\%homecourses,$regexp,$count,
                    140:                                            $range,$start,$end,$major,$minor);
                    141:         }
                    142:     }
                    143:     chop($qresult);
                    144:     return $qresult;
                    145: }
                    146: 
                    147: 
                    148: sub releasereqd_check {
                    149:     my ($cnum,$cdom,$key,$value,$major,$minor,$homecourses,$ids) = @_;
                    150:     my $home = &Apache::lonnet::homeserver($cnum,$cdom);
                    151:     return if ($home eq 'no_host');
                    152:     my ($reqdmajor,$reqdminor,$displayrole);
                    153:     if ($cnum =~ /$LONCAPA::match_community/) {
                    154:         if ($major eq '' && $minor eq '') {
                    155:             return unless ((ref($ids) eq 'ARRAY') && 
                    156:                            (grep(/^\Q$home\E$/,@{$ids})));
                    157:         } else {
                    158:             $reqdmajor = 2;
                    159:             $reqdminor = 9;
                    160:             return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
                    161:         }
                    162:     }
                    163:     my $hashid = $cdom.':'.$cnum;
                    164:     my ($courseinfo,$cached) =
                    165:         &Apache::lonnet::is_cached_new('courseinfo',$hashid);
                    166:     if (defined($cached)) {
                    167:         if (ref($courseinfo) eq 'HASH') {
                    168:             if (exists($courseinfo->{'releaserequired'})) {
                    169:                 my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});
                    170:                 return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
                    171:             }
                    172:         }
                    173:     } else {
                    174:         if (ref($ids) eq 'ARRAY') {
                    175:             if (grep(/^\Q$home\E$/,@{$ids})) {
                    176:                 if (ref($homecourses) eq 'HASH') {
                    177:                     if (ref($homecourses->{$cdom}) eq 'HASH') {
                    178:                         if (ref($homecourses->{$cdom}{$cnum}) eq 'HASH') {
                    179:                             if (ref($homecourses->{$cdom}{$cnum}) eq 'ARRAY') {
                    180:                                 push(@{$homecourses->{$cdom}{$cnum}},{$key=>$value});
                    181:                             } else {
                    182:                                 $homecourses->{$cdom}{$cnum} = [{$key=>$value}];
                    183:                             }
                    184:                         } else {
                    185:                             $homecourses->{$cdom}{$cnum} = [{$key=>$value}];
                    186:                         }
                    187:                     } else {
                    188:                         $homecourses->{$cdom}{$cnum} = [{$key=>$value}];
                    189:                     }
                    190:                 }
                    191:                 return;
                    192:             }
                    193:         }
                    194:         my $courseinfo = &get_courseinfo_hash($cnum,$cdom,$home);
                    195:         if (ref($courseinfo) eq 'HASH') {
                    196:             if (exists($courseinfo->{'releaserequired'})) {
                    197:                 my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});
                    198:                 return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
                    199:             }
                    200:         } else {
                    201:             return;
                    202:         }
                    203:     }
                    204:     return 1;
                    205: }
                    206: 
                    207: 
                    208: sub check_homecourses {
                    209:     my ($homecourses,$regexp,$count,$range,$start,$end,$major,$minor) = @_;
                    210:     my ($result,%addtocache);
                    211:     my $yesterday = time - 24*3600; 
                    212:     if (ref($homecourses) eq 'HASH') {
                    213:         my (%okcourses,%courseinfo,%recent);
                    214:         foreach my $domain (keys(%{$homecourses})) {
                    215:             my $hashref = 
                    216:                 &tie_domain_hash($domain, "nohist_courseids", &GDBM_WRCREAT());
                    217:             if (ref($hashref) eq 'HASH') {
                    218:                 while (my ($key,$value) = each(%$hashref)) {
                    219:                     my $unesc_key = &unescape($key);
                    220:                     if ($unesc_key =~ /^lasttime:(\w+)$/) {
                    221:                         my $cid = $1;
                    222:                         $cid =~ s/_/:/;
                    223:                         if ($value > $yesterday ) {
                    224:                             $recent{$cid} = 1;
                    225:                         }
                    226:                         next;
                    227:                     }
                    228:                     my $items = &Apache::lonnet::thaw_unescape($value);
                    229:                     if (ref($items) eq 'HASH') {
                    230:                         my ($cdom,$cnum) = split(/_/,$unesc_key);
                    231:                         my $hashid = $cdom.':'.$cnum; 
                    232:                         $courseinfo{$hashid} = $items;
                    233:                         if (ref($homecourses->{$cdom}{$cnum}) eq 'ARRAY') {
                    234:                             my ($reqdmajor,$reqdminor) = split(/\./,$items->{'releaserequired'});
                    235:                             if (&useable_role($reqdmajor,$reqdminor,$major,$minor)) {
                    236:                                $okcourses{$hashid} = 1;
                    237:                             }
                    238:                         }
                    239:                     }
                    240:                 }
                    241:                 unless (&untie_domain_hash($hashref)) {
1.8.2.3   raeburn   242:                     &Apache::lonnet::logthis("Failed to untie tied hash for nohist_courseids.db for $domain");
1.2       droeschl  243:                 }
                    244:             } else {
1.8.2.3   raeburn   245:                 &Apache::lonnet::logthis("Failed to tie hash for nohist_courseids.db for $domain");
1.2       droeschl  246:             }
                    247:         }
                    248:         foreach my $hashid (keys(%recent)) {
                    249:             my ($result,$cached)=&Apache::lonnet::is_cached_new('courseinfo',$hashid);
                    250:             unless ($cached) {
                    251:                 &Apache::lonnet::do_cache_new('courseinfo',$hashid,$courseinfo{$hashid},600);
                    252:             }
                    253:         }
                    254:         foreach my $cdom (keys(%{$homecourses})) {
                    255:             if (ref($homecourses->{$cdom}) eq 'HASH') {
                    256:                 foreach my $cnum (keys(%{$homecourses->{$cdom}})) {
                    257:                     my $hashid = $cdom.':'.$cnum;
                    258:                     next if ($recent{$hashid});
                    259:                     &Apache::lonnet::do_cache_new('courseinfo',$hashid,$courseinfo{$hashid},600);
                    260:                 }
                    261:             }
                    262:         }
                    263:         foreach my $hashid (keys(%okcourses)) {
                    264:             my ($cdom,$cnum) = split(/:/,$hashid);
                    265:             if ((ref($homecourses->{$cdom}) eq 'HASH') &&  
                    266:                 (ref($homecourses->{$cdom}{$cnum}) eq 'ARRAY')) {
                    267:                 foreach my $role (@{$homecourses->{$cdom}{$cnum}}) {
                    268:                     if (ref($role) eq 'HASH') {
                    269:                         while (my ($key,$value) = each(%{$role})) {
                    270:                             if ($regexp eq '.') {
                    271:                                 $count++;
                    272:                                 if (defined($range) && $count >= $end)   { last; }
                    273:                                 if (defined($range) && $count <  $start) { next; }
                    274:                                 $result.=$key.'='.$value.'&';
                    275:                             } else {
                    276:                                 my $unescapeKey = &unescape($key);
                    277:                                 if (eval('$unescapeKey=~/$regexp/')) {
                    278:                                     $count++;
                    279:                                     if (defined($range) && $count >= $end)   { last; }
                    280:                                     if (defined($range) && $count <  $start) { next; }
                    281:                                     $result.="$key=$value&";
                    282:                                 }
                    283:                             }
                    284:                         }
                    285:                     }
1.1       droeschl  286:                 }
                    287:             }
1.2       droeschl  288:         }
1.1       droeschl  289:     }
1.2       droeschl  290:     return $result;
                    291: }
                    292: 
1.1       droeschl  293: 
1.2       droeschl  294: sub useable_role {
                    295:     my ($reqdmajor,$reqdminor,$major,$minor) = @_; 
                    296:     if ($reqdmajor ne '' && $reqdminor ne '') {
                    297:         return if (($major eq '' && $minor eq '') ||
                    298:                    ($major < $reqdmajor) ||
                    299:                    (($major == $reqdmajor) && ($minor < $reqdminor)));
                    300:     }
1.1       droeschl  301:     return 1;
                    302: }
                    303: 
1.2       droeschl  304: 
1.3       droeschl  305: sub get_courseinfo_hash {
                    306:     my ($cnum,$cdom,$home) = @_;
                    307:     my %info;
                    308:     eval {
                    309:         local($SIG{ALRM}) = sub { die "timeout\n"; };
                    310:         local($SIG{__DIE__})='DEFAULT';
                    311:         alarm(3);
                    312:         %info = &Apache::lonnet::courseiddump($cdom,'.',1,'.','.',$cnum,1,[$home],'.');
                    313:         alarm(0);
                    314:     };
                    315:     if ($@) {
                    316:         if ($@ eq "timeout\n") {
1.8.2.3   raeburn   317:             &Apache::lonnet::logthis("<font color='blue'>WARNING courseiddump for $cnum:$cdom from $home timedout</font>");
1.3       droeschl  318:         } else {
1.8.2.3   raeburn   319:             &Apache::lonnet::logthis("<font color='yellow'>WARNING unexpected error during eval of call for courseiddump from $home</font>");
1.3       droeschl  320:         }
                    321:     } else {
                    322:         if (ref($info{$cdom.'_'.$cnum}) eq 'HASH') {
                    323:             my $hashid = $cdom.':'.$cnum;
                    324:             return &Apache::lonnet::do_cache_new('courseinfo',$hashid,$info{$cdom.'_'.$cnum},600);
                    325:         }
                    326:     }
                    327:     return;
                    328: }
1.2       droeschl  329: 
1.4       droeschl  330: sub dump_course_id_handler {
                    331:     my ($tail) = @_;
                    332: 
                    333:     my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter,
                    334:         $typefilter,$regexp_ok,$rtn_as_hash,$selfenrollonly,$catfilter,$showhidden,
                    335:         $caller,$cloner,$cc_clone_list,$cloneonly,$createdbefore,$createdafter,
1.7       raeburn   336:         $creationcontext,$domcloner,$hasuniquecode,$reqcrsdom,$reqinstcode) = split(/:/,$tail);
1.4       droeschl  337:     my $now = time;
                    338:     my ($cloneruname,$clonerudom,%cc_clone);
                    339:     if (defined($description)) {
                    340: 	$description=&unescape($description);
                    341:     } else {
                    342: 	$description='.';
                    343:     }
                    344:     if (defined($instcodefilter)) {
                    345:         $instcodefilter=&unescape($instcodefilter);
                    346:     } else {
                    347:         $instcodefilter='.';
                    348:     }
                    349:     my ($ownerunamefilter,$ownerdomfilter);
                    350:     if (defined($ownerfilter)) {
                    351:         $ownerfilter=&unescape($ownerfilter);
                    352:         if ($ownerfilter ne '.' && defined($ownerfilter)) {
                    353:             if ($ownerfilter =~ /^([^:]*):([^:]*)$/) {
                    354:                  $ownerunamefilter = $1;
                    355:                  $ownerdomfilter = $2;
                    356:             } else {
                    357:                 $ownerunamefilter = $ownerfilter;
                    358:                 $ownerdomfilter = '';
                    359:             }
                    360:         }
                    361:     } else {
                    362:         $ownerfilter='.';
                    363:     }
                    364: 
                    365:     if (defined($coursefilter)) {
                    366:         $coursefilter=&unescape($coursefilter);
                    367:     } else {
                    368:         $coursefilter='.';
                    369:     }
                    370:     if (defined($typefilter)) {
                    371:         $typefilter=&unescape($typefilter);
                    372:     } else {
                    373:         $typefilter='.';
                    374:     }
                    375:     if (defined($regexp_ok)) {
                    376:         $regexp_ok=&unescape($regexp_ok);
                    377:     }
                    378:     if (defined($catfilter)) {
                    379:         $catfilter=&unescape($catfilter);
                    380:     }
                    381:     if (defined($cloner)) {
                    382:         $cloner = &unescape($cloner);
                    383:         ($cloneruname,$clonerudom) = ($cloner =~ /^($LONCAPA::match_username):($LONCAPA::match_domain)$/); 
                    384:     }
                    385:     if (defined($cc_clone_list)) {
                    386:         $cc_clone_list = &unescape($cc_clone_list);
                    387:         my @cc_cloners = split('&',$cc_clone_list);
                    388:         foreach my $cid (@cc_cloners) {
                    389:             my ($clonedom,$clonenum) = split(':',$cid);
                    390:             next if ($clonedom ne $udom); 
                    391:             $cc_clone{$clonedom.'_'.$clonenum} = 1;
                    392:         } 
                    393:     }
                    394:     if ($createdbefore ne '') {
                    395:         $createdbefore = &unescape($createdbefore);
                    396:     } else {
                    397:        $createdbefore = 0;
                    398:     }
                    399:     if ($createdafter ne '') {
                    400:         $createdafter = &unescape($createdafter);
                    401:     } else {
                    402:         $createdafter = 0;
                    403:     }
                    404:     if ($creationcontext ne '') {
                    405:         $creationcontext = &unescape($creationcontext);
                    406:     } else {
                    407:         $creationcontext = '.';
                    408:     }
1.6       raeburn   409:     unless ($hasuniquecode) {
                    410:         $hasuniquecode = '.';
                    411:     }
1.8       raeburn   412:     if ($reqinstcode ne '') {
                    413:         $reqinstcode = &unescape($reqinstcode);
                    414:     }
1.4       droeschl  415:     my $unpack = 1;
                    416:     if ($description eq '.' && $instcodefilter eq '.' && $ownerfilter eq '.' && 
                    417:         $typefilter eq '.') {
                    418:         $unpack = 0;
                    419:     }
                    420:     if (!defined($since)) { $since=0; }
1.7       raeburn   421:     my (%gotcodedefaults,%otcodedefaults);
1.4       droeschl  422:     my $qresult='';
                    423: 
                    424:     my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT())
                    425:         or return "error: ".($!+0)." tie(GDBM) Failed while attempting courseiddump";
                    426: 
                    427: 	while (my ($key,$value) = each(%$hashref)) {
                    428:             my ($unesc_key,$lasttime_key,$lasttime,$is_hash,%val,
                    429:                 %unesc_val,$selfenroll_end,$selfenroll_types,$created,
                    430:                 $context);
                    431:             $unesc_key = &unescape($key);
                    432:             if ($unesc_key =~ /^lasttime:/) {
                    433:                 next;
                    434:             } else {
                    435:                 $lasttime_key = &escape('lasttime:'.$unesc_key);
                    436:             }
                    437:             if ($hashref->{$lasttime_key} ne '') {
                    438:                 $lasttime = $hashref->{$lasttime_key};
                    439:                 next if ($lasttime<$since);
                    440:             }
1.7       raeburn   441:             my ($canclone,$valchange,$clonefromcode);
1.4       droeschl  442:             my $items = &Apache::lonnet::thaw_unescape($value);
                    443:             if (ref($items) eq 'HASH') {
                    444:                 if ($hashref->{$lasttime_key} eq '') {
                    445:                     next if ($since > 1);
                    446:                 }
1.7       raeburn   447:                 if ($items->{'inst_code'}) {
                    448:                     $clonefromcode = $items->{'inst_code'};
                    449:                 }
1.4       droeschl  450:                 $is_hash =  1;
                    451:                 if ($domcloner) {
                    452:                     $canclone = 1;
                    453:                 } elsif (defined($clonerudom)) {
                    454:                     if ($items->{'cloners'}) {
                    455:                         my @cloneable = split(',',$items->{'cloners'});
                    456:                         if (@cloneable) {
                    457:                             if (grep(/^\*$/,@cloneable))  {
                    458:                                 $canclone = 1;
                    459:                             } elsif (grep(/^\*:\Q$clonerudom\E$/,@cloneable)) {
                    460:                                 $canclone = 1;
                    461:                             } elsif (grep(/^\Q$cloneruname\E:\Q$clonerudom\E$/,@cloneable)) {
                    462:                                 $canclone = 1;
                    463:                             }
                    464:                         }
                    465:                         unless ($canclone) {
                    466:                             if ($cloneruname ne '' && $clonerudom ne '') {
                    467:                                 if ($cc_clone{$unesc_key}) {
                    468:                                     $canclone = 1;
                    469:                                     $items->{'cloners'} .= ','.$cloneruname.':'.
                    470:                                                            $clonerudom;
                    471:                                     $valchange = 1;
                    472:                                 }
                    473:                             }
                    474:                         }
1.7       raeburn   475:                         unless ($canclone) {
                    476:                             if (($reqcrsdom eq $udom) && ($reqinstcode) && ($clonefromcode)) {
                    477:                                 if (grep(/\=/,@cloneable))  {
                    478:                                     foreach my $cloner (@cloneable) {
                    479:                                         if (($cloner ne '*') && ($cloner !~ /^\*\:$LONCAPA::match_domain$/) &&
                    480:                                             ($cloner !~ /^$LONCAPA::match_username\:$LONCAPA::match_domain$/) && ($cloner ne '')) {
                    481:                                             if ($cloner =~ /=/) {
                    482:                                                 my (%codedefaults,@code_order);
                    483:                                                 if (ref($gotcodedefaults{$udom}) eq 'HASH') {
                    484:                                                     if (ref($gotcodedefaults{$udom}{'defaults'}) eq 'HASH') {
                    485:                                                         %codedefaults = %{$gotcodedefaults{$udom}{'defaults'}};
                    486:                                                     }
                    487:                                                     if (ref($gotcodedefaults{$udom}{'order'}) eq 'ARRAY') {
                    488:                                                         @code_order = @{$gotcodedefaults{$udom}{'order'}};
                    489:                                                     }
                    490:                                                 } else {
                    491:                                                     &Apache::lonnet::auto_instcode_defaults($udom,
                    492:                                                                                             \%codedefaults,
                    493:                                                                                             \@code_order);
                    494:                                                     $gotcodedefaults{$udom}{'defaults'} = \%codedefaults;
                    495:                                                     $gotcodedefaults{$udom}{'order'} = \@code_order;
                    496:                                                 }
                    497:                                                 if (@code_order > 0) {
                    498:                                                     if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
                    499:                                                                                                 $cloner,$clonefromcode,$reqinstcode)) {
                    500:                                                         $canclone = 1;
                    501:                                                         last;
                    502:                                                     }
                    503:                                                 }
                    504:                                             }
                    505:                                         }
                    506:                                     }
                    507:                                 }
                    508:                             }
                    509:                         }
1.4       droeschl  510:                     } elsif (defined($cloneruname)) {
                    511:                         if ($cc_clone{$unesc_key}) {
                    512:                             $canclone = 1;
                    513:                             $items->{'cloners'} = $cloneruname.':'.$clonerudom;
                    514:                             $valchange = 1;
                    515:                         }
                    516:                         unless ($canclone) {
                    517:                             if ($items->{'owner'} =~ /:/) {
                    518:                                 if ($items->{'owner'} eq $cloner) {
                    519:                                     $canclone = 1;
                    520:                                 }
                    521:                             } elsif ($cloner eq $items->{'owner'}.':'.$udom) {
                    522:                                 $canclone = 1;
                    523:                             }
                    524:                             if ($canclone) {
                    525:                                 $items->{'cloners'} = $cloneruname.':'.$clonerudom;
                    526:                                 $valchange = 1;
                    527:                             }
                    528:                         }
                    529:                     }
1.7       raeburn   530:                     unless (($canclone) || ($items->{'cloners'})) {
                    531:                         my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
                    532:                         if ($domdefs{'canclone'}) {
                    533:                             unless ($domdefs{'canclone'} eq 'none') {
                    534:                                 if ($domdefs{'canclone'} eq 'domain') {
                    535:                                     if ($clonerudom eq $udom) {
                    536:                                         $canclone = 1;
                    537:                                     }
                    538:                                 } elsif (($clonefromcode) && ($reqinstcode) &&
                    539:                                          ($udom eq $reqcrsdom)) {
                    540:                                     if (&Apache::lonnet::default_instcode_cloning($udom,$domdefs{'canclone'},
                    541:                                                                                   $clonefromcode,$reqinstcode)) {
                    542:                                         $canclone = 1;
                    543:                                     }
                    544:                                 }
                    545:                             }
                    546:                         }
                    547:                     }
1.4       droeschl  548:                 }
                    549:                 if ($unpack || !$rtn_as_hash) {
                    550:                     $unesc_val{'descr'} = $items->{'description'};
                    551:                     $unesc_val{'inst_code'} = $items->{'inst_code'};
                    552:                     $unesc_val{'owner'} = $items->{'owner'};
                    553:                     $unesc_val{'type'} = $items->{'type'};
                    554:                     $unesc_val{'cloners'} = $items->{'cloners'};
                    555:                     $unesc_val{'created'} = $items->{'created'};
                    556:                     $unesc_val{'context'} = $items->{'context'};
                    557:                 }
                    558:                 $selfenroll_types = $items->{'selfenroll_types'};
                    559:                 $selfenroll_end = $items->{'selfenroll_end_date'};
                    560:                 $created = $items->{'created'};
                    561:                 $context = $items->{'context'};
                    562:                 if ($selfenrollonly) {
                    563:                     next if (!$selfenroll_types);
                    564:                     if (($selfenroll_end > 0) && ($selfenroll_end <= $now)) {
                    565:                         next;
                    566:                     }
                    567:                 }
                    568:                 if ($creationcontext ne '.') {
                    569:                     next if (($context ne '') && ($context ne $creationcontext));  
                    570:                 }
                    571:                 if ($createdbefore > 0) {
                    572:                     next if (($created eq '') || ($created > $createdbefore));   
                    573:                 }
                    574:                 if ($createdafter > 0) {
                    575:                     next if (($created eq '') || ($created <= $createdafter)); 
                    576:                 }
                    577:                 if ($catfilter ne '') {
                    578:                     next if ($items->{'categories'} eq '');
                    579:                     my @categories = split('&',$items->{'categories'}); 
                    580:                     next if (@categories == 0);
                    581:                     my @subcats = split('&',$catfilter);
                    582:                     my $matchcat = 0;
                    583:                     foreach my $cat (@categories) {
                    584:                         if (grep(/^\Q$cat\E$/,@subcats)) {
                    585:                             $matchcat = 1;
                    586:                             last;
                    587:                         }
                    588:                     }
                    589:                     next if (!$matchcat);
                    590:                 }
                    591:                 if ($caller eq 'coursecatalog') {
                    592:                     if ($items->{'hidefromcat'} eq 'yes') {
                    593:                         next if !$showhidden;
                    594:                     }
                    595:                 }
1.6       raeburn   596:                 if ($hasuniquecode ne '.') {
                    597:                     next unless ($items->{'uniquecode'});
                    598:                 }
1.4       droeschl  599:             } else {
                    600:                 next if ($catfilter ne '');
                    601:                 next if ($selfenrollonly);
                    602:                 next if ($createdbefore || $createdafter);
                    603:                 next if ($creationcontext ne '.');
                    604:                 if ((defined($clonerudom)) && (defined($cloneruname)))  {
                    605:                     if ($cc_clone{$unesc_key}) {
                    606:                         $canclone = 1;
                    607:                         $val{'cloners'} = &escape($cloneruname.':'.$clonerudom);
                    608:                     }
                    609:                 }
                    610:                 $is_hash =  0;
                    611:                 my @courseitems = split(/:/,$value);
                    612:                 $lasttime = pop(@courseitems);
                    613:                 if ($hashref->{$lasttime_key} eq '') {
                    614:                     next if ($lasttime<$since);
                    615:                 }
                    616: 	        ($val{'descr'},$val{'inst_code'},$val{'owner'},$val{'type'}) = @courseitems;
                    617:             }
                    618:             if ($cloneonly) {
                    619:                next unless ($canclone);
                    620:             }
                    621:             my $match = 1;
                    622: 	    if ($description ne '.') {
                    623:                 if (!$is_hash) {
                    624:                     $unesc_val{'descr'} = &unescape($val{'descr'});
                    625:                 }
                    626:                 if (eval{$unesc_val{'descr'} !~ /\Q$description\E/i}) {
                    627:                     $match = 0;
                    628:                 }
                    629:             }
                    630:             if ($instcodefilter ne '.') {
                    631:                 if (!$is_hash) {
                    632:                     $unesc_val{'inst_code'} = &unescape($val{'inst_code'});
                    633:                 }
                    634:                 if ($regexp_ok == 1) {
                    635:                     if (eval{$unesc_val{'inst_code'} !~ /$instcodefilter/}) {
                    636:                         $match = 0;
                    637:                     }
                    638:                 } elsif ($regexp_ok == -1) {
                    639:                     if (eval{$unesc_val{'inst_code'} =~ /$instcodefilter/}) {
                    640:                         $match = 0;
                    641:                     }
                    642:                 } else {
                    643:                     if (eval{$unesc_val{'inst_code'} !~ /\Q$instcodefilter\E/i}) {
                    644:                         $match = 0;
                    645:                     }
                    646:                 }
                    647: 	    }
                    648:             if ($ownerfilter ne '.') {
                    649:                 if (!$is_hash) {
                    650:                     $unesc_val{'owner'} = &unescape($val{'owner'});
                    651:                 }
                    652:                 if (($ownerunamefilter ne '') && ($ownerdomfilter ne '')) {
                    653:                     if ($unesc_val{'owner'} =~ /:/) {
                    654:                         if (eval{$unesc_val{'owner'} !~ 
                    655:                              /\Q$ownerunamefilter\E:\Q$ownerdomfilter\E$/i}) {
                    656:                             $match = 0;
                    657:                         } 
                    658:                     } else {
                    659:                         if (eval{$unesc_val{'owner'} !~ /\Q$ownerunamefilter\E/i}) {
                    660:                             $match = 0;
                    661:                         }
                    662:                     }
                    663:                 } elsif ($ownerunamefilter ne '') {
                    664:                     if ($unesc_val{'owner'} =~ /:/) {
                    665:                         if (eval{$unesc_val{'owner'} !~ /\Q$ownerunamefilter\E:[^:]+$/i}) {
                    666:                              $match = 0;
                    667:                         }
                    668:                     } else {
                    669:                         if (eval{$unesc_val{'owner'} !~ /\Q$ownerunamefilter\E/i}) {
                    670:                             $match = 0;
                    671:                         }
                    672:                     }
                    673:                 } elsif ($ownerdomfilter ne '') {
                    674:                     if ($unesc_val{'owner'} =~ /:/) {
                    675:                         if (eval{$unesc_val{'owner'} !~ /^[^:]+:\Q$ownerdomfilter\E/}) {
                    676:                              $match = 0;
                    677:                         }
                    678:                     } else {
                    679:                         if ($ownerdomfilter ne $udom) {
                    680:                             $match = 0;
                    681:                         }
                    682:                     }
                    683:                 }
                    684:             }
                    685:             if ($coursefilter ne '.') {
                    686:                 if (eval{$unesc_key !~ /^$udom(_)\Q$coursefilter\E$/}) {
                    687:                     $match = 0;
                    688:                 }
                    689:             }
                    690:             if ($typefilter ne '.') {
                    691:                 if (!$is_hash) {
                    692:                     $unesc_val{'type'} = &unescape($val{'type'});
                    693:                 }
                    694:                 if ($unesc_val{'type'} eq '') {
                    695:                     if ($typefilter ne 'Course') {
                    696:                         $match = 0;
                    697:                     }
                    698:                 } else {
                    699:                     if (eval{$unesc_val{'type'} !~ /^\Q$typefilter\E$/}) {
                    700:                         $match = 0;
                    701:                     }
                    702:                 }
                    703:             }
                    704:             if ($match == 1) {
                    705:                 if ($rtn_as_hash) {
                    706:                     if ($is_hash) {
                    707:                         if ($valchange) {
                    708:                             my $newvalue = &Apache::lonnet::freeze_escape($items);
                    709:                             $qresult.=$key.'='.$newvalue.'&';
                    710:                         } else {
                    711:                             $qresult.=$key.'='.$value.'&';
                    712:                         }
                    713:                     } else {
                    714:                         my %rtnhash = ( 'description' => &unescape($val{'descr'}),
                    715:                                         'inst_code' => &unescape($val{'inst_code'}),
                    716:                                         'owner'     => &unescape($val{'owner'}),
                    717:                                         'type'      => &unescape($val{'type'}),
                    718:                                         'cloners'   => &unescape($val{'cloners'}),
                    719:                                       );
                    720:                         my $items = &Apache::lonnet::freeze_escape(\%rtnhash);
                    721:                         $qresult.=$key.'='.$items.'&';
                    722:                     }
                    723:                 } else {
                    724:                     if ($is_hash) {
                    725:                         $qresult .= $key.'='.&escape($unesc_val{'descr'}).':'.
                    726:                                     &escape($unesc_val{'inst_code'}).':'.
                    727:                                     &escape($unesc_val{'owner'}).'&';
                    728:                     } else {
                    729:                         $qresult .= $key.'='.$val{'descr'}.':'.$val{'inst_code'}.
                    730:                                     ':'.$val{'owner'}.'&';
                    731:                     }
                    732:                 }
                    733:             }
                    734: 	}
                    735:     &untie_domain_hash($hashref) or 
                    736:         return "error: ".($!+0)." untie(GDBM) Failed while attempting courseiddump";
                    737: 
                    738:     chop($qresult);
                    739:     return $qresult;
                    740: }
                    741: 
                    742: sub dump_profile_database {
                    743:     my ($tail) = @_;
                    744: 
                    745:     my ($udom,$uname,$namespace) = split(/:/,$tail);
                    746: 
                    747:     my $hashref = &tie_user_hash($udom, $uname, $namespace, &GDBM_READER()) or
                    748:         return "error: ".($!+0)." tie(GDBM) Failed while attempting currentdump";
                    749: 
                    750: 	# Structure of %data:
                    751: 	# $data{$symb}->{$parameter}=$value;
                    752: 	# $data{$symb}->{'v.'.$parameter}=$version;
                    753: 	# since $parameter will be unescaped, we do not
                    754:  	# have to worry about silly parameter names...
                    755: 	
                    756:         my $qresult='';
                    757: 	my %data = ();                     # A hash of anonymous hashes..
                    758: 	while (my ($key,$value) = each(%$hashref)) {
                    759: 	    my ($v,$symb,$param) = split(/:/,$key);
                    760: 	    next if ($v eq 'version' || $symb eq 'keys');
                    761: 	    next if (exists($data{$symb}) && 
                    762: 		     exists($data{$symb}->{$param}) &&
                    763: 		     $data{$symb}->{'v.'.$param} > $v);
                    764: 	    $data{$symb}->{$param}=$value;
                    765: 	    $data{$symb}->{'v.'.$param}=$v;
                    766: 	}
                    767: 
                    768:     &untie_user_hash($hashref) or
                    769:         return "error: ".($!+0)." untie(GDBM) Failed while attempting currentdump";
                    770: 
                    771:     while (my ($symb,$param_hash) = each(%data)) {
                    772:     while(my ($param,$value) = each (%$param_hash)){
                    773:         next if ($param =~ /^v\./);       # Ignore versions...
                    774:         #
                    775:         #   Just dump the symb=value pairs separated by &
                    776:         #
                    777:         $qresult.=$symb.':'.$param.'='.$value.'&';
                    778:     }
                    779:     }
1.2       droeschl  780: 
1.4       droeschl  781:     chop($qresult);
                    782:     return $qresult;
                    783: }
1.2       droeschl  784: 
1.8.2.1   raeburn   785: sub is_course {
                    786:     my ($cdom,$cnum) = @_;
                    787: 
                    788:     return unless (($cdom =~ /^$LONCAPA::match_domain$/) &&
                    789:                    ($cnum =~ /^$LONCAPA::match_courseid$/));
                    790:     my $hashid = $cdom.':'.$cnum;
                    791:     my ($iscourse,$cached) =
                    792:         &Apache::lonnet::is_cached_new('iscourse',$hashid);
                    793:     unless (defined($cached)) {
                    794:         my $hashref =
                    795:             &tie_domain_hash($cdom, "nohist_courseids", &GDBM_WRCREAT());
                    796:         if (ref($hashref) eq 'HASH') {
                    797:             my $esc_key = &escape($cdom.'_'.$cnum);
                    798:             if (exists($hashref->{$esc_key})) {
                    799:                 $iscourse = 1;
                    800:             } else {
                    801:                 $iscourse = 0;
                    802:             }
                    803:             &Apache::lonnet::do_cache_new('iscourse',$hashid,$iscourse,3600);
                    804:             unless (&untie_domain_hash($hashref)) {
1.8.2.3   raeburn   805:                 &Apache::lonnet::logthis("Failed to untie tied hash for nohist_courseids.db for $cdom");
1.8.2.1   raeburn   806:             }
                    807:         } else {
1.8.2.3   raeburn   808:             &Apache::lonnet::logthis("Failed to tie hash for nohist_courseids.db for $cdom");
1.8.2.1   raeburn   809:         }
                    810:     }
                    811:     return $iscourse;
                    812: }
1.2       droeschl  813: 
1.8.2.2   raeburn   814: sub get_dom {
                    815:     my ($userinput) = @_;
                    816:     my ($cmd,$udom,$namespace,$what) =split(/:/,$userinput,4);
                    817:     my $hashref = &tie_domain_hash($udom,$namespace,&GDBM_READER()) or
                    818:         return "error: ".($!+0)." tie(GDBM) Failed while attempting $cmd";
                    819:     my $qresult='';
                    820:     if (ref($hashref)) {
                    821:         chomp($what);
                    822:         my @queries=split(/\&/,$what);
                    823:         for (my $i=0;$i<=$#queries;$i++) {
                    824:             $qresult.="$hashref->{$queries[$i]}&";
                    825:         }
                    826:         $qresult=~s/\&$//;
                    827:     }
                    828:     &untie_user_hash($hashref) or
                    829:         return "error: ".($!+0)." untie(GDBM) Failed while attempting $cmd";
                    830:     return $qresult;
                    831: }
                    832: 
1.8.2.3.2.1! raeburn   833: sub crslti_itemid {
        !           834:     my ($cdom,$cnum,$url,$method,$params,$loncaparev) = @_;
        !           835:     unless (ref($params) eq 'HASH') {
        !           836:         return;
        !           837:     }
        !           838:     if (($cdom eq '') || ($cnum eq '')) {
        !           839:         return;
        !           840:     }
        !           841:     my ($itemid,$consumer_key,$secret);
        !           842: 
        !           843:     if (exists($params->{'oauth_callback'})) {
        !           844:         $Net::OAuth::PROTOCOL_VERSION = Net::OAuth::PROTOCOL_VERSION_1_0A;
        !           845:     } else {
        !           846:         $Net::OAuth::PROTOCOL_VERSION = Net::OAuth::PROTOCOL_VERSION_1_0;
        !           847:     }
        !           848: 
        !           849:     my $consumer_key = $params->{'oauth_consumer_key'};
        !           850:     return if ($consumer_key eq '');
        !           851: 
        !           852:     my (%crslti,%crslti_by_key);
        !           853:     my $hashid=$cdom.'_'.$cnum;
        !           854:     my ($result,$cached)=&Apache::lonnet::is_cached_new('courseltienc',$hashid);
        !           855:     if (defined($cached)) {
        !           856:         if (ref($result) eq 'HASH') {
        !           857:             %crslti = %{$result};
        !           858:         }
        !           859:     } else {
        !           860:         my $reply = &dump_with_regexp(join(":",($cdom,$cnum,'nohist_ltienc','','')),$loncaparev);
        !           861:         %crslti = %{&Apache::lonnet::unserialize($reply)};
        !           862:         my $cachetime = 24*60*60;
        !           863:         &Apache::lonnet::do_cache_new('courseltienc',$hashid,\%crslti,$cachetime);
        !           864:     }
        !           865: 
        !           866:     return if (!keys(%crslti));
        !           867: 
        !           868:     foreach my $id (keys(%crslti)) {
        !           869:         if (ref($crslti{$id}) eq 'HASH') {
        !           870:             my $key = $crslti{$id}{'key'};
        !           871:             if (($key ne '') && ($crslti{$id}{'secret'} ne '')) {
        !           872:                 push(@{$crslti_by_key{$key}},$id);
        !           873:             }
        !           874:         }
        !           875:     }
        !           876: 
        !           877:     return if (!keys(%crslti_by_key));
        !           878: 
        !           879:     if (ref($crslti_by_key{$consumer_key}) eq 'ARRAY') {
        !           880:         foreach my $id (@{$crslti_by_key{$consumer_key}}) {
        !           881:             my $secret = $crslti{$id}{'secret'};
        !           882:             my $request = Net::OAuth->request('request token')->from_hash($params,
        !           883:                                               request_url => $url,
        !           884:                                               request_method => $method,
        !           885:                                               consumer_secret => $secret,);
        !           886:             if ($request->verify()) {
        !           887:                 $itemid = $id;
        !           888:                 last;
        !           889:             }
        !           890:         }
        !           891:     }
        !           892:     return $itemid;
        !           893: }
        !           894: 
        !           895: sub domlti_itemid {
        !           896:     my ($dom,$context,$url,$method,$params,$loncaparev) = @_;
        !           897:     unless (ref($params) eq 'HASH') {
        !           898:         return;
        !           899:     }
        !           900:     if ($dom eq '') {
        !           901:         return;
        !           902:     }
        !           903:     my ($itemid,$consumer_key,$secret);
        !           904: 
        !           905:     if (exists($params->{'oauth_callback'})) {
        !           906:         $Net::OAuth::PROTOCOL_VERSION = Net::OAuth::PROTOCOL_VERSION_1_0A;
        !           907:     } else {
        !           908:         $Net::OAuth::PROTOCOL_VERSION = Net::OAuth::PROTOCOL_VERSION_1_0;
        !           909:     }
        !           910: 
        !           911:     my $consumer_key = $params->{'oauth_consumer_key'};
        !           912:     return if ($consumer_key eq '');
        !           913: 
        !           914:     my %ltienc;
        !           915:     my ($encresult,$enccached)=&Apache::lonnet::is_cached_new('ltienc',$dom);
        !           916:     if (defined($enccached)) {
        !           917:         if (ref($encresult) eq 'HASH') {
        !           918:             %ltienc = %{$encresult};
        !           919:         }
        !           920:     } else {
        !           921:         my $reply = &get_dom("getdom:$dom:encconfig:lti");
        !           922:         my $ltiencref = &Apache::lonnet::thaw_unescape($reply);
        !           923:         if (ref($ltiencref) eq 'HASH') {
        !           924:             %ltienc = %{$ltiencref};
        !           925:         }
        !           926:         my $cachetime = 24*60*60;
        !           927:         &Apache::lonnet::do_cache_new('ltienc',$dom,\%ltienc,$cachetime);
        !           928:     }
        !           929: 
        !           930:     return if (!keys(%ltienc));
        !           931: 
        !           932:     my %lti;
        !           933:     if ($context eq 'deeplink') {
        !           934:         my ($result,$cached)=&Apache::lonnet::is_cached_new('lti',$dom);
        !           935:         if (defined($cached)) {
        !           936:             if (ref($result) eq 'HASH') {
        !           937:                 %lti = %{$result};
        !           938:             }
        !           939:             }
        !           940:         } else {
        !           941:             my $reply = &get_dom("getdom:$dom:configuration:lti");
        !           942:             my $ltiref = &Apache::lonnet::thaw_unescape($reply);
        !           943:             if (ref($ltiref) eq 'HASH') {
        !           944:                 %lti = %{$ltiref};
        !           945:             }
        !           946:             my $cachetime = 24*60*60;
        !           947:             &Apache::lonnet::do_cache_new('lti',$dom,\%lti,$cachetime);
        !           948:         }
        !           949:     }
        !           950:     return if (!keys(%lti));
        !           951: 
        !           952:     my %lti_by_key;
        !           953:     foreach my $id (keys(%ltienc)) {
        !           954:         if (ref($ltienc{$id}) eq 'HASH') {
        !           955:             my $key = $ltienc{$id}{'key'};
        !           956:             if (($key ne '') && ($ltienc{$id}{'secret'} ne '')) {
        !           957:                 if ($context eq 'deeplink') {
        !           958:                     if (ref($lti{$id}) eq 'HASH') {
        !           959:                         if (!$lti{$id}{'requser'}) {
        !           960:                             push(@{$lti_by_key{$key}},$id);
        !           961:                         }
        !           962:                     }
        !           963:                 } else {
        !           964:                     push(@{$lti_by_key{$key}},$id);
        !           965:                 }
        !           966:             }
        !           967:         }
        !           968:     }
        !           969:     return if (!keys(%lti_by_key));
        !           970: 
        !           971:     if (ref($lti_by_key{$consumer_key}) eq 'ARRAY') {
        !           972:         foreach my $id (@{$lti_by_key{$consumer_key}}) {
        !           973:             my $secret = $ltienc{$id}{'secret'};
        !           974:             my $request = Net::OAuth->request('request token')->from_hash($params,
        !           975:                                               request_url => $url,
        !           976:                                               request_method => $method,
        !           977:                                               consumer_secret => $secret,);
        !           978:             if ($request->verify()) {
        !           979:                 $itemid = $id;
        !           980:                 last;
        !           981:             }
        !           982:         }
        !           983:     }
        !           984:     return $itemid;
        !           985: }
        !           986: 
1.1       droeschl  987: 1;
                    988: 
                    989: __END__
                    990: 
                    991: =head1 NAME
                    992: 
                    993: LONCAPA::Lond.pm
                    994: 
                    995: =head1 SYNOPSIS
                    996: 
                    997: #TODO
                    998: 
                    999: =head1 DESCRIPTION
                   1000: 
                   1001: #TODO
                   1002: 
                   1003: =head1 METHODS
                   1004: 
                   1005: =over 4
                   1006: 
1.2       droeschl 1007: =item dump_with_regexp( $tail, $client )
1.1       droeschl 1008: 
                   1009: Dump a profile database with an optional regular expression to match against
                   1010: the keys.  In this dump, no effort is made to separate symb from version
                   1011: information. Presumably the databases that are dumped by this command are of a
                   1012: different structure.  Need to look at this and improve the documentation of
                   1013: both this and the currentdump handler.
                   1014: 
                   1015: $tail a colon separated list containing
                   1016: 
                   1017: =over 
                   1018: 
                   1019: =item domain
                   1020: 
                   1021: =item user 
                   1022: 
                   1023: identifying the user.
                   1024: 
                   1025: =item namespace    
                   1026: 
                   1027: identifying the database.
                   1028: 
                   1029: =item regexp     
                   1030: 
                   1031: optional regular expression that is matched against database keywords to do
                   1032: selective dumps.
                   1033: 
                   1034: =item range       
                   1035: 
                   1036: optional range of entries e.g., 10-20 would return the 10th to 19th items, etc.  
                   1037: 
                   1038: =back
                   1039: 
                   1040: $client is the channel open on the client.
                   1041: 
                   1042: Returns: 1 (Continue processing).
                   1043: 
                   1044: Side effects: response is written to $client.  
                   1045: 
1.5       bisitz   1046: =item dump_course_id_handler
1.4       droeschl 1047: 
                   1048: #TODO copy from lond
                   1049: 
                   1050: =item dump_profile_database
                   1051: 
                   1052: #TODO copy from lond  
1.2       droeschl 1053: 
                   1054: =item releasereqd_check( $cnum, $cdom, $key, $value, $major, $minor, 
                   1055:         $homecourses, $ids )
                   1056: 
                   1057: releasereqd_check() will determine if a LON-CAPA version (defined in the
                   1058: $major,$minor args passed) is not too old to allow use of a role in a 
                   1059: course ($cnum,$cdom args passed), if at least one of the following applies: 
                   1060: (a) the course is a Community, (b) the course's home server is *not* the
                   1061: current server, or (c) cached course information is not stale. 
                   1062: 
                   1063: For the case where none of these apply, the course is added to the 
                   1064: $homecourse hash ref (keys = courseIDs, values = array of a hash of roles).
                   1065: The $homecourse hash ref is for courses for which the current server is the 
                   1066: home server.  LON-CAPA version requirements are checked elsewhere for the
                   1067: items in $homecourse.
                   1068: 
                   1069: 
                   1070: =item check_homecourses( $homecourses, $regexp, $count, $range, $start, $end, 
                   1071:         $major, $minor )
                   1072: 
                   1073: check_homecourses() will retrieve course information for those courses which
                   1074: are keys of the $homecourses hash ref (first arg). The nohist_courseids.db 
                   1075: GDBM file is tied and course information for each course retrieved. Last   
                   1076: visit (lasttime key) is also retrieved for each, and cached values updated  
                   1077: for any courses last visited less than 24 hours ago. Cached values are also
                   1078: updated for any courses included in the $homecourses hash ref.
                   1079: 
                   1080: The reason for the 24 hours constraint is that the cron entry in 
                   1081: /etc/cron.d/loncapa for /home/httpd/perl/refresh_courseids_db.pl causes 
                   1082: cached course information to be updated nightly for courses with activity
                   1083: within the past 24 hours.
                   1084: 
                   1085: Role information for the user (included in a ref to an array of hashes as the
                   1086: value for each key in $homecourses) is appended to the result returned by the
                   1087: routine, which will in turn be appended to the string returned to the client
                   1088: hosting the user's session.
                   1089: 
                   1090: 
                   1091: =item useable_role( $reqdmajor, $reqdminor, $major, $minor )
                   1092: 
                   1093: useable_role() will compare the LON-CAPA version required by a course with 
                   1094: the version available on the client server.  If the client server's version
                   1095: is compatible, 1 will be returned.
                   1096: 
                   1097: 
1.3       droeschl 1098: =item get_courseinfo_hash( $cnum, $cdom, $home )
                   1099: 
                   1100: get_courseinfo_hash() is used to retrieve course information from the db
                   1101: file: nohist_courseids.db for a course for which the current server is *not*
                   1102: the home server.
                   1103: 
                   1104: A hash of a hash will be retrieved. The outer hash contains a single key --
                   1105: courseID -- for the course for which the data are being requested.
                   1106: The contents of the inner hash, for that single item in the outer hash
                   1107: are returned (and cached in memcache for 10 minutes).
                   1108: 
1.8.2.2   raeburn  1109: =item get_dom ( $userinput )
1.3       droeschl 1110: 
1.8.2.2   raeburn  1111: get_dom() will retrieve domain configuration information from a GDBM file
                   1112: in /home/httpd/lonUsers/$dom on the primary library server in a domain.
                   1113: The single argument passed is the string: $cmd:$udom:$namespace:$what
                   1114: where $cmd is the command historically passed to lond - i.e., getdom
                   1115: or egetdom, $udom is the domain, $namespace is the name of the GDBM file
                   1116: (encconfig or configuration), and $what is a string containing names of
                   1117: items to retrieve from the db file (each item name is escaped and separated
                   1118: from the next item name with an ampersand). The return value is either:
                   1119: error: followed by an error message, or a string containing the value (escaped)
                   1120: for each item, again separated from the next item with an ampersand.
1.3       droeschl 1121: 
1.1       droeschl 1122: =back
                   1123: 
                   1124: =head1 BUGS
                   1125: 
                   1126: No known bugs at this time.
                   1127: 
                   1128: =head1 SEE ALSO
                   1129: 
                   1130: L<Apache::lonnet>, L<lond>
                   1131: 
                   1132: =cut  

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