loncom/lonnet/perl/lonnet.pm - diff

Return to lonnet.pm CVS log

Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.1309 and 1.1314

-version 1.1309, 2016/05/30 03:16:33
+version 1.1314, 2016/07/24 14:35:29
  Line 2202  sub get_domain_defaults {
                                    'requestcourses','inststatus',
                                    'coursedefaults','usersessions',
                                    'requestauthor','selfenrollment',
-                                   'coursecategories'],$domain);
+                                   'coursecategories','autoenroll'],$domain);
      my @coursetypes = ('official','unofficial','community','textbook','placement');
      if (ref($domconfig{'defaults'}) eq 'HASH') {
          $domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'};
  Line 2328  sub get_domain_defaults {
              $domdefaults{'catunauth'} = $domconfig{'coursecategories'}{'unauth'};
          }
      }
+     if (ref($domconfig{'autoenroll'}) eq 'HASH') {
+         $domdefaults{'autofailsafe'} = $domconfig{'autoenroll'}{'autofailsafe'};
+     }
      &do_cache_new('domdefaults',$domain,\%domdefaults,$cachetime);
      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
  sub assign_access_key {
- Line 7367  sub constructaccess {
+ Line 7386  sub constructaccess {
              $ownerhome = &homeserver($ownername,$ownerdomain);
              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,
- Line 7519  sub get_commblock_resources {
+ Line 7547  sub get_commblock_resources {
                              }
                          }
                      }
-                     if ($interval[0] =~ /^(\d+/)) {
+                     if ($interval[0] =~ /^(\d+)/) {
                          my $timelimit = $1;
                          my $first_access;
                          if ($type eq 'resource') {
- Line 9063  sub modifyuser {
+ Line 9091  sub modifyuser {
  sub modifystudent {
      my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec,
          $end,$start,$forceid,$desiredhome,$email,$type,$locktype,$cid,
-         $selfenroll,$context,$inststatus,$credits)=@_;
+         $selfenroll,$context,$inststatus,$credits,$instsec)=@_;
      if (!$cid) {
  	unless ($cid=$env{'request.course.id'}) {
  	    return 'not_in_class';
- Line 9079  sub modifystudent {
+ Line 9107  sub modifystudent {
      $uid = undef if (!$forceid);
      $reply = &modify_student_enrollment($udom,$uname,$uid,$first,$middle,$last,
                                          $gene,$usec,$end,$start,$type,$locktype,
-                                         $cid,$selfenroll,$context,$credits);
+                                         $cid,$selfenroll,$context,$credits,$instsec);
      return $reply;
  }
  sub modify_student_enrollment {
      my ($udom,$uname,$uid,$first,$middle,$last,$gene,$usec,$end,$start,$type,
-         $locktype,$cid,$selfenroll,$context,$credits) = @_;
+         $locktype,$cid,$selfenroll,$context,$credits,$instsec) = @_;
      my ($cdom,$cnum,$chome);
      if (!$cid) {
  	unless ($cid=$env{'request.course.id'}) {
- Line 9132  sub modify_student_enrollment {
+ Line 9160  sub modify_student_enrollment {
      my %old_entry = &Apache::lonnet::get('classlist',[$user],$cdom,$cnum);
      my $reply=cput('classlist',
  		   {$user =>
- 			join(':',$end,$start,$uid,$usec,$fullname,$type,$locktype,$credits) },
+ 			join(':',$end,$start,$uid,$usec,$fullname,$type,$locktype,$credits,$instsec) },
  		   $cdom,$cnum);
      if (($reply eq 'ok') || ($reply eq 'delayed')) {
          &devalidate_getsection_cache($udom,$uname,$cid);
- Line 10191  sub stat_file {
+ Line 10219  sub stat_file {
      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
  # gets the value of a specific preevaluated condition
- Line 10354  sub get_userresdata {
+ Line 10491  sub get_userresdata {
  #  Parameters:
  #     $name      - Course/user name.
  #     $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
  #     $recursed  - Ref to scalar -- set to 1, if nested maps have been recursed.
  #     $recurseup - Ref to array of map URLs, starting with map containing
- Line 13729  Inputs:
+ Line 13866  Inputs:
  =item $credits, number of credits student will earn from this class
+ =item $instsec, institutional course section code for student
  =back

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

Removed from v.1.1309
changed lines
	Added in v.1.1314