Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.1307 and 1.1311

version 1.1307, 2016/04/21 00:36:17 version 1.1311, 2016/06/19 00:19:24
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 4646  my %cachedtimes=(); Line 4662  my %cachedtimes=();
 my $cachedtime='';  my $cachedtime='';
   
 sub load_all_first_access {  sub load_all_first_access {
     my ($uname,$udom)=@_;      my ($uname,$udom,$ignorecache)=@_;
     if (($cachedkey eq $uname.':'.$udom) &&      if (($cachedkey eq $uname.':'.$udom) &&
         (abs($cachedtime-time)<5) && (!$env{'form.markaccess'})) {          (abs($cachedtime-time)<5) && (!$env{'form.markaccess'}) &&
           (!$ignorecache)) {
         return;          return;
     }      }
     $cachedtime=time;      $cachedtime=time;
Line 4657  sub load_all_first_access { Line 4674  sub load_all_first_access {
 }  }
   
 sub get_first_access {  sub get_first_access {
     my ($type,$argsymb,$argmap)=@_;      my ($type,$argsymb,$argmap,$ignorecache)=@_;
     my ($symb,$courseid,$udom,$uname)=&whichuser();      my ($symb,$courseid,$udom,$uname)=&whichuser();
     if ($argsymb) { $symb=$argsymb; }      if ($argsymb) { $symb=$argsymb; }
     my ($map,$id,$res)=&decode_symb($symb);      my ($map,$id,$res)=&decode_symb($symb);
Line 4669  sub get_first_access { Line 4686  sub get_first_access {
     } else {      } else {
  $res=$symb;   $res=$symb;
     }      }
     &load_all_first_access($uname,$udom);      &load_all_first_access($uname,$udom,$ignorecache);
     return $cachedtimes{"$courseid\0$res"};      return $cachedtimes{"$courseid\0$res"};
 }  }
   
Line 7518  sub get_commblock_resources { Line 7535  sub get_commblock_resources {
                             }                              }
                         }                          }
                     }                      }
                     if ($interval[0] =~ /^\d+/) {                      if ($interval[0] =~ /^(\d+)/) {
                         my ($timelimit) = split(/_/,$interval[0]);                          my $timelimit = $1; 
                         my $first_access;                          my $first_access;
                         if ($type eq 'resource') {                          if ($type eq 'resource') {
                             $first_access=&get_first_access($interval[1],$item);                              $first_access=&get_first_access($interval[1],$item);
Line 8292  sub auto_crsreq_update { Line 8309  sub auto_crsreq_update {
 }  }
   
 sub auto_export_grades {  sub auto_export_grades {
     my ($cnum,$cdom,$gradesref) = @_;      my ($cdom,$cnum,$inforef,$gradesref) = @_;
     return;      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 {  sub check_instcode_cloning {
Line 10331  sub get_userresdata { Line 10370  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.1307  
changed lines
  Added in v.1.1311


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