--- loncom/lonnet/perl/lonnet.pm	2016/04/21 00:36:17	1.1307
+++ loncom/lonnet/perl/lonnet.pm	2016/06/19 04:28:19	1.1312
@@ -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.1312 2016/06/19 04:28:19 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 {
@@ -10331,7 +10379,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