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

Diff for /loncom/interface/loncommon.pm between versions 1.1075.2.141.2.1 and 1.1075.2.141.2.5

version 1.1075.2.141.2.1, 2020/01/15 01:50:09 version 1.1075.2.141.2.5, 2020/07/19 21:33:46
Line 430  sub studentbrowser_javascript { Line 430  sub studentbrowser_javascript {
 <script type="text/javascript" language="Javascript">  <script type="text/javascript" language="Javascript">
 // <![CDATA[  // <![CDATA[
     var stdeditbrowser;      var stdeditbrowser;
     function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) {      function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadv) {
         var url = '/adm/pickstudent?';          var url = '/adm/pickstudent?';
         var filter;          var filter;
  if (!ignorefilter) {   if (!ignorefilter) {
Line 445  sub studentbrowser_javascript { Line 445  sub studentbrowser_javascript {
                                     '&udomelement='+udom+                                      '&udomelement='+udom+
                                     '&clicker='+clicker;                                      '&clicker='+clicker;
  if (roleflag) { url+="&roles=1"; }   if (roleflag) { url+="&roles=1"; }
         if (courseadvonly) { url+="&courseadvonly=1"; }          if (courseadv == 'condition') {
               if (document.getElementById('courseadv')) {
                   courseadv = document.getElementById('courseadv').value;
               }
           }
           if ((courseadv == 'only') || (courseadv == 'none')) { url+="&courseadv="+courseadv; }
         var title = 'Student_Browser';          var title = 'Student_Browser';
         var options = 'scrollbars=1,resizable=1,menubar=0';          var options = 'scrollbars=1,resizable=1,menubar=0';
         options += ',width=700,height=600';          options += ',width=700,height=600';
Line 477  ENDRESBRW Line 482  ENDRESBRW
 }  }
   
 sub selectstudent_link {  sub selectstudent_link {
    my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;     my ($form,$unameele,$udomele,$courseadv,$clickerid)=@_;
    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".     my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                       &Apache::lonhtmlcommon::entity_encode($unameele)."','".                        &Apache::lonhtmlcommon::entity_encode($unameele)."','".
                       &Apache::lonhtmlcommon::entity_encode($udomele)."'";                        &Apache::lonhtmlcommon::entity_encode($udomele)."'";
Line 488  sub selectstudent_link { Line 493  sub selectstudent_link {
    return '';     return '';
        }         }
        $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";         $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
        if ($courseadvonly)  {         if ($courseadv eq 'only') {
            $callargs .= ",'',1,1";             $callargs .= ",'',1,'$courseadv'";
          } elsif ($courseadv eq 'none') {
              $callargs .= ",'','','$courseadv'";
          } elsif ($courseadv eq 'condition') {
              $callargs .= ",'','','$courseadv'";
        }         }
        return '<span class="LC_nobreak">'.         return '<span class="LC_nobreak">'.
               '<a href="javascript:openstdbrowser('.$callargs.');">'.                '<a href="javascript:openstdbrowser('.$callargs.');">'.
Line 3233  sub check_passwd_rules { Line 3242  sub check_passwd_rules {
         $rulenames{'min'} = &mt('Minimum password length: [_1]',$min);          $rulenames{'min'} = &mt('Minimum password length: [_1]',$min);
         $rulenames{'max'} = &mt('Maximum password length: [_1]',$max);          $rulenames{'max'} = &mt('Maximum password length: [_1]',$max);
         $warning = &mt('Password did not satisfy the following:').'<ul>';          $warning = &mt('Password did not satisfy the following:').'<ul>';
         foreach my $rule ('min','max','uc','ls','num','spec') {          foreach my $rule ('min','max','uc','lc','num','spec') {
             if (grep(/^$rule$/,@brokerule)) {              if (grep(/^$rule$/,@brokerule)) {
                 $warning .= '<li>'.$rulenames{$rule}.'</li>';                  $warning .= '<li>'.$rulenames{$rule}.'</li>';
             }              }
Line 5028  sub check_ip_acc { Line 5037  sub check_ip_acc {
     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {      if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
         return 1;          return 1;
     }      }
     my $allowed;      my ($ip,$allowed);
     my $ip=$ENV{'REMOTE_ADDR'} || $clientip || $env{'request.host'};      if (($ENV{'REMOTE_ADDR'} eq '127.0.0.1') ||
           ($ENV{'REMOTE_ADDR'} eq &Apache::lonnet::get_host_ip($Apache::lonnet::perlvar{'lonHostID'}))) {
           $ip = $env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip;
       } else {
           $ip = $ENV{'REMOTE_ADDR'} || $env{'request.host'} || $clientip;
       }
   
     my $name;      my $name;
     my %access = (      my %access = (
Line 7942  ADDMETA Line 7956  ADDMETA
                 my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};                  my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
                 unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {                  unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
                     my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);                      my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
                       my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
                       my $offload;
                     if (ref($domdefs{'offloadnow'}) eq 'HASH') {                      if (ref($domdefs{'offloadnow'}) eq 'HASH') {
                         my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};  
                         if ($domdefs{'offloadnow'}{$lonhost}) {                          if ($domdefs{'offloadnow'}{$lonhost}) {
                             my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);                              $offload = 1;
                             if (($newserver) && ($newserver ne $lonhost)) {                          }
                                 my $numsec = 5;                      }
                                 my $timeout = $numsec * 1000;                      unless ($offload) {
                                 my ($newurl,$locknum,%locks,$msg);                          if (ref($domdefs{'offloadoth'}) eq 'HASH') {
                                 if ($env{'request.role.adv'}) {                              if ($domdefs{'offloadoth'}{$lonhost}) {
                                     ($locknum,%locks) = &Apache::lonnet::get_locks();                                  if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&
                                 }                                      (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {
                                 my $disable_submit = 0;                                      unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {
                                 if ($requrl =~ /$LONCAPA::assess_re/) {                                          $offload = 1;
                                     $disable_submit = 1;                                          $dom_in_use = $env{'user.domain'};
                                       }
                                 }                                  }
                                 if ($locknum) {                              }
                                     my @lockinfo = sort(values(%locks));                          }
                                     $msg = &mt('Once the following tasks are complete: ')."\\n".                      }
                                            join(", ",sort(values(%locks)))."\\n".                      if ($offload) {
                                            &mt('your session will be transferred to a different server, after you click "Roles".');                          my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);
                           if (($newserver) && ($newserver ne $lonhost)) {
                               my $numsec = 5;
                               my $timeout = $numsec * 1000;
                               my ($newurl,$locknum,%locks,$msg);
                               if ($env{'request.role.adv'}) {
                                   ($locknum,%locks) = &Apache::lonnet::get_locks();
                               }
                               my $disable_submit = 0;
                               if ($requrl =~ /$LONCAPA::assess_re/) {
                                   $disable_submit = 1;
                               }
                               if ($locknum) {
                                   my @lockinfo = sort(values(%locks));
                                   $msg = &mt('Once the following tasks are complete: ')."\n".
                                          join(", ",sort(values(%locks)))."\n";
                                   if (&show_course()) {
                                       $msg .= &mt('your session will be transferred to a different server, after you click "Courses".');
                                 } else {                                  } else {
                                     if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {                                      $msg .= &mt('your session will be transferred to a different server, after you click "Roles".');
                                         $msg = &mt('Your LON-CAPA submission has been recorded')."\\n";                                  }
                                     }                              } else {
                                     $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);                                  if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
                                     $newurl = '/adm/switchserver?otherserver='.$newserver;                                      $msg = &mt('Your LON-CAPA submission has been recorded')."\n";
                                     if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {                                  }
                                         $newurl .= '&role='.$env{'request.role'};                                  $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
                                   $newurl = '/adm/switchserver?otherserver='.$newserver;
                                   if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
                                       $newurl .= '&role='.$env{'request.role'};
                                   }
                                   if ($env{'request.symb'}) {
                                       my $shownsymb = &Apache::lonenc::check_encrypt($env{'request.symb'});
                                       if ($shownsymb =~ m{^/enc/}) {
                                           my $reqdmajor = 2;
                                           my $reqdminor = 11;
                                           my $reqdsubminor = 3;
                                           my $newserverrev = &Apache::lonnet::get_server_loncaparev('',$newserver);
                                           my $remoterev = &Apache::lonnet::get_server_loncaparev(undef,$newserver);
                                           my ($major,$minor,$subminor) = ($remoterev =~ /^\'?(\d+)\.(\d+)\.(\d+|)[\w.\-]+\'?$/);
                                           if (($major eq '' && $minor eq '') ||
                                               (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)) ||
                                               (($reqdmajor == $major) && ($reqdminor == $minor) && (($subminor eq '') ||
                                                ($reqdsubminor > $subminor))))) {
                                               undef($shownsymb);
                                           }
                                     }                                      }
                                     if ($env{'request.symb'}) {                                      if ($shownsymb) {
                                         $newurl .= '&symb='.$env{'request.symb'};                                          &js_escape(\$shownsymb);
                                     } else {                                          $newurl .= '&symb='.$shownsymb;
                                         $newurl .= '&origurl='.$requrl;  
                                     }                                      }
                                   } else {
                                       my $shownurl = &Apache::lonenc::check_encrypt($requrl);
                                       &js_escape(\$shownurl);
                                       $newurl .= '&origurl='.$shownurl;
                                 }                                  }
                                 &js_escape(\$msg);                              }
                                 $result.=<<OFFLOAD                              &js_escape(\$msg);
                               $result.=<<OFFLOAD
 <meta http-equiv="pragma" content="no-cache" />  <meta http-equiv="pragma" content="no-cache" />
 <script type="text/javascript">  <script type="text/javascript">
 // <![CDATA[  // <![CDATA[
Line 7999  function LC_Offload_Now() { Line 8055  function LC_Offload_Now() {
 // ]]>  // ]]>
 </script>  </script>
 OFFLOAD  OFFLOAD
                             }  
                         }                          }
                     }                      }
                 }                  }
Line 8420  sub modal_link { Line 8475  sub modal_link {
         $target_attr = 'target="'.$target.'"';          $target_attr = 'target="'.$target.'"';
     }      }
     return <<"ENDLINK";      return <<"ENDLINK";
 <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">  <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">$linktext</a>
            $linktext</a>  
 ENDLINK  ENDLINK
 }  }
   
Line 15028  sub check_clone { Line 15082  sub check_clone {
     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};      my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);      my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);      my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
     my $clonemsg;      my $clonetitle;
       my @clonemsg;
     my $can_clone = 0;      my $can_clone = 0;
     my $lctype = lc($args->{'crstype'});      my $lctype = lc($args->{'crstype'});
     if ($lctype ne 'community') {      if ($lctype ne 'community') {
Line 15036  sub check_clone { Line 15091  sub check_clone {
     }      }
     if ($clonehome eq 'no_host') {      if ($clonehome eq 'no_host') {
         if ($args->{'crstype'} eq 'Community') {          if ($args->{'crstype'} eq 'Community') {
             $clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});              push(@clonemsg,({
                                 mt => 'No new community created.',
                                 args => [],
                               },
                               {
                                 mt => 'A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',
                                 args => [$args->{'clonedomain'}.':'.$args->{'clonedomain'}],
                               }));
         } else {          } else {
             $clonemsg = &mt('No new course created.').$linefeed.&mt('A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});              push(@clonemsg,({
         }                                     mt => 'No new course created.',
                                 args => [],
                               },
                               {
                                 mt => 'A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',
                                 args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
                               }));
           }
     } else {      } else {
  my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});   my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
           $clonetitle = $clonedesc{'description'};
         if ($args->{'crstype'} eq 'Community') {          if ($args->{'crstype'} eq 'Community') {
             if ($clonedesc{'type'} ne 'Community') {              if ($clonedesc{'type'} ne 'Community') {
                  $clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});                  push(@clonemsg,({
                 return ($can_clone, $clonemsg, $cloneid, $clonehome);                                    mt => 'No new community created.',
                                     args => [],
                                   },
                                   {
                                     mt => 'A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',
                                     args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
                                   }));
                   return ($can_clone,\@clonemsg,$cloneid,$clonehome);
             }              }
         }          }
  if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&   if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
