--- loncom/lonnet/perl/lonnet.pm 2022/11/23 02:55:37 1.1502 +++ loncom/lonnet/perl/lonnet.pm 2022/12/31 14:09:00 1.1503 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1502 2022/11/23 02:55:37 raeburn Exp $ +# $Id: lonnet.pm,v 1.1503 2022/12/31 14:09:00 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -2924,7 +2924,7 @@ sub get_dom_instcats { if (&auto_instcode_format($caller,$dom,\%coursecodes,\%codes, \@codetitles,\%cat_titles,\%cat_order) eq 'ok') { $instcats = { - totcodes => $totcodes, + totcodes => $totcodes, codes => \%codes, codetitles => \@codetitles, cat_titles => \%cat_titles, @@ -12026,14 +12026,19 @@ 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). # $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) @@ -12050,39 +12055,61 @@ sub stat_file { # 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'); + 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)) { + 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; - } - } else { - unless (($item =~ /\.meta$/) || ($item =~ /\.\d+\.\w+$/) || ($item =~ /\.rights$/)) { + if ($recurse) { + &recursedirs($is_home,$recurse,$include,$exclude,$nonemptydir,$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}); + } + 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); @@ -12093,6 +12120,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); @@ -12108,21 +12136,34 @@ 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; - } - } else { - unless (($item =~ /\.meta$/) || ($item =~ /\.\d+\.\w+$/)) { - $filehashref->{$relpath}{$item} = 1; + if ($recurse) { + &recursedirs($is_home,$recurse,$include,$exclude,$nonemptydir,$toppath,$newpath,$dirhashref,$filehashref); + } + } elsif (($savefile) || ($relpath eq '')) { + next if ($nonemptydir && $filecount); + if ($checkinc || $checkexc) { + my $extension; + 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; } } + $filecount ++; } } } @@ -12130,6 +12171,17 @@ sub recursedirs { 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