--- loncom/lonnet/perl/lonnet.pm 2016/04/21 00:36:17 1.1307
+++ loncom/lonnet/perl/lonnet.pm 2016/07/01 19:59:46 1.1313
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1307 2016/04/21 00:36:17 raeburn Exp $
+# $Id: lonnet.pm,v 1.1313 2016/07/01 19:59:46 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -2332,6 +2332,22 @@ sub get_domain_defaults {
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 {
@@ -4646,9 +4662,10 @@ my %cachedtimes=();
my $cachedtime='';
sub load_all_first_access {
- my ($uname,$udom)=@_;
+ my ($uname,$udom,$ignorecache)=@_;
if (($cachedkey eq $uname.':'.$udom) &&
- (abs($cachedtime-time)<5) && (!$env{'form.markaccess'})) {
+ (abs($cachedtime-time)<5) && (!$env{'form.markaccess'}) &&
+ (!$ignorecache)) {
return;
}
$cachedtime=time;
@@ -4657,7 +4674,7 @@ sub load_all_first_access {
}
sub get_first_access {
- my ($type,$argsymb,$argmap)=@_;
+ my ($type,$argsymb,$argmap,$ignorecache)=@_;
my ($symb,$courseid,$udom,$uname)=&whichuser();
if ($argsymb) { $symb=$argsymb; }
my ($map,$id,$res)=&decode_symb($symb);
@@ -4669,7 +4686,7 @@ sub get_first_access {
} else {
$res=$symb;
}
- &load_all_first_access($uname,$udom);
+ &load_all_first_access($uname,$udom,$ignorecache);
return $cachedtimes{"$courseid\0$res"};
}
@@ -7366,6 +7383,15 @@ 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,
@@ -7518,8 +7544,8 @@ sub get_commblock_resources {
}
}
}
- if ($interval[0] =~ /^\d+/) {
- my ($timelimit) = split(/_/,$interval[0]);
+ if ($interval[0] =~ /^(\d+)/) {
+ my $timelimit = $1;
my $first_access;
if ($type eq 'resource') {
$first_access=&get_first_access($interval[1],$item);
@@ -8292,8 +8318,30 @@ sub auto_crsreq_update {
}
sub auto_export_grades {
- my ($cnum,$cdom,$gradesref) = @_;
- return;
+ my ($cdom,$cnum,$inforef,$gradesref) = @_;
+ my ($homeserver,%exportresponse);
+ if ($cdom =~ /^$match_domain$/) {
+ $homeserver = &domain($cdom,'primary');
+ }
+ unless (($homeserver eq 'no_host') || ($homeserver eq '')) {
+ my $info;
+ if (ref($inforef) eq 'HASH') {
+ $info = &freeze_escape($inforef);
+ }
+ if (ref($gradesref) eq 'HASH') {
+ my $grades = &freeze_escape($gradesref);
+ my $response=&reply('encrypt:autoexportgrades:'.$cdom.':'.$cnum.':'.
+ $info.':'.$grades,$homeserver);
+ unless ($response =~ /(con_lost|error|no_such_host|refused|unknown_command)/) {
+ my @items = split(/&/,$response);
+ foreach my $item (@items) {
+ my ($key,$value) = split('=',$item);
+ $exportresponse{&unescape($key)} = &thaw_unescape($value);
+ }
+ }
+ }
+ }
+ return \%exportresponse;
}
sub check_instcode_cloning {
@@ -10168,6 +10216,115 @@ 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
@@ -10331,7 +10488,7 @@ 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