version 1.1495, 2022/10/18 19:07:04
|
version 1.1503, 2022/12/31 14:09:00
|
Line 2924 sub get_dom_instcats {
|
Line 2924 sub get_dom_instcats {
|
if (&auto_instcode_format($caller,$dom,\%coursecodes,\%codes, |
if (&auto_instcode_format($caller,$dom,\%coursecodes,\%codes, |
\@codetitles,\%cat_titles,\%cat_order) eq 'ok') { |
\@codetitles,\%cat_titles,\%cat_order) eq 'ok') { |
$instcats = { |
$instcats = { |
|
totcodes => $totcodes, |
codes => \%codes, |
codes => \%codes, |
codetitles => \@codetitles, |
codetitles => \@codetitles, |
cat_titles => \%cat_titles, |
cat_titles => \%cat_titles, |
Line 10333 sub assignrole {
|
Line 10334 sub assignrole {
|
if ($role =~ /^cr\//) { |
if ($role =~ /^cr\//) { |
my $cwosec=$url; |
my $cwosec=$url; |
$cwosec=~s/^\/($match_domain)\/($match_courseid)\/.*/$1\/$2/; |
$cwosec=~s/^\/($match_domain)\/($match_courseid)\/.*/$1\/$2/; |
unless (&allowed('ccr',$cwosec)) { |
if ((!&allowed('ccr',$cwosec)) && (!&allowed('ccr',$udom))) { |
my $refused = 1; |
my $refused = 1; |
if ($context eq 'requestcourses') { |
if ($context eq 'requestcourses') { |
if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '')) { |
if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '')) { |
Line 12025 sub stat_file {
|
Line 12026 sub stat_file {
|
# or corresponding Published Resource Space, and populate the hash ref: |
# or corresponding Published Resource Space, and populate the hash ref: |
# $dirhashref with URLs of all directories, and if $filehashref hash |
# $dirhashref with URLs of all directories, and if $filehashref hash |
# ref arg is provided, the URLs of any files, excluding versioned, .meta, |
# ref arg is provided, the URLs of any files, excluding versioned, .meta, |
# or .rights files in resource space, and .meta, .save, .log, and .bak |
# or .rights files in resource space, and .meta, .save, .log, .bak and |
# files in Authoring Space. |
# .rights files in Authoring Space. |
# |
# |
# Inputs: |
# Inputs: |
# |
# |
# $is_home - true if current server is home server for user's space |
# $is_home - true if current server is home server for user's space |
# $context - either: priv, or res respectively for Authoring or Resource Space. |
# $recurse - if true will also traverse subdirectories recursively |
# $docroot - Document root (i.e., /home/httpd/html |
# $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). |
# $toppath - Top level directory (i.e., /res/$dom/$uname or /priv/$dom/$uname |
# $toppath - Top level directory (i.e., /res/$dom/$uname or /priv/$dom/$uname |
# $relpath - Current path (relative to top level). |
# $relpath - Current path (relative to top level). |
# $dirhashref - reference to hash to populate with URLs of directories (Required) |
# $dirhashref - reference to hash to populate with URLs of directories (Required) |
Line 12049 sub stat_file {
|
Line 12055 sub stat_file {
|
# |
# |
|
|
sub recursedirs { |
sub recursedirs { |
my ($is_home,$context,$docroot,$toppath,$relpath,$dirhashref,$filehashref) = @_; |
my ($is_home,$recurse,$include,$exclude,$nonemptydir,$toppath,$relpath,$dirhashref,$filehashref) = @_; |
return unless (ref($dirhashref) eq 'HASH'); |
return unless (ref($dirhashref) eq 'HASH'); |
|
my $docroot = $perlvar{'lonDocRoot'}; |
my $currpath = $docroot.$toppath; |
my $currpath = $docroot.$toppath; |
if ($relpath) { |
if ($relpath ne '') { |
$currpath .= "/$relpath"; |
$currpath .= "/$relpath"; |
} |
} |
my $savefile; |
my ($savefile,$checkinc,$checkexc); |
if (ref($filehashref)) { |
if (ref($filehashref)) { |
$savefile = 1; |
$savefile = 1; |
} |
} |
|
if (ref($include) eq 'HASH') { |
|
$checkinc = 1; |
|
} |
|
if (ref($exclude) eq 'HASH') { |
|
$checkexc = 1; |
|
} |
if ($is_home) { |
if ($is_home) { |
if (opendir(my $dirh,$currpath)) { |
if (opendir(my $dirh,$currpath)) { |
|
my $filecount = 0; |
foreach my $item (sort { lc($a) cmp lc($b) } grep(!/^\.+$/,readdir($dirh))) { |
foreach my $item (sort { lc($a) cmp lc($b) } grep(!/^\.+$/,readdir($dirh))) { |
next if ($item eq ''); |
next if ($item eq ''); |
if (-d "$currpath/$item") { |
if (-d "$currpath/$item") { |
my $newpath; |
my $newpath; |
if ($relpath) { |
if ($relpath ne '') { |
$newpath = "$relpath/$item"; |
$newpath = "$relpath/$item"; |
} else { |
} else { |
$newpath = $item; |
$newpath = $item; |
} |
} |
$dirhashref->{&Apache::lonlocal::js_escape($newpath)} = 1; |
$dirhashref->{&Apache::lonlocal::js_escape($newpath)} = 1; |
&recursedirs($is_home,$context,$docroot,$toppath,$newpath,$dirhashref,$filehashref); |
if ($recurse) { |
} elsif ($savefile) { |
&recursedirs($is_home,$recurse,$include,$exclude,$nonemptydir,$toppath,$newpath,$dirhashref,$filehashref); |
if ($context eq 'priv') { |
} |
unless ($item =~ /\.(meta|save|log|bak|DS_Store)$/) { |
} elsif (($savefile) || ($relpath eq '')) { |
$filehashref->{&Apache::lonlocal::js_escape($relpath)}{$item} = 1; |
next if ($nonemptydir && $filecount); |
} |
if ($checkinc || $checkexc) { |
} else { |
my ($extension) = ($item =~ /\.(\w+)$/); |
unless (($item =~ /\.meta$/) || ($item =~ /\.\d+\.\w+$/) || ($item =~ /\.rights$/)) { |
if ($checkinc) { |
|
next unless ($extension && $include->{$extension}); |
|
} |
|
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; |
$filehashref->{&Apache::lonlocal::js_escape($relpath)}{$item} = 1; |
} |
} |
} |
} |
|
$filecount ++; |
} |
} |
} |
} |
closedir($dirh); |
closedir($dirh); |
Line 12092 sub recursedirs {
|
Line 12120 sub recursedirs {
|
my @dir_lines; |
my @dir_lines; |
my $dirptr=16384; |
my $dirptr=16384; |
if (ref($dirlistref) eq 'ARRAY') { |
if (ref($dirlistref) eq 'ARRAY') { |
|
my $filecount = 0; |
foreach my $dir_line (sort |
foreach my $dir_line (sort |
{ |
{ |
my ($afile)=split('&',$a,2); |
my ($afile)=split('&',$a,2); |
Line 12107 sub recursedirs {
|
Line 12136 sub recursedirs {
|
if ($relpath) { |
if ($relpath) { |
$newpath = "$relpath/$item"; |
$newpath = "$relpath/$item"; |
} else { |
} else { |
$relpath = '/'; |
|
$newpath = $item; |
$newpath = $item; |
} |
} |
$dirhashref->{&Apache::lonlocal::js_escape($newpath)} = 1; |
$dirhashref->{&Apache::lonlocal::js_escape($newpath)} = 1; |
&recursedirs($is_home,$context,$docroot,$toppath,$newpath,$dirhashref,$filehashref); |
if ($recurse) { |
} elsif ($savefile) { |
&recursedirs($is_home,$recurse,$include,$exclude,$nonemptydir,$toppath,$newpath,$dirhashref,$filehashref); |
if ($context eq 'priv') { |
} |
unless ($item =~ /\.(meta|save|log|bak|DS_Store)$/) { |
} elsif (($savefile) || ($relpath eq '')) { |
$filehashref->{$relpath}{$item} = 1; |
next if ($nonemptydir && $filecount); |
} |
if ($checkinc || $checkexc) { |
} else { |
my $extension; |
unless (($item =~ /\.meta$/) || ($item =~ /\.\d+\.\w+$/)) { |
if ($checkinc) { |
$filehashref->{$relpath}{$item} = 1; |
next unless ($extension && $include->{$extension}); |
|
} |
|
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 ++; |
} |
} |
} |
} |
} |
} |
Line 12129 sub recursedirs {
|
Line 12171 sub recursedirs {
|
return; |
return; |
} |
} |
|
|
|
sub priv_exclude { |
|
return { |
|
meta => 1, |
|
save => 1, |
|
log => 1, |
|
bak => 1, |
|
rights => 1, |
|
DS_Store => 1, |
|
}; |
|
} |
|
|
# -------------------------------------------------------- Value of a Condition |
# -------------------------------------------------------- Value of a Condition |
|
|
# gets the value of a specific preevaluated condition |
# gets the value of a specific preevaluated condition |
Line 12457 sub domainlti_itemid {
|
Line 12510 sub domainlti_itemid {
|
return $itemid; |
return $itemid; |
} |
} |
|
|
sub get_numsuppfiles { |
sub count_supptools { |
my ($cnum,$cdom,$ignorecache)=@_; |
my ($cnum,$cdom,$ignorecache,$reload)=@_; |
|
my $hashid=$cnum.':'.$cdom; |
|
my ($numexttools,$cached); |
|
unless ($ignorecache) { |
|
($numexttools,$cached) = &is_cached_new('supptools',$hashid); |
|
} |
|
unless (defined($cached)) { |
|
my $chome=&homeserver($cnum,$cdom); |
|
$numexttools = 0; |
|
unless ($chome eq 'no_host') { |
|
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('supptools',$hashid,$numexttools,600); |
|
} |
|
return $numexttools; |
|
} |
|
|
|
sub has_unhidden_suppfiles { |
|
my ($cnum,$cdom,$ignorecache,$possdel)=@_; |
my $hashid=$cnum.':'.$cdom; |
my $hashid=$cnum.':'.$cdom; |
my ($suppcount,$cached); |
my ($showsupp,$cached); |
unless ($ignorecache) { |
unless ($ignorecache) { |
($suppcount,$cached) = &is_cached_new('suppcount',$hashid); |
($showsupp,$cached) = &is_cached_new('showsupp',$hashid); |
} |
} |
unless (defined($cached)) { |
unless (defined($cached)) { |
my $chome=&homeserver($cnum,$cdom); |
my $chome=&homeserver($cnum,$cdom); |
unless ($chome eq 'no_host') { |
unless ($chome eq 'no_host') { |
($suppcount,my $supptools,my $errors) = (0,0,0); |
my ($supplemental) = &Apache::loncommon::get_supplemental($cnum,$cdom,$ignorecache,$possdel); |
my $suppmap = 'supplemental.sequence'; |
if (ref($supplemental) eq 'HASH') { |
($suppcount,$supptools,$errors) = |
if ((ref($supplemental->{'ids'}) eq 'HASH') && (ref($supplemental->{'hidden'}) eq 'HASH')) { |
&Apache::loncommon::recurse_supplemental($cnum,$cdom,$suppmap,$suppcount, |
foreach my $key (keys(%{$supplemental->{'ids'}})) { |
$supptools,$errors); |
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('suppcount',$hashid,$suppcount,600); |
&do_cache_new('showsupp',$hashid,$showsupp,600); |
} |
} |
return $suppcount; |
return $showsupp; |
} |
} |
|
|
# |
# |
Line 13603 sub get_coursechange {
|
Line 13695 sub get_coursechange {
|
} |
} |
|
|
sub devalidate_coursechange_cache { |
sub devalidate_coursechange_cache { |
my ($cnum,$cdom)=@_; |
my ($cdom,$cnum)=@_; |
my $hashid=$cnum.':'.$cdom; |
my $hashid=$cdom.'_'.$cnum; |
&devalidate_cache_new('crschange',$hashid); |
&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 |
# ------------------------------------------------- Update symbolic store links |
|
|
sub symblist { |
sub symblist { |
Line 16464 data base, returning a hash that is keye
|
Line 16613 data base, returning a hash that is keye
|
values that are the resource value. I believe that the timestamps and |
values that are the resource value. I believe that the timestamps and |
versions are also returned. |
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 |
=back |
|
|
=head2 Course Modification |
=head2 Course Modification |