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

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.1532 and 1.1537

version 1.1532, 2024/12/27 02:32:55 version 1.1537, 2025/03/19 14:44:04
Line 3019  sub get_domain_defaults { Line 3019  sub get_domain_defaults {
                 last if ($domdefaults{'userapprovals'});                  last if ($domdefaults{'userapprovals'});
             }              }
         }          }
           if (ref($domconfig{'privacy'}{'othdom'}) eq 'HASH') {
               $domdefaults{'privacyothdom'} = $domconfig{'privacy'}{'othdom'};
           }
     }      }
     &do_cache_new('domdefaults',$domain,\%domdefaults,$cachetime);      &do_cache_new('domdefaults',$domain,\%domdefaults,$cachetime);
     return %domdefaults;      return %domdefaults;
Line 3731  sub ssi_body { Line 3734  sub ssi_body {
     $output=~s|//(\s*<!--)? BEGIN LON-CAPA Internal.+?// END LON-CAPA Internal\s*(-->)?\s||gs;      $output=~s|//(\s*<!--)? BEGIN LON-CAPA Internal.+?// END LON-CAPA Internal\s*(-->)?\s||gs;
     $output=~s/^.*?\<body[^\>]*\>//si;      $output=~s/^.*?\<body[^\>]*\>//si;
     $output=~s/\<\/body\s*\>.*?$//si;      $output=~s/\<\/body\s*\>.*?$//si;
       $output=~s{\Q<div class="LC_landmark" role="main">\E}{<div>}gs;
     if (wantarray) {      if (wantarray) {
         return ($output, $response);          return ($output, $response);
     } else {      } else {
Line 6749  sub store { Line 6753  sub store {
 # -------------------------------------------------------------- Critical Store  # -------------------------------------------------------------- Critical Store
   
 sub cstore {  sub cstore {
     my ($storehash,$symb,$namespace,$domain,$stuname,$laststore,$ip,$nolog) = @_;      my ($storehash,$symb,$namespace,$domain,$stuname,$laststore) = @_;
     my $home='';      my $home='';
   
     if ($stuname) { $home=&homeserver($stuname,$domain); }      if ($stuname) { $home=&homeserver($stuname,$domain); }
Line 6774  sub cstore { Line 6778  sub cstore {
     }      }
     if (!$home) { $home=$env{'user.home'}; }      if (!$home) { $home=$env{'user.home'}; }
   
     if ($ip ne '') {      $$storehash{'ip'} = &get_requestor_ip();
         $$storehash{'ip'} = $ip;  
     } else {  
         $$storehash{'ip'} = &get_requestor_ip();  
     }  
     $$storehash{'host'}=$perlvar{'lonHostID'};      $$storehash{'host'}=$perlvar{'lonHostID'};
   
     my $namevalue='';      my $namevalue='';
Line 6786  sub cstore { Line 6786  sub cstore {
         $namevalue.=&escape($key).'='.&freeze_escape($$storehash{$key}).'&';          $namevalue.=&escape($key).'='.&freeze_escape($$storehash{$key}).'&';
     }      }
     $namevalue=~s/\&$//;      $namevalue=~s/\&$//;
     unless ($nolog) {      &courselog($symb.':'.$stuname.':'.$domain.':CSTORE:'.$namevalue);
         &courselog($symb.':'.$stuname.':'.$domain.':CSTORE:'.$namevalue);  
     }  
     return critical      return critical
                 ("store:$domain:$stuname:$namespace:$symb:$namevalue:$laststore","$home");                  ("store:$domain:$stuname:$namespace:$symb:$namevalue:$laststore","$home");
 }  }
Line 7530  sub set_adhoc_privileges { Line 7528  sub set_adhoc_privileges {
         if (&allowed('adv') eq 'F') { $tadv=1; }          if (&allowed('adv') eq 'F') { $tadv=1; }
         &appenv({'request.role.adv'    => $tadv});          &appenv({'request.role.adv'    => $tadv});
     }      }
       if ($role eq 'ca') {
           my @ca_settings = ('authoreditors','coauthorlist');
           my %info = &userenvironment($dcdom,$pickedcourse,@ca_settings);
           foreach my $item (@ca_settings) {
               if (exists($info{$item})) {
                   my $name = $item;
                   if ($item eq 'authoreditors') {
                       $name = 'editors';
                       unless ($info{'authoreditors'}) {
                           my %domdefs = &get_domain_defaults($dcdom);
                           if ($domdefs{$name} ne '') {
                               $info{'authoreditors'} = $domdefs{$name};
                           } else {
                               $info{'authoreditors'} = 'edit,xml';
                           }
                       }
                   }
                   &appenv({"environment.internal.$name./$dcdom/$pickedcourse" => $info{$item}});
               }
           }
       }
 }  }
   
 # --------------------------------------------------------------- get interface  # --------------------------------------------------------------- get interface
Line 11690  sub is_course { Line 11709  sub is_course {
 }  }
   
 sub store_userdata {  sub store_userdata {
     my ($storehash,$datakey,$namespace,$udom,$uname) = @_;      my ($storehash,$datakey,$namespace,$udom,$uname,$ip) = @_;
     my $result;      my $result;
     if ($datakey ne '') {      if ($datakey ne '') {
         if (ref($storehash) eq 'HASH') {          if (ref($storehash) eq 'HASH') {
Line 11702  sub store_userdata { Line 11721  sub store_userdata {
             if (($uhome eq '') || ($uhome eq 'no_host')) {              if (($uhome eq '') || ($uhome eq 'no_host')) {
                 $result = 'error: no_host';                  $result = 'error: no_host';
             } else {              } else {
                 $storehash->{'ip'} = &get_requestor_ip();                  if ($ip ne '') {
                       $storehash->{'ip'} = $ip;
                   } else {
                       $storehash->{'ip'} = &get_requestor_ip();
                   }
                 $storehash->{'host'} = $perlvar{'lonHostID'};                  $storehash->{'host'} = $perlvar{'lonHostID'};
   
                 my $namevalue='';                  my $namevalue='';
Line 15094  sub whichuser { Line 15117  sub whichuser {
     $courseid=$tmp_courseid;      $courseid=$tmp_courseid;
     ($domain)=&get_env_multiple('form.grade_domain');      ($domain)=&get_env_multiple('form.grade_domain');
     ($name)=&get_env_multiple('form.grade_username');      ($name)=&get_env_multiple('form.grade_username');
               if ($name eq 'public' && $domain eq 'public') {
                   $publicuser = 1;
               }
     return ($symb,$courseid,$domain,$name,$publicuser);      return ($symb,$courseid,$domain,$name,$publicuser);
  }   }
     }      }
Line 15110  sub whichuser { Line 15136  sub whichuser {
     $env{'form.username'}.=time.rand(10000000);      $env{'form.username'}.=time.rand(10000000);
  }   }
  $name.=$env{'form.username'};   $name.=$env{'form.username'};
           $publicuser = 1;
     }      }
     return ($symb,$courseid,$domain,$name,$publicuser);      return ($symb,$courseid,$domain,$name,$publicuser);
   
Removed from v.1.1532  
changed lines
  Added in v.1.1537

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