[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.1077 and 1.1081

version 1.1077, 2010/07/25 02:58:05 version 1.1081, 2010/08/17 22:22:05
Line 76  use HTTP::Date; Line 76  use HTTP::Date;
 use Image::Magick;  use Image::Magick;
   
 use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir  use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir
             $_64bit %env %protocol %loncaparevs %serverhomeIDs);              $_64bit %env %protocol %loncaparevs %serverhomeIDs %needsrelease);
   
 my (%badServerCache, $memcache, %courselogs, %accesshash, %domainrolehash,  my (%badServerCache, $memcache, %courselogs, %accesshash, %domainrolehash,
     %userrolehash, $processmarker, $dumpcount, %coursedombuf,      %userrolehash, $processmarker, $dumpcount, %coursedombuf,
Line 222  sub get_server_loncaparev { Line 222  sub get_server_loncaparev {
         my @ids=&current_machine_ids();          my @ids=&current_machine_ids();
         if (grep(/^\Q$lonhost\E$/,@ids)) {          if (grep(/^\Q$lonhost\E$/,@ids)) {
             $answer = $perlvar{'lonVersion'};              $answer = $perlvar{'lonVersion'};
             if ($answer =~ /^[\'\"]?([\d.\-]+)[\'\"]?$/) {              if ($answer =~ /^[\'\"]?([\w.\-]+)[\'\"]?$/) {
                 $loncaparev = $1;                  $loncaparev = $1;
             }              }
         } else {          } else {
Line 238  sub get_server_loncaparev { Line 238  sub get_server_loncaparev {
                     my $response=$ua->request($request);                      my $response=$ua->request($request);
                     unless ($response->is_error()) {                      unless ($response->is_error()) {
                         my $content = $response->content;                          my $content = $response->content;
                         if ($content =~ /<p>VERSION\:\s*([\d.\-]+)<\/p>/) {                          if ($content =~ /<p>VERSION\:\s*([\w.\-]+)<\/p>/) {
                             $loncaparev = $1;                              $loncaparev = $1;
                         }                          }
                     }                      }
                 } else {                  } else {
                     $loncaparev = $loncaparevs{$lonhost};                      $loncaparev = $loncaparevs{$lonhost};
                 }                  }
             } elsif ($answer =~ /^[\'\"]?([\d.\-]+)[\'\"]?$/) {              } elsif ($answer =~ /^[\'\"]?([\w.\-]+)[\'\"]?$/) {
                 $loncaparev = $1;                  $loncaparev = $1;
             }              }
         }          }
Line 3904  sub coursedescription { Line 3904  sub coursedescription {
     return %returnhash;      return %returnhash;
 }  }
   
   sub update_released_required {
       my ($needsrelease,$cdom,$cnum,$chome,$cid) = @_;
       if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
           $cid = $env{'request.course.id'};
           $cdom = $env{'course.'.$cid.'.domain'};
           $cnum = $env{'course.'.$cid.'.num'};
           $chome = $env{'course.'.$cid.'.home'};
       }
       if ($needsrelease) {
           my %curr_reqd_hash = &userenvironment($cdom,$cnum,'internal.releaserequired');
           my $needsupdate;
           if ($curr_reqd_hash{'internal.releaserequired'} eq '') {
               $needsupdate = 1;
           } else {
               my ($currmajor,$currminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
               my ($needsmajor,$needsminor) = split(/\./,$needsrelease);
               if (($currmajor < $needsmajor) || ($currmajor == $needsmajor && $currminor < $needsminor)) {
                   $needsupdate = 1;
               }
           }
           if ($needsupdate) {
               my %needshash = (
                                'internal.releaserequired' => $needsrelease,
                               );
               my $putresult = &put('environment',\%needshash,$cdom,$cnum);
               if ($putresult eq 'ok') {
                   &appenv({'course.'.$cid.'.internal.releaserequired' => $needsrelease});
                   my %crsinfo = &courseiddump($cdom,'.',1,'.','.',$cnum,undef,undef,'.');
                   if (ref($crsinfo{$cid}) eq 'HASH') {
                       $crsinfo{$cid}{'releaserequired'} = $needsrelease;
                       &courseidput($cdom,\%crsinfo,$chome,'notime');
                   }
               }
           }
       }
       return;
   }
   
 # -------------------------------------------------See if a user is privileged  # -------------------------------------------------See if a user is privileged
   
 sub privileged {  sub privileged {
Line 3943  sub rolesinit { Line 3981  sub rolesinit {
     my ($domain,$username,$authhost)=@_;      my ($domain,$username,$authhost)=@_;
     my $now=time;      my $now=time;
     my %userroles = ('user.login.time' => $now);      my %userroles = ('user.login.time' => $now);
     my $rolesdump=reply("dump:$domain:$username:roles",$authhost);      my $extra = &freeze_escape({'clientcheckrole' => 1});
       my $rolesdump=reply("dump:$domain:$username:roles:.::$extra",$authhost);
     if (($rolesdump eq 'con_lost') || ($rolesdump eq '') ||       if (($rolesdump eq 'con_lost') || ($rolesdump eq '') || 
         ($rolesdump =~ /^error:/)) {           ($rolesdump =~ /^error:/)) {
         return \%userroles;          return \%userroles;
     }      }
     my %allroles=();      my %allroles=();
Line 10138  sub get_dns { Line 10177  sub get_dns {
   
 }  }
   
   sub all_loncaparevs {
       return qw(1.1 1.2 1.3 2.0 2.1 2.2 2.3 2.4 2.5 2.6 2.7 2.8 2.9 2.10);
   }
   
 BEGIN {  BEGIN {
   
 # ----------------------------------- Read loncapa.conf and loncapa_apache.conf  # ----------------------------------- Read loncapa.conf and loncapa_apache.conf
Line 10241  BEGIN { Line 10284  BEGIN {
     }      }
 }  }
   
 sub all_loncaparevs {  {
     return qw(1.1 1.2 1.3 2.0 2.1 2.2 2.3 2.4 2.5 2.6 2.7 2.8 2.9 2.10);      my $file = $Apache::lonnet::perlvar{'lonTabDir'}.'/releaseslist.xml';
       if (-e $file) {
           my $parser = HTML::LCParser->new($file);
           while (my $token = $parser->get_token()) {
               if ($token->[0] eq 'S') {
                   my $item = $token->[1];
                   my $name = $token->[2]{'name'};
                   my $value = $token->[2]{'value'};
                   if ($item ne '' && $name ne '' && $value ne '') {
                       my $release = $parser->get_text();
                       $release =~ s/(^\s*|\s*$ )//gx;
                       $needsrelease{$item.':'.$name.':'.$value} = $release;
                   }
               }
           }
       }
 }  }
   
 # ------------- set up temporary directory  # ------------- set up temporary directory
Removed from v.1.1077  
changed lines
  Added in v.1.1081

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