--- loncom/lonnet/perl/lonnet.pm 2013/08/04 03:00:12 1.1172.2.30 +++ loncom/lonnet/perl/lonnet.pm 2013/08/13 12:48:47 1.1172.2.32 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1172.2.30 2013/08/04 03:00:12 raeburn Exp $ +# $Id: lonnet.pm,v 1.1172.2.32 2013/08/13 12:48:47 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -2846,6 +2846,13 @@ sub can_edit_resource { $cfile =~ s{^http://}{}; $cfile = '/adm/wrapper/ext/'.$cfile; } + } elsif ($resurl =~ m{^/?adm/viewclasslist$}) { + if ($env{'form.forceedit'}) { + $forceview = 1; + } else { + $forceedit = 1; + } + $cfile = ($resurl =~ m{^/} ? $resurl : "/$resurl"); } } if ($uploaded || $incourse) { @@ -4377,6 +4384,92 @@ sub set_first_access { return 'already_set'; } } + +sub checkout { + my ($symb,$tuname,$tudom,$tcrsid)=@_; + my $now=time; + my $lonhost=$perlvar{'lonHostID'}; + my $infostr=&escape( + 'CHECKOUTTOKEN&'. + $tuname.'&'. + $tudom.'&'. + $tcrsid.'&'. + $symb.'&'. + $now.'&'.$ENV{'REMOTE_ADDR'}); + my $token=&reply('tmpput:'.$infostr,$lonhost); + if ($token=~/^error\:/) { + &logthis("WARNING: ". + "Checkout tmpput failed ".$tudom.' - '.$tuname.' - '.$symb. + ""); + return ''; + } + + $token=~s/^(\d+)\_.*\_(\d+)$/$1\*$2\*$lonhost/; + $token=~tr/a-z/A-Z/; + + my %infohash=('resource.0.outtoken' => $token, + 'resource.0.checkouttime' => $now, + 'resource.0.outremote' => $ENV{'REMOTE_ADDR'}); + + unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') { + return ''; + } else { + &logthis("WARNING: ". + "Checkout cstore failed ".$tudom.' - '.$tuname.' - '.$symb. + ""); + } + + if (&log($tudom,$tuname,&homeserver($tuname,$tudom), + &escape('Checkout '.$infostr.' - '. + $token)) ne 'ok') { + return ''; + } else { + &logthis("WARNING: ". + "Checkout log failed ".$tudom.' - '.$tuname.' - '.$symb. + ""); + } + return $token; +} + +# ------------------------------------------------------------ Check in an item + +sub checkin { + my $token=shift; + my $now=time; + my ($ta,$tb,$lonhost)=split(/\*/,$token); + $lonhost=~tr/A-Z/a-z/; + my $dtoken=$ta.'_'.&hostname($lonhost).'_'.$tb; + $dtoken=~s/\W/\_/g; + my ($dummy,$tuname,$tudom,$tcrsid,$symb,$chtim,$rmaddr)= + split(/\&/,&unescape(&reply('tmpget:'.$dtoken,$lonhost))); + + unless (($tuname) && ($tudom)) { + &logthis('Check in '.$token.' ('.$dtoken.') failed'); + return ''; + } + + unless (&allowed('mgr',$tcrsid)) { + &logthis('Check in '.$token.' ('.$dtoken.') unauthorized: '. + $env{'user.name'}.' - '.$env{'user.domain'}); + return ''; + } + + my %infohash=('resource.0.intoken' => $token, + 'resource.0.checkintime' => $now, + 'resource.0.inremote' => $ENV{'REMOTE_ADDR'}); + + unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') { + return ''; + } + + if (&log($tudom,$tuname,&homeserver($tuname,$tudom), + &escape('Checkin - '.$token)) ne 'ok') { + return ''; + } + + return ($symb,$tuname,$tudom,$tcrsid); +} + # --------------------------------------------- Set Expire Date for Spreadsheet sub expirespread { @@ -8478,7 +8571,7 @@ sub modifystudent { $desiredhome,$email,$inststatus); unless ($reply eq 'ok') { return $reply; } # This will cause &modify_student_enrollment to get the uid from the - # students environment + # student's environment $uid = undef if (!$forceid); $reply = &modify_student_enrollment($udom,$uname,$uid,$first,$middle,$last, $gene,$usec,$end,$start,$type,$locktype, @@ -9614,6 +9707,26 @@ sub resdata { return undef; } +sub get_numsuppfiles { + my ($cnum,$cdom,$ignorecache)=@_; + my $hashid=$cnum.':'.$cdom; + my ($suppcount,$cached); + unless ($ignorecache) { + ($suppcount,$cached) = &is_cached_new('suppcount',$hashid); + } + unless (defined($cached)) { + my $chome=&homeserver($cnum,$cdom); + unless ($chome eq 'no_host') { + ($suppcount,my $errors) = (0,0); + my $suppmap = 'supplemental.sequence'; + ($suppcount,$errors) = + &Apache::loncommon::recurse_supplemental($cnum,$cdom,$suppmap,$suppcount,$errors); + } + &do_cache_new('suppcount',$hashid,$suppcount,600); + } + return $suppcount; +} + # # EXT resource caching routines # @@ -12673,8 +12786,8 @@ or when Autoupdate.pl is run by cron in modifystudent modify a student's enrollment and identification information. -The course id is resolved based on the current users environment. -This means the envoking user must be a course coordinator or otherwise +The course id is resolved based on the current user's environment. +This means the invoking user must be a course coordinator or otherwise associated with a course. This call is essentially a wrapper for lonnet::modifyuser and @@ -12734,20 +12847,20 @@ Inputs: modify_student_enrollment -Change a students enrollment status in a class. The environment variable +Change a student's enrollment status in a class. The environment variable 'role.request.course' must be defined for this function to proceed. Inputs: =over 4 -=item $udom, students domain +=item $udom, student's domain -=item $uname, students name +=item $uname, student's name -=item $uid, students user id +=item $uid, student's user id -=item $first, students first name +=item $first, student's first name =item $middle @@ -12829,7 +12942,7 @@ If defined, the supplied username is use resdata($name,$domain,$type,@which) : request for current parameter setting for a specific $type, where $type is either 'course' or 'user', @what should be a list of parameters to ask about. This routine caches -answers for 5 minutes. +answers for 10 minutes. =item * @@ -12838,6 +12951,10 @@ data base, returning a hash that is keye values that are the resource value. I believe that the timestamps and versions are also returned. +get_numsuppfiles($cnum,$cdom) : retrieve number of files in a course's +supplemental content area. This routine caches the number of files for +10 minutes. + =back =head2 Course Modification