Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.1172.2.146.2.24 and 1.1172.2.146.2.28

version 1.1172.2.146.2.24, 2024/09/03 09:34:26 version 1.1172.2.146.2.28, 2025/02/07 22:54:30
Line 221  sub get_server_distarch { Line 221  sub get_server_distarch {
             }              }
         }          }
         my $rep = &reply('serverdistarch',$lonhost);          my $rep = &reply('serverdistarch',$lonhost);
         unless ($rep eq 'unknown_command' || $rep eq 'no_such_host' ||          unless ($rep eq 'unknown_cmd' || $rep eq 'no_such_host' ||
                 $rep eq 'con_lost' || $rep eq 'rejected' || $rep eq 'refused' ||                  $rep eq 'con_lost' || $rep eq 'rejected' || $rep eq 'refused' ||
                 $rep eq '') {                  $rep eq '') {
             return &do_cache_new('serverdistarch',$lonhost,$rep,$cachetime);              return &do_cache_new('serverdistarch',$lonhost,$rep,$cachetime);
Line 2581  sub get_domain_defaults { Line 2581  sub get_domain_defaults {
         if (ref($domconfig{'coursedefaults'}{'postsubmit'}) eq 'HASH') {          if (ref($domconfig{'coursedefaults'}{'postsubmit'}) eq 'HASH') {
             $domdefaults{'postsubmit'} = $domconfig{'coursedefaults'}{'postsubmit'}{'client'};              $domdefaults{'postsubmit'} = $domconfig{'coursedefaults'}{'postsubmit'}{'client'};
         }          }
           if (ref($domconfig{'coursedefaults'}{'crseditors'}) eq 'ARRAY') {
               $domdefaults{'crseditors'}=join(',',@{$domconfig{'coursedefaults'}{'crseditors'}});
           }
         foreach my $type (@coursetypes) {          foreach my $type (@coursetypes) {
             if (ref($domconfig{'coursedefaults'}{'coursecredits'}) eq 'HASH') {              if (ref($domconfig{'coursedefaults'}{'coursecredits'}) eq 'HASH') {
                 unless ($type eq 'community') {                  unless ($type eq 'community') {
Line 5845  sub courselastaccess { Line 5848  sub courselastaccess {
 sub extract_lastaccess {  sub extract_lastaccess {
     my ($returnhash,$rep) = @_;      my ($returnhash,$rep) = @_;
     if (ref($returnhash) eq 'HASH') {      if (ref($returnhash) eq 'HASH') {
         unless ($rep eq 'unknown_command' || $rep eq 'no_such_host' ||           unless ($rep eq 'unknown_cmd' || $rep eq 'no_such_host' || 
                 $rep eq 'con_lost' || $rep eq 'rejected' || $rep eq 'refused' ||                  $rep eq 'con_lost' || $rep eq 'rejected' || $rep eq 'refused' ||
                  $rep eq '') {                   $rep eq '') {
             my @pairs=split(/\&/,$rep);              my @pairs=split(/\&/,$rep);
Line 6519  sub cstore { Line 6522  sub cstore {
   
     if ($stuname) { $home=&homeserver($stuname,$domain); }      if ($stuname) { $home=&homeserver($stuname,$domain); }
   
     $symb=&symbclean($symb);      unless (($symb eq '_feedback') || ($symb eq '_discussion')) {
           $symb=&symbclean($symb);
       }
     if (!$symb) { unless ($symb=&symbread()) { return ''; } }      if (!$symb) { unless ($symb=&symbread()) { return ''; } }
   
     if (!$domain) { $domain=$env{'user.domain'}; }      if (!$domain) { $domain=$env{'user.domain'}; }
     if (!$stuname) { $stuname=$env{'user.name'}; }      if (!$stuname) { $stuname=$env{'user.name'}; }
   
     &devalidate($symb,$stuname,$domain);      unless (($symb eq '_feedback') || ($symb eq '_discussion')) {
           &devalidate($symb,$stuname,$domain);
       }
   
     $symb=escape($symb);      $symb=escape($symb);
     if (!$namespace) {       if (!$namespace) { 
Line 6535  sub cstore { Line 6542  sub cstore {
     }      }
     if (!$home) { $home=$env{'user.home'}; }      if (!$home) { $home=$env{'user.home'}; }
   
     $$storehash{'ip'}=&get_requestor_ip();      $$storehash{'ip'} = &get_requestor_ip();
     $$storehash{'host'}=$perlvar{'lonHostID'};      $$storehash{'host'}=$perlvar{'lonHostID'};
   
     my $namevalue='';      my $namevalue='';
Line 7285  sub set_adhoc_privileges { Line 7292  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 10118  sub auto_instsec_reformat { Line 10146  sub auto_instsec_reformat {
             my $info = &freeze_escape($instsecref);              my $info = &freeze_escape($instsecref);
             my $response=&reply('autoinstsecreformat:'.$cdom.':'.              my $response=&reply('autoinstsecreformat:'.$cdom.':'.
                                 $action.':'.$info,$server);                                  $action.':'.$info,$server);
             next if ($response =~ /(con_lost|error|no_such_host|refused|unknown_command)/);              next if ($response =~ /(con_lost|error|no_such_host|refused|unknown_cmd)/);
             my @items = split(/&/,$response);              my @items = split(/&/,$response);
             foreach my $item (@items) {              foreach my $item (@items) {
                 my ($key,$value) = split(/=/,$item);                  my ($key,$value) = split(/=/,$item);
Line 10199  sub auto_export_grades { Line 10227  sub auto_export_grades {
             my $grades = &freeze_escape($gradesref);              my $grades = &freeze_escape($gradesref);
             my $response=&reply('encrypt:autoexportgrades:'.$cdom.':'.$cnum.':'.              my $response=&reply('encrypt:autoexportgrades:'.$cdom.':'.$cnum.':'.
                                 $info.':'.$grades,$homeserver);                                  $info.':'.$grades,$homeserver);
             unless ($response =~ /(con_lost|error|no_such_host|refused|unknown_command)/) {              unless ($response =~ /(con_lost|error|no_such_host|refused|unknown_cmd)/) {
                 my @items = split(/&/,$response);                  my @items = split(/&/,$response);
                 foreach my $item (@items) {                  foreach my $item (@items) {
                     my ($key,$value) = split('=',$item);                      my ($key,$value) = split('=',$item);
Line 11321  sub is_course { Line 11349  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 11333  sub store_userdata { Line 11361  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='';

Removed from v.1.1172.2.146.2.24  
changed lines
  Added in v.1.1172.2.146.2.28


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