[BACK]Return to lonnet.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.1310 and 1.1313

version 1.1310, 2016/05/30 04:48:23 version 1.1313, 2016/07/01 19:59:46
Line 2332  sub get_domain_defaults { Line 2332  sub get_domain_defaults {
     return %domdefaults;      return %domdefaults;
 }  }
   
   sub course_portal_url {
       my ($cnum,$cdom) = @_;
       my $chome = &homeserver($cnum,$cdom);
       my $hostname = &hostname($chome);
       my $protocol = $protocol{$chome};
       $protocol = 'http' if ($protocol ne 'https');
       my %domdefaults = &get_domain_defaults($cdom);
       my $firsturl;
       if ($domdefaults{'portal_def'}) {
           $firsturl = $domdefaults{'portal_def'};
       } else {
           $firsturl = $protocol.'://'.$hostname;
       }
       return $firsturl;
   }
   
 # --------------------------------------------------- Assign a key to a student  # --------------------------------------------------- Assign a key to a student
   
 sub assign_access_key {  sub assign_access_key {
Line 7367  sub constructaccess { Line 7383  sub constructaccess {
             $ownerhome = &homeserver($ownername,$ownerdomain);              $ownerhome = &homeserver($ownername,$ownerdomain);
             return ($ownername,$ownerdomain,$ownerhome);              return ($ownername,$ownerdomain,$ownerhome);
         }          }
           if ($env{'request.course.id'}) {
               if (($ownername eq $env{'course.'.$env{'request.course.id'}.'.num'}) &&
                   ($ownerdomain eq $env{'course.'.$env{'request.course.id'}.'.domain'})) {
                   if (&allowed('mdc',$env{'request.course.id'})) {
                       $ownerhome = $env{'course.'.$env{'request.course.id'}.'.home'};
                       return ($ownername,$ownerdomain,$ownerhome);
                   }
               }
           }
     }      }
   
 # We don't have any access right now. If we are not possibly going to do anything about this,  # We don't have any access right now. If we are not possibly going to do anything about this,
Line 10191  sub stat_file { Line 10216  sub stat_file {
     return ();      return ();
 }  }
   
   # --------------------------------------------------------- recursedirs
   # Recursive function to traverse either a specific user's Authoring Space
   # 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.
   #
   # 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
   # $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)
   # $filehashref - reference to hash to populate with URLs of files (Optional)
   #
   # Returns: nothing
   #
   # Side Effects: populates $dirhashref, and $filehashref (if provided).
   #
   # Currently used by interface/londocs.pm to create linked select boxes for
   # directory and filename to import a Course "Author" resource into a course, and
   # also to create linked select boxes for Authoring Space and Directory to choose
   # save location for creation of a new "standard" problem from the Course Editor.
   #
   
   sub recursedirs {
       my ($is_home,$context,$docroot,$toppath,$relpath,$dirhashref,$filehashref) = @_;
       return unless (ref($dirhashref) eq 'HASH');
       my $currpath = $docroot.$toppath;
       if ($relpath) {
           $currpath .= "/$relpath";
       }
       my $savefile;
       if (ref($filehashref)) {
           $savefile = 1;
       }
       if ($is_home) {
           if (opendir(my $dirh,$currpath)) {
               foreach my $item (sort { lc($a) cmp lc($b) } grep(!/^\.+$/,readdir($dirh))) {
                   next if ($item eq '');
                   if (-d "$currpath/$item") {
                       my $newpath;
                       if ($relpath) {
                           $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$/)) {
                               $filehashref->{&Apache::lonlocal::js_escape($relpath)}{$item} = 1;
                           }
                       }
                   }
               }
               closedir($dirh);
           }
       } else {
           my ($dirlistref,$listerror) =
               &dirlist($toppath.$relpath);
           my @dir_lines;
           my $dirptr=16384;
           if (ref($dirlistref) eq 'ARRAY') {
               foreach my $dir_line (sort
                                 {
                                     my ($afile)=split('&',$a,2);
                                     my ($bfile)=split('&',$b,2);
                                     return (lc($afile) cmp lc($bfile));
                                 } (@{$dirlistref})) {
                   my ($item,$dom,undef,$testdir,undef,undef,undef,undef,$size,undef,$mtime,undef,undef,undef,$obs,undef) =
                       split(/\&/,$dir_line,16);
                   $item =~ s/\s+$//;
                   next if (($item =~ /^\.\.?$/) || ($obs));
                   if ($dirptr&$testdir) {
                       my $newpath;
                       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;
                           }
                       }
                   }
               }
           }
       }
       return;
   }
   
 # -------------------------------------------------------- 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 10354  sub get_userresdata { Line 10488  sub get_userresdata {
 #  Parameters:  #  Parameters:
 #     $name      - Course/user name.  #     $name      - Course/user name.
 #     $domain    - Name of the domain the user/course is registered on.  #     $domain    - Name of the domain the user/course is registered on.
 #     $type      - Type of thing $name is (must be 'course' or 'user'  #     $type      - Type of thing $name is (must be 'course' or 'user')
 #     $mapp      - decluttered URL of enclosing map    #     $mapp      - decluttered URL of enclosing map  
 #     $recursed  - Ref to scalar -- set to 1, if nested maps have been recursed.  #     $recursed  - Ref to scalar -- set to 1, if nested maps have been recursed.
 #     $recurseup - Ref to array of map URLs, starting with map containing  #     $recurseup - Ref to array of map URLs, starting with map containing
Removed from v.1.1310  
changed lines
  Added in v.1.1313

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