Line 15134  sub check_clone { Line 15211  sub check_clone {
             }              }
             unless ($can_clone) {              unless ($can_clone) {
                 if ($args->{'crstype'} eq 'Community') {                  if ($args->{'crstype'} eq 'Community') {
                     $clonemsg = &mt('No new community created.').$linefeed.&mt('The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});                      push(@clonemsg,({
                                         mt => 'No new community created.',
                                         args => [],
                                       },
                                       {
                                         mt => 'The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',
                                         args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
                                       }));
                 } else {                  } else {
                     $clonemsg = &mt('No new course created.').$linefeed.&mt('The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});                      push(@clonemsg,({
         }                                        mt => 'No new course created.',
                                         args => [],
                                       },
                                       {
                                         mt => 'The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',
                                         args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
                                       }));
                   }
     }      }
         }          }
     }      }
     return ($can_clone, $clonemsg, $cloneid, $clonehome);      return ($can_clone,\@clonemsg,$cloneid,$clonehome,$clonetitle);
 }  }
   
 sub construct_course {  sub construct_course {
     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,      my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,
         $cnum,$category,$coderef) = @_;          $cnum,$category,$coderef,$callercontext,$user_lh) = @_;
     my $outcome;      my ($outcome,$msgref,$clonemsgref);
     my $linefeed =  '<br />'."\n";      my $linefeed =  '<br />'."\n";
     if ($context eq 'auto') {      if ($context eq 'auto') {
         $linefeed = "\n";          $linefeed = "\n";
Line 15156  sub construct_course { Line 15247  sub construct_course {
 #  #
 # Are we cloning?  # Are we cloning?
 #  #
     my ($can_clone, $clonemsg, $cloneid, $clonehome);      my ($can_clone,$cloneid,$clonehome,$clonetitle);
     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {      if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
  ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);   ($can_clone,$clonemsgref,$cloneid,$clonehome,$clonetitle) = &check_clone($args,$linefeed);
  if ($context ne 'auto') {  
             if ($clonemsg ne '') {  
         $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';  
             }  
  }  
  $outcome .= $clonemsg.$linefeed;  
   
         if (!$can_clone) {          if (!$can_clone) {
     return (0,$outcome);      return (0,$outcome,$clonemsgref);
  }   }
     }      }
   
Line 15185  sub construct_course { Line 15269  sub construct_course {
                                              $args->{'ccuname'}.':'.                                               $args->{'ccuname'}.':'.
                                              $args->{'ccdomain'},                                               $args->{'ccdomain'},
                                              $args->{'crstype'},                                               $args->{'crstype'},
                                              $cnum,$context,$category);                                               $cnum,$context,$category,
                                                $callercontext);
   
     # Note: The testing routines depend on this being output; see       # Note: The testing routines depend on this being output; see 
     # Utils::Course. This needs to at least be output as a comment      # Utils::Course. This needs to at least be output as a comment
     # if anyone ever decides to not show this, and Utils::Course::new      # if anyone ever decides to not show this, and Utils::Course::new
     # will need to be suitably modified.      # will need to be suitably modified.
     $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;      if (($callercontext eq 'auto') && ($user_lh ne '')) {
           $outcome .= &mt_user($user_lh,'New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
       } else {
           $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
       }
     if ($$courseid =~ /^error:/) {      if ($$courseid =~ /^error:/) {
         return (0,$outcome);          return (0,$outcome,$clonemsgref);
     }      }
   
 #  #
Line 15202  sub construct_course { Line 15291  sub construct_course {
     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);      ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);      my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
     if ($crsuhome eq 'no_host') {      if ($crsuhome eq 'no_host') {
         $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;          if (($callercontext eq 'auto') && ($user_lh ne '')) {
         return (0,$outcome);              $outcome .= &mt_user($user_lh,
                               'Course creation failed, unrecognized course home server.');
           } else {
               $outcome .= &mt('Course creation failed, unrecognized course home server.');
           }
           $outcome .= $linefeed;
           return (0,$outcome,$clonemsgref);
     }      }
     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;      $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
   
 #  #
 # Do the cloning  # Do the cloning
 #     #   
       my @clonemsg;
     if ($can_clone && $cloneid) {      if ($can_clone && $cloneid) {
  $clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);          push(@clonemsg,
  if ($context ne 'auto') {                        {
     $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';                            mt => 'Created [_1] by cloning from [_2]',
  }                            args => [$crstype,$clonetitle],
  $outcome .= $clonemsg.$linefeed;                        });
  my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);   my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
 # Copy all files  # Copy all files
  &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});          my @info =
       &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},
                                                        $args->{'dateshift'},$args->{'crscode'},
                                                        $args->{'ccuname'}.':'.$args->{'ccdomain'},
                                                        $args->{'tinyurls'});
           if (@info) {
               push(@clonemsg,@info);
           }
 # Restore URL  # Restore URL
  $cenv{'url'}=$oldcenv{'url'};   $cenv{'url'}=$oldcenv{'url'};
 # Restore title  # Restore title
