Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.1502 and 1.1503

version 1.1502, 2022/11/23 02:55:37 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,                                   totcodes => $totcodes,
                                 codes => \%codes,                                  codes => \%codes,
                                 codetitles => \@codetitles,                                  codetitles => \@codetitles,
                                 cat_titles => \%cat_titles,                                  cat_titles => \%cat_titles,
Line 12026  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 12050  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 12093  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 12108  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 12130  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

Removed from v.1.1502  
changed lines
  Added in v.1.1503


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