--- loncom/lonnet/perl/lonnet.pm 2022/10/18 19:07:04 1.1495
+++ loncom/lonnet/perl/lonnet.pm 2023/06/02 01:20:29 1.1511
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1495 2022/10/18 19:07:04 raeburn Exp $
+# $Id: lonnet.pm,v 1.1511 2023/06/02 01:20:29 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -415,6 +415,63 @@ sub remote_devalidate_cache {
return $response;
}
+sub sign_lti {
+ my ($cdom,$cnum,$crsdef,$type,$context,$url,$ltinum,$keynum,$paramsref,$inforef) = @_;
+ my $chome;
+ if (&domain($cdom) ne '') {
+ if ($crsdef) {
+ $chome = &homeserver($cnum,$cdom);
+ } else {
+ $chome = &domain($cdom,'primary');
+ }
+ }
+ if ($cdom && $chome && ($chome ne 'no_host')) {
+ if ((ref($paramsref) eq 'HASH') &&
+ (ref($inforef) eq 'HASH')) {
+ my $rep;
+ if (grep { $_ eq $chome } ¤t_machine_ids()) {
+ # domain information is hosted on this machine
+ $rep =
+ &LONCAPA::Lond::sign_lti_payload($cdom,$cnum,$crsdef,$type,
+ $context,$url,$ltinum,$keynum,
+ $perlvar{'lonVersion'},
+ $paramsref,$inforef);
+ if (ref($rep) eq 'HASH') {
+ return ('ok',$rep);
+ }
+ } else {
+ my ($escurl,$params,$info);
+ $escurl = &escape($url);
+ if (ref($paramsref) eq 'HASH') {
+ $params = &freeze_escape($paramsref);
+ }
+ if (ref($inforef) eq 'HASH') {
+ $info = &freeze_escape($inforef);
+ }
+ $rep=&reply("encrypt:signlti:$cdom:$cnum:$crsdef:$type:$context:$escurl:$ltinum:$keynum:$params:$info",$chome);
+ }
+ if (($rep eq '') || ($rep =~ /^con_lost|error|no_such_host|unknown_cmd/i)) {
+ return ();
+ } elsif (($inforef->{'respfmt'} eq 'to_post_body') ||
+ ($inforef->{'respfmt'} eq 'to_authorization_header')) {
+ return ('ok',$rep);
+ } else {
+ my %returnhash;
+ foreach my $item (split(/\&/,$rep)) {
+ my ($name,$value)=split(/\=/,$item);
+ $returnhash{&unescape($name)}=&thaw_unescape($value);
+ }
+ return('ok',\%returnhash);
+ }
+ } else {
+ return ();
+ }
+ } else {
+ return ();
+ &logthis("sign_lti failed - no homeserver and/or domain ($cdom) ($chome)");
+ }
+}
+
# -------------------------------------------------- Non-critical communication
sub subreply {
my ($cmd,$server)=@_;
@@ -2698,7 +2755,9 @@ sub get_domain_defaults {
'coursedefaults','usersessions',
'requestauthor','selfenrollment',
'coursecategories','ssl','autoenroll',
- 'trust','helpsettings','wafproxy','ltisec'],$domain);
+ 'trust','helpsettings','wafproxy',
+ 'ltisec','toolsec','domexttool',
+ 'exttool'],$domain);
my @coursetypes = ('official','unofficial','community','textbook','placement');
if (ref($domconfig{'defaults'}) eq 'HASH') {
$domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'};
@@ -2770,6 +2829,16 @@ sub get_domain_defaults {
$domconfig{'coursedefaults'}{'postsubmit'}{'timeout'}{$type};
}
}
+ if (ref($domconfig{'coursedefaults'}{'domexttool'}) eq 'HASH') {
+ $domdefaults{$type.'domexttool'} = $domconfig{'coursedefaults'}{'domexttool'}{$type};
+ } else {
+ $domdefaults{$type.'domexttool'} = 1;
+ }
+ if (ref($domconfig{'coursedefaults'}{'exttool'}) eq 'HASH') {
+ $domdefaults{$type.'exttool'} = $domconfig{'coursedefaults'}{'exttool'}{$type};
+ } else {
+ $domdefaults{$type.'exttool'} = 0;
+ }
}
if (ref($domconfig{'coursedefaults'}{'canclone'}) eq 'HASH') {
if (ref($domconfig{'coursedefaults'}{'canclone'}{'instcode'}) eq 'ARRAY') {
@@ -2884,7 +2953,18 @@ sub get_domain_defaults {
}
if (ref($domconfig{'ltisec'}{'private'}) eq 'HASH') {
if (ref($domconfig{'ltisec'}{'private'}{'keys'}) eq 'ARRAY') {
- $domdefaults{'privhosts'} = $domconfig{'ltisec'}{'private'}{'keys'};
+ $domdefaults{'ltiprivhosts'} = $domconfig{'ltisec'}{'private'}{'keys'};
+ }
+ }
+ }
+ if (ref($domconfig{'toolsec'}) eq 'HASH') {
+ if (ref($domconfig{'toolsec'}{'encrypt'}) eq 'HASH') {
+ $domdefaults{'toolenc_crs'} = $domconfig{'toolsec'}{'encrypt'}{'crs'};
+ $domdefaults{'toolenc_dom'} = $domconfig{'toolsec'}{'encrypt'}{'dom'};
+ }
+ if (ref($domconfig{'toolsec'}{'private'}) eq 'HASH') {
+ if (ref($domconfig{'toolsec'}{'private'}{'keys'}) eq 'ARRAY') {
+ $domdefaults{'toolprivhosts'} = $domconfig{'toolsec'}{'private'}{'keys'};
}
}
}
@@ -2924,6 +3004,7 @@ sub get_dom_instcats {
if (&auto_instcode_format($caller,$dom,\%coursecodes,\%codes,
\@codetitles,\%cat_titles,\%cat_order) eq 'ok') {
$instcats = {
+ totcodes => $totcodes,
codes => \%codes,
codetitles => \@codetitles,
cat_titles => \%cat_titles,
@@ -3856,10 +3937,15 @@ sub can_edit_resource {
return;
}
} elsif (!$crsedit) {
+ if ($env{'request.role'} =~ m{^st\./$cdom/$cnum}) {
#
# No edit allowed where CC has switched to student role.
#
- return;
+ return;
+ } elsif (($resurl !~ m{^/res/$match_domain/$match_username/}) ||
+ ($resurl =~ m{^/res/lib/templates/})) {
+ return;
+ }
}
}
}
@@ -3885,7 +3971,7 @@ sub can_edit_resource {
$forceedit = 1;
}
$cfile = $resurl;
- } elsif (($resurl ne '') && (&is_on_map($resurl))) {
+ } elsif (($resurl ne '') && (&is_on_map($resurl))) {
if ($resurl =~ m{^/adm/$match_domain/$match_username/\d+/smppg|bulletinboard$}) {
$incourse = 1;
if ($env{'form.forceedit'}) {
@@ -4268,7 +4354,7 @@ sub resizeImage {
# input: $formname - the contents of the file are in $env{"form.$formname"}
# the desired filename is in $env{"form.$formname.filename"}
# $context - possible values: coursedoc, existingfile, overwrite,
-# canceloverwrite, scantron or ''.
+# canceloverwrite, scantron, toollogo or ''.
# if 'coursedoc': upload to the current course
# if 'existingfile': write file to tmp/overwrites directory
# if 'canceloverwrite': delete file written to tmp/overwrites directory
@@ -4280,8 +4366,8 @@ sub resizeImage {
# Section => 4, CODE => 5, FirstQuestion => 9 }).
# $allfiles - reference to hash for embedded objects
# $codebase - reference to hash for codebase of java objects
-# $desuname - username for permanent storage of uploaded file
-# $dsetudom - domain for permanaent storage of uploaded file
+# $destuname - username for permanent storage of uploaded file
+# $destudom - domain for permanaent storage of uploaded file
# $thumbwidth - width (pixels) of thumbnail to make for uploaded image
# $thumbheight - height (pixels) of thumbnail to make for uploaded image
# $resizewidth - width (pixels) to which to resize uploaded image
@@ -4491,11 +4577,24 @@ sub finishuserfileupload {
if (($thumbwidth =~ /^\d+$/) && ($thumbheight =~ /^\d+$/)) {
my $input = $filepath.'/'.$file;
my $output = $filepath.'/'.'tn-'.$file;
+ my $makethumb;
my $thumbsize = $thumbwidth.'x'.$thumbheight;
- my @args = ('convert','-sample',$thumbsize,$input,$output);
- system({$args[0]} @args);
- if (-e $filepath.'/'.'tn-'.$file) {
- $fetchthumb = 1;
+ if ($context eq 'toollogo') {
+ my ($fullwidth,$fullheight) = &check_dimensions($input);
+ if ($fullwidth ne '' && $fullheight ne '') {
+ if ($fullwidth > $thumbwidth && $fullheight > $thumbheight) {
+ $makethumb = 1;
+ }
+ }
+ } else {
+ $makethumb = 1;
+ }
+ if ($makethumb) {
+ my @args = ('convert','-sample',$thumbsize,$input,$output);
+ system({$args[0]} @args);
+ if (-e $filepath.'/'.'tn-'.$file) {
+ $fetchthumb = 1;
+ }
}
}
@@ -4727,6 +4826,30 @@ sub embedded_dependency {
return;
}
+sub check_dimensions {
+ my ($inputfile) = @_;
+ my ($fullwidth,$fullheight);
+ if (($inputfile =~ m|^[/\w.\-]+$|) && (-e $inputfile)) {
+ my $mm = new File::MMagic;
+ my $mime_type = $mm->checktype_filename($inputfile);
+ if ($mime_type =~ m{^image/}) {
+ if (open(PIPE,"identify $inputfile 2>&1 |")) {
+ my $imageinfo = <PIPE>;
+ if (!close(PIPE)) {
+ &Apache::lonnet::logthis("Failed to close PIPE opened to retrieve image information for $inputfile");
+ }
+ chomp($imageinfo);
+ my ($fullsize) =
+ ($imageinfo =~ /^\Q$inputfile\E\s+\w+\s+(\d+x\d+)/);
+ if ($fullsize) {
+ ($fullwidth,$fullheight) = split(/x/,$fullsize);
+ }
+ }
+ }
+ }
+ return ($fullwidth,$fullheight);
+}
+
sub bubblesheet_converter {
my ($cdom,$fullpath,$config,$format) = @_;
if ((&domain($cdom) ne '') &&
@@ -5090,7 +5213,7 @@ sub flushcourselogs {
# Typo in rev. 1.458 (2003/12/09)??
# These should likely by $env{'course.'.$cid.'.domain'} and $env{'course.'.$cid.'.num'}
#
-# While these ramain as $env{'request.'.$cid.'.domain'} and $env{'request.'.$cid.'.num'}
+# While these remain as $env{'request.'.$cid.'.domain'} and $env{'request.'.$cid.'.num'}
# $dom and $name will always be null, so the &inc() call will default to storing this data
# in a nohist_accesscount.db file for the user rather than the course.
#
@@ -7954,6 +8077,17 @@ sub is_portfolio_file {
return;
}
+sub is_coursetool_logo {
+ my ($uri) = @_;
+ if ($env{'request.course.id'}) {
+ my $courseurl = &courseid_to_courseurl($env{'request.course.id'});
+ if ($uri =~ m{^/*uploaded\Q$courseurl\E/toollogo/\d+/[^/]+$}) {
+ return 1;
+ }
+ }
+ return;
+}
+
sub usertools_access {
my ($uname,$udom,$tool,$action,$context,$userenvref,$domdefref,$is_advref)=@_;
my ($access,%tools);
@@ -8582,6 +8716,12 @@ sub allowed {
if ($env{'request.course.id'}) {
+ if ($priv eq 'bre') {
+ if (&is_coursetool_logo($uri)) {
+ return 'F';
+ }
+ }
+
# If this is modifying password (internal auth) domains must match for user and user's role.
if ($priv eq 'mip') {
@@ -8902,13 +9042,8 @@ sub constructaccess {
if (exists($env{'user.priv.au./'.$ownerdomain.'/./'})) {
return ($ownername,$ownerdomain,$ownerhome);
}
- } else {
-# Co-author for this?
- if (exists($env{'user.priv.ca./'.$ownerdomain.'/'.$ownername.'./'}) ||
- exists($env{'user.priv.aa./'.$ownerdomain.'/'.$ownername.'./'}) ) {
- $ownerhome = &homeserver($ownername,$ownerdomain);
- return ($ownername,$ownerdomain,$ownerhome);
- }
+ } elsif (&is_course($ownerdomain,$ownername)) {
+# Course Authoring Space?
if ($env{'request.course.id'}) {
if (($ownername eq $env{'course.'.$env{'request.course.id'}.'.num'}) &&
($ownerdomain eq $env{'course.'.$env{'request.course.id'}.'.domain'})) {
@@ -8918,6 +9053,14 @@ sub constructaccess {
}
}
}
+ return '';
+ } else {
+# Co-author for this?
+ if (exists($env{'user.priv.ca./'.$ownerdomain.'/'.$ownername.'./'}) ||
+ exists($env{'user.priv.aa./'.$ownerdomain.'/'.$ownername.'./'}) ) {
+ $ownerhome = &homeserver($ownername,$ownerdomain);
+ return ($ownername,$ownerdomain,$ownerhome);
+ }
}
# We don't have any access right now. If we are not possibly going to do anything about this,
@@ -10333,7 +10476,7 @@ sub assignrole {
if ($role =~ /^cr\//) {
my $cwosec=$url;
$cwosec=~s/^\/($match_domain)\/($match_courseid)\/.*/$1\/$2/;
- unless (&allowed('ccr',$cwosec)) {
+ if ((!&allowed('ccr',$cwosec)) && (!&allowed('ccr',$udom))) {
my $refused = 1;
if ($context eq 'requestcourses') {
if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '')) {
@@ -12025,14 +12168,20 @@ sub stat_file {
# or corresponding Published Resource Space, and populate the hash ref:
# $dirhashref with URLs of all directories, and if $filehashref hash
# ref arg is provided, the URLs of any files, excluding versioned, .meta,
-# or .rights files in resource space, and .meta, .save, .log, and .bak
-# files in Authoring Space.
+# or .rights files in resource space, and .meta, .save, .log, .bak and
+# .rights files in Authoring Space.
#
# Inputs:
#
# $is_home - true if current server is home server for user's space
-# $context - either: priv, or res respectively for Authoring or Resource Space.
-# $docroot - Document root (i.e., /home/httpd/html
+# $recurse - if true will also traverse subdirectories recursively
+# $include - reference to hash containing allowed file extensions. If provided,
+# files which do not have a matching extension will be ignored.
+# $exclude - reference to hash containing excluded file extensions. If provided,
+# files which have a matching extension will be ignored.
+# $nonemptydir - if true, will only populate $fileshashref hash entry for a particular
+# directory with first file found (with acceptable extension).
+# $addtopdir - if true, set $dirhashref->{'/'} = 1
# $toppath - Top level directory (i.e., /res/$dom/$uname or /priv/$dom/$uname
# $relpath - Current path (relative to top level).
# $dirhashref - reference to hash to populate with URLs of directories (Required)
@@ -12049,39 +12198,61 @@ sub stat_file {
#
sub recursedirs {
- my ($is_home,$context,$docroot,$toppath,$relpath,$dirhashref,$filehashref) = @_;
+ my ($is_home,$recurse,$include,$exclude,$nonemptydir,$addtopdir,$toppath,$relpath,$dirhashref,$filehashref) = @_;
return unless (ref($dirhashref) eq 'HASH');
+ my $docroot = $perlvar{'lonDocRoot'};
my $currpath = $docroot.$toppath;
- if ($relpath) {
+ if ($relpath ne '') {
$currpath .= "/$relpath";
}
- my $savefile;
+ my ($savefile,$checkinc,$checkexc);
if (ref($filehashref)) {
$savefile = 1;
}
+ if (ref($include) eq 'HASH') {
+ $checkinc = 1;
+ }
+ if (ref($exclude) eq 'HASH') {
+ $checkexc = 1;
+ }
if ($is_home) {
- if (opendir(my $dirh,$currpath)) {
+ if ((-e $currpath) && (opendir(my $dirh,$currpath))) {
+ my $filecount = 0;
foreach my $item (sort { lc($a) cmp lc($b) } grep(!/^\.+$/,readdir($dirh))) {
next if ($item eq '');
if (-d "$currpath/$item") {
my $newpath;
- if ($relpath) {
+ if ($relpath ne '') {
$newpath = "$relpath/$item";
} else {
$newpath = $item;
}
$dirhashref->{&Apache::lonlocal::js_escape($newpath)} = 1;
- &recursedirs($is_home,$context,$docroot,$toppath,$newpath,$dirhashref,$filehashref);
- } elsif ($savefile) {
- if ($context eq 'priv') {
- unless ($item =~ /\.(meta|save|log|bak|DS_Store)$/) {
- $filehashref->{&Apache::lonlocal::js_escape($relpath)}{$item} = 1;
+ if ($recurse) {
+ &recursedirs($is_home,$recurse,$include,$exclude,$nonemptydir,$addtopdir,$toppath,$newpath,$dirhashref,$filehashref);
+ }
+ } elsif (($savefile) || ($relpath eq '')) {
+ next if ($nonemptydir && $filecount);
+ if ($checkinc || $checkexc) {
+ my ($extension) = ($item =~ /\.(\w+)$/);
+ if ($checkinc) {
+ next unless ($extension && $include->{$extension});
}
- } else {
- unless (($item =~ /\.meta$/) || ($item =~ /\.\d+\.\w+$/) || ($item =~ /\.rights$/)) {
+ if ($checkexc) {
+ next if ($extension && $exclude->{$extension});
+ }
+ }
+ if (($relpath eq '') && (!exists($dirhashref->{'/'}))) {
+ $dirhashref->{'/'} = 1;
+ }
+ if ($savefile) {
+ if ($relpath eq '') {
+ $filehashref->{'/'}{$item} = 1;
+ } else {
$filehashref->{&Apache::lonlocal::js_escape($relpath)}{$item} = 1;
}
}
+ $filecount ++;
}
}
closedir($dirh);
@@ -12092,6 +12263,7 @@ sub recursedirs {
my @dir_lines;
my $dirptr=16384;
if (ref($dirlistref) eq 'ARRAY') {
+ my $filecount = 0;
foreach my $dir_line (sort
{
my ($afile)=split('&',$a,2);
@@ -12107,28 +12279,57 @@ sub recursedirs {
if ($relpath) {
$newpath = "$relpath/$item";
} else {
- $relpath = '/';
$newpath = $item;
}
$dirhashref->{&Apache::lonlocal::js_escape($newpath)} = 1;
- &recursedirs($is_home,$context,$docroot,$toppath,$newpath,$dirhashref,$filehashref);
- } elsif ($savefile) {
- if ($context eq 'priv') {
- unless ($item =~ /\.(meta|save|log|bak|DS_Store)$/) {
- $filehashref->{$relpath}{$item} = 1;
+ if ($recurse) {
+ &recursedirs($is_home,$recurse,$include,$exclude,$nonemptydir,$addtopdir,$toppath,$newpath,$dirhashref,$filehashref);
+ }
+ } elsif (($savefile) || ($relpath eq '')) {
+ next if ($nonemptydir && $filecount);
+ if ($checkinc || $checkexc) {
+ my $extension;
+ if ($checkinc) {
+ next unless ($extension && $include->{$extension});
}
- } else {
- unless (($item =~ /\.meta$/) || ($item =~ /\.\d+\.\w+$/)) {
- $filehashref->{$relpath}{$item} = 1;
+ if ($checkexc) {
+ next if ($extension && $exclude->{$extension});
}
}
+ if (($relpath eq '') && (!exists($dirhashref->{'/'}))) {
+ $dirhashref->{'/'} = 1;
+ }
+ if ($savefile) {
+ if ($relpath eq '') {
+ $filehashref->{'/'}{$item} = 1;
+ } else {
+ $filehashref->{&Apache::lonlocal::js_escape($relpath)}{$item} = 1;
+ }
+ }
+ $filecount ++;
}
}
}
}
+ if ($addtopdir) {
+ if (($relpath eq '') && (!exists($dirhashref->{'/'}))) {
+ $dirhashref->{'/'} = 1;
+ }
+ }
return;
}
+sub priv_exclude {
+ return {
+ meta => 1,
+ save => 1,
+ log => 1,
+ bak => 1,
+ rights => 1,
+ DS_Store => 1,
+ };
+}
+
# -------------------------------------------------------- Value of a Condition
# gets the value of a specific preevaluated condition
@@ -12352,13 +12553,11 @@ sub get_domain_lti {
} else {
return %lti;
}
-
if ($context eq 'linkprot') {
$cachename = $context;
} else {
$cachename = $name;
}
-
my ($result,$cached)=&is_cached_new($cachename,$cdom);
if (defined($cached)) {
if (ref($result) eq 'HASH') {
@@ -12374,18 +12573,6 @@ sub get_domain_lti {
} else {
%lti = %{$domconfig{$name}};
}
- if (($context eq 'consumer') && (keys(%lti))) {
- my %encdomconfig = &get_dom('encconfig',[$name],$cdom,undef,1);
- if (ref($encdomconfig{$name}) eq 'HASH') {
- foreach my $id (keys(%lti)) {
- if (ref($encdomconfig{$name}{$id}) eq 'HASH') {
- foreach my $item ('key','secret') {
- $lti{$id}{$item} = $encdomconfig{$name}{$id}{$item};
- }
- }
- }
- }
- }
}
my $cachetime = 24*60*60;
&do_cache_new($cachename,$cdom,\%lti,$cachetime);
@@ -12394,20 +12581,29 @@ sub get_domain_lti {
}
sub get_course_lti {
- my ($cnum,$cdom) = @_;
+ my ($cnum,$cdom,$context) = @_;
+ my ($name,$cachename,%lti);
+ if ($context eq 'consumer') {
+ $name = 'ltitools';
+ $cachename = 'courseltitools';
+ } elsif ($context eq 'provider') {
+ $name = 'lti';
+ $cachename = 'courselti';
+ } else {
+ return %lti;
+ }
my $hashid=$cdom.'_'.$cnum;
- my %courselti;
- my ($result,$cached)=&is_cached_new('courselti',$hashid);
+ my ($result,$cached)=&is_cached_new($cachename,$hashid);
if (defined($cached)) {
if (ref($result) eq 'HASH') {
- %courselti = %{$result};
+ %lti = %{$result};
}
} else {
- %courselti = &dump('lti',$cdom,$cnum,undef,undef,undef,1);
+ %lti = &dump($name,$cdom,$cnum,undef,undef,undef,1);
my $cachetime = 24*60*60;
- &do_cache_new('courselti',$hashid,\%courselti,$cachetime);
+ &do_cache_new($cachename,$hashid,\%lti,$cachetime);
}
- return %courselti;
+ return %lti;
}
sub courselti_itemid {
@@ -12457,25 +12653,64 @@ sub domainlti_itemid {
return $itemid;
}
-sub get_numsuppfiles {
- my ($cnum,$cdom,$ignorecache)=@_;
+sub count_supptools {
+ my ($cnum,$cdom,$ignorecache,$reload)=@_;
my $hashid=$cnum.':'.$cdom;
- my ($suppcount,$cached);
+ my ($numexttools,$cached);
unless ($ignorecache) {
- ($suppcount,$cached) = &is_cached_new('suppcount',$hashid);
+ ($numexttools,$cached) = &is_cached_new('supptools',$hashid);
}
unless (defined($cached)) {
my $chome=&homeserver($cnum,$cdom);
+ $numexttools = 0;
unless ($chome eq 'no_host') {
- ($suppcount,my $supptools,my $errors) = (0,0,0);
- my $suppmap = 'supplemental.sequence';
- ($suppcount,$supptools,$errors) =
- &Apache::loncommon::recurse_supplemental($cnum,$cdom,$suppmap,$suppcount,
- $supptools,$errors);
+ my ($supplemental) = &Apache::loncommon::get_supplemental($cnum,$cdom,$reload);
+ if (ref($supplemental) eq 'HASH') {
+ if ((ref($supplemental->{'ids'}) eq 'HASH') && (ref($supplemental->{'hidden'}) eq 'HASH')) {
+ foreach my $key (keys(%{$supplemental->{'ids'}})) {
+ if ($key =~ m{^/adm/$cdom/$cnum/\d+/ext\.tool$}) {
+ $numexttools ++;
+ }
+ }
+ }
+ }
}
- &do_cache_new('suppcount',$hashid,$suppcount,600);
+ &do_cache_new('supptools',$hashid,$numexttools,600);
}
- return $suppcount;
+ return $numexttools;
+}
+
+sub has_unhidden_suppfiles {
+ my ($cnum,$cdom,$ignorecache,$possdel)=@_;
+ my $hashid=$cnum.':'.$cdom;
+ my ($showsupp,$cached);
+ unless ($ignorecache) {
+ ($showsupp,$cached) = &is_cached_new('showsupp',$hashid);
+ }
+ unless (defined($cached)) {
+ my $chome=&homeserver($cnum,$cdom);
+ unless ($chome eq 'no_host') {
+ my ($supplemental) = &Apache::loncommon::get_supplemental($cnum,$cdom,$ignorecache,$possdel);
+ if (ref($supplemental) eq 'HASH') {
+ if ((ref($supplemental->{'ids'}) eq 'HASH') && (ref($supplemental->{'hidden'}) eq 'HASH')) {
+ foreach my $key (keys(%{$supplemental->{'ids'}})) {
+ next if ($key =~ /\.sequence$/);
+ if (ref($supplemental->{'ids'}->{$key}) eq 'ARRAY') {
+ foreach my $id (@{$supplemental->{'ids'}->{$key}}) {
+ unless ($supplemental->{'hidden'}->{$id}) {
+ $showsupp = 1;
+ last;
+ }
+ }
+ }
+ last if ($showsupp);
+ }
+ }
+ }
+ }
+ &do_cache_new('showsupp',$hashid,$showsupp,600);
+ }
+ return $showsupp;
}
#
@@ -13603,11 +13838,68 @@ sub get_coursechange {
}
sub devalidate_coursechange_cache {
- my ($cnum,$cdom)=@_;
- my $hashid=$cnum.':'.$cdom;
+ my ($cdom,$cnum)=@_;
+ my $hashid=$cdom.'_'.$cnum;
&devalidate_cache_new('crschange',$hashid);
}
+sub get_suppchange {
+ my ($cdom,$cnum) = @_;
+ if ($cdom eq '' || $cnum eq '') {
+ return unless ($env{'request.course.id'});
+ $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+ $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+ }
+ my $hashid=$cdom.'_'.$cnum;
+ my ($change,$cached)=&is_cached_new('suppchange',$hashid);
+ if ((defined($cached)) && ($change ne '')) {
+ return $change;
+ } else {
+ my %crshash = &get('environment',['internal.supplementalchange'],$cdom,$cnum);
+ if ($crshash{'internal.supplementalchange'} eq '') {
+ $change = $env{'course.'.$cdom.'_'.$cnum.'.internal.created'};
+ if ($change eq '') {
+ %crshash = &get('environment',['internal.created'],$cdom,$cnum);
+ $change = $crshash{'internal.created'};
+ }
+ } else {
+ $change = $crshash{'internal.supplementalchange'};
+ }
+ my $cachetime = 600;
+ &do_cache_new('suppchange',$hashid,$change,$cachetime);
+ }
+ return $change;
+}
+
+sub devalidate_suppchange_cache {
+ my ($cdom,$cnum)=@_;
+ my $hashid=$cdom.'_'.$cnum;
+ &devalidate_cache_new('suppchange',$hashid);
+}
+
+sub update_supp_caches {
+ my ($cdom,$cnum) = @_;
+ my %servers = &internet_dom_servers($cdom);
+ my @ids=¤t_machine_ids();
+ foreach my $server (keys(%servers)) {
+ next if (grep(/^\Q$server\E$/,@ids));
+ my $hashid=$cnum.':'.$cdom;
+ my $cachekey = &escape('showsupp').':'.&escape($hashid);
+ &remote_devalidate_cache($server,[$cachekey]);
+ }
+ &has_unhidden_suppfiles($cnum,$cdom,1,1);
+ &count_supptools($cnum,$cdom,1);
+ my $now = time;
+ if ($env{'request.course.id'} eq $cdom.'_'.$cnum) {
+ &Apache::lonnet::appenv({'request.course.suppupdated' => $now});
+ }
+ &put('environment',{'internal.supplementalchange' => $now},
+ $cdom,$cnum);
+ &Apache::lonnet::appenv(
+ {'course.'.$cdom.'_'.$cnum.'.internal.supplementalchange' => $now});
+ &do_cache_new('suppchange',$cdom.'_'.$cnum,$now,600);
+}
+
# ------------------------------------------------- Update symbolic store links
sub symblist {
@@ -16464,10 +16756,6 @@ 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