Line 15485  sub construct_course { Line 15588  sub construct_course {
 # Open all assignments  # Open all assignments
 #  #
     if ($args->{'openall'}) {      if ($args->{'openall'}) {
          my $opendate = time;
          if ($args->{'openallfrom'} =~ /^\d+$/) {
              $opendate = $args->{'openallfrom'};
          }
        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';         my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
        my %storecontent = ($storeunder         => time,         my %storecontent = ($storeunder         => $opendate,
                            $storeunder.'.type' => 'date_start');                             $storeunder.'.type' => 'date_start');
                 $outcome .= &mt('All assignments open starting [_1]',
        $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput                         &Apache::lonlocal::locallocaltime($opendate)).': '.
                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;                     &Apache::lonnet::cput
                          ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
    }     }
 #  #
 # Set first page  # Set first page
Line 15520  sub construct_course { Line 15628  sub construct_course {
         $outcome .= ($fatal?$errtext:'write ok').$linefeed;          $outcome .= ($fatal?$errtext:'write ok').$linefeed;
     }      }
   
     return (1,$outcome);      return (1,$outcome,\@clonemsg);
 }  }
   
 sub make_unique_code {  sub make_unique_code {
Line 17194  sub des_decrypt { Line 17302  sub des_decrypt {
     return $plaintext;      return $plaintext;
 }  }
   
 sub make_short_symbs {  sub get_requested_shorturls {
     my ($cdom,$cnum,$navmap) = @_;      my ($cdom,$cnum,$navmap) = @_;
     return unless (ref($navmap));      return unless (ref($navmap));
     my ($numnew,@errors);      my ($numnew,$errors);
     my @toshorten = &Apache::loncommon::get_env_multiple('form.addtiny');      my @toshorten = &Apache::loncommon::get_env_multiple('form.addtiny');
     if (@toshorten) {      if (@toshorten) {
         my (%maps,%resources,%titles);          my (%maps,%resources,%titles);
         &Apache::loncourserespicker::enumerate_course_contents($navmap,\%maps,\%resources,\%titles,          &Apache::loncourserespicker::enumerate_course_contents($navmap,\%maps,\%resources,\%titles,
                                                                'shorturls',$cdom,$cnum);                                                                 'shorturls',$cdom,$cnum);
         my %tocreate;  
         if (keys(%resources)) {          if (keys(%resources)) {
               my %tocreate;
             foreach my $item (sort {$a <=> $b} (@toshorten)) {              foreach my $item (sort {$a <=> $b} (@toshorten)) {
                 my $symb = $resources{$item};                  my $symb = $resources{$item};
                 if ($symb) {                  if ($symb) {
                     $tocreate{$cnum.'&'.$symb} = 1;                      $tocreate{$cnum.'&'.$symb} = 1;
                 }                  }
             }              }
               if (keys(%tocreate)) {
                   ($numnew,$errors) = &make_short_symbs($cdom,$cnum,
                                                         \%tocreate);
               }
         }          }
       }
       return ($numnew,$errors);
   }
   
   sub make_short_symbs {
       my ($cdom,$cnum,$tocreateref,$lockuser) = @_;
       my ($numnew,@errors);
       if (ref($tocreateref) eq 'HASH') {
           my %tocreate = %{$tocreateref};
         if (keys(%tocreate)) {          if (keys(%tocreate)) {
             my %coursetiny = &Apache::lonnet::dump('tiny',$cdom,$cnum);              my %coursetiny = &Apache::lonnet::dump('tiny',$cdom,$cnum);
             my $su = Short::URL->new(no_vowels => 1);              my $su = Short::URL->new(no_vowels => 1);
Line 17219  sub make_short_symbs { Line 17340  sub make_short_symbs {
             my (%newunique,%addcourse,%courseonly,%failed);              my (%newunique,%addcourse,%courseonly,%failed);
             # get lock on tiny db              # get lock on tiny db
             my $now = time;              my $now = time;
               if ($lockuser eq '') {
                   $lockuser = $env{'user.name'}.':'.$env{'user.domain'};
               }
             my $lockhash = {              my $lockhash = {
                                 "lock\0$now" => $env{'user.name'}.                                  "lock\0$now" => $lockuser,
                                                 ':'.$env{'user.domain'},  
                             };                              };
             my $tries = 0;              my $tries = 0;
             my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);              my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
Line 17342  sub is_nonframeable { Line 17465  sub is_nonframeable {
     }      }
     my $uselink;      my $uselink;
     my $request = new HTTP::Request('HEAD',$url);      my $request = new HTTP::Request('HEAD',$url);
     my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',5);      my $ua = LWP::UserAgent->new;
       $ua->timeout(5);
       my $response=$ua->request($request);
     if ($response->is_success()) {      if ($response->is_success()) {
         my $secpolicy = lc($response->header('content-security-policy'));          my $secpolicy = lc($response->header('content-security-policy'));
         my $xframeop = lc($response->header('x-frame-options'));          my $xframeop = lc($response->header('x-frame-options'));
Removed from v.1.1075.2.141.2.1  
changed lines
  Added in v.1.1075.2.141.2.5

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