[BACK]Return to lonuserstate.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / rat

Diff for /rat/lonuserstate.pm between versions 1.107.2.2 and 1.124

version 1.107.2.2, 2006/05/11 23:59:11 version 1.124, 2007/08/29 00:50:50
Line 33  package Apache::lonuserstate; Line 33  package Apache::lonuserstate;
 use strict;  use strict;
 use HTML::TokeParser;  use HTML::TokeParser;
 use Apache::lonnet;  use Apache::lonnet;
   use Apache::lonlocal;
 use Apache::loncommon();  use Apache::loncommon();
 use GDBM_File;  use GDBM_File;
 use Apache::lonmsg;  use Apache::lonmsg;
Line 41  use Safe::Hole; Line 42  use Safe::Hole;
 use Opcode;  use Opcode;
 use Apache::lonenc;  use Apache::lonenc;
 use Fcntl qw(:flock);  use Fcntl qw(:flock);
   use LONCAPA;
    
   
 # ---------------------------------------------------- Globals for this package  # ---------------------------------------------------- Globals for this package
   
Line 49  my %hash;    # The big tied hash Line 52  my %hash;    # The big tied hash
 my %parmhash;# The hash with the parameters  my %parmhash;# The hash with the parameters
 my @cond;    # Array with all of the conditions  my @cond;    # Array with all of the conditions
 my $errtext; # variable with all errors  my $errtext; # variable with all errors
 my $retfurl; # variable with the very first URL in the course  my $retfrid; # variable with the very first RID in the course
   my $retfurl; # first URL
 my %randompick; # randomly picked resources  my %randompick; # randomly picked resources
 my %randompickseed; # optional seed for randomly picking resources  my %randompickseed; # optional seed for randomly picking resources
   my %randomorder; # maps to order contents randomly
 my %encurl; # URLs in this folder are supposed to be encrypted  my %encurl; # URLs in this folder are supposed to be encrypted
 my %hiddenurl; # this URL (or complete folder) is supposed to be hidden  my %hiddenurl; # this URL (or complete folder) is supposed to be hidden
   
Line 102  sub processversionfile { Line 107  sub processversionfile {
 # --------------------------------------------------------- Loads map from disk  # --------------------------------------------------------- Loads map from disk
   
 sub loadmap {   sub loadmap { 
     my $uri=shift;      my ($uri,$parent_rid)=@_;
     if ($hash{'map_pc_'.$uri}) { return; }      if ($hash{'map_pc_'.$uri}) { 
    $errtext.='<p class="LC_error">'.
       &mt('Multiple use of sequence/page [_1]! The course will not function properly.','<tt>'.$uri.'</tt>').
       '</p>';
    return; 
       }
     $pc++;      $pc++;
     my $lpc=$pc;      my $lpc=$pc;
     $hash{'map_pc_'.$uri}=$lpc;      $hash{'map_pc_'.$uri}=$lpc;
Line 117  sub loadmap { Line 126  sub loadmap {
   
     unless (($fn=~/\.sequence$/) ||      unless (($fn=~/\.sequence$/) ||
             ($fn=~/\.page$/)) {               ($fn=~/\.page$/)) { 
  $errtext.="Invalid map: $fn\n";   $errtext.=&mt("<br />Invalid map: <tt>[_1]</tt>",$fn);
  return;    return; 
     }      }
   
     my $instr=&Apache::lonnet::getfile($fn);      my $instr=&Apache::lonnet::getfile($fn);
   
     unless ($instr eq -1) {      if ($instr eq -1) {
           $errtext.=&mt('<br />Map not loaded: The file <tt>[_1]</tt> does not exist.',$fn);
    return;
       }
   
 # Successfully got file, parse it  # Successfully got file, parse it
   
         my $parser = HTML::TokeParser->new(\$instr);      my $parser = HTML::TokeParser->new(\$instr);
  $parser->attr_encoded(1);      $parser->attr_encoded(1);
         my $token;      # first get all parameters
       while (my $token = $parser->get_token) {
         my $linkpc=0;   next if ($token->[0] ne 'S');
    if ($token->[1] eq 'param') {
       &parse_param($token,$lpc);
    } 
       }
       #reset parser
       $parser = HTML::TokeParser->new(\$instr);
       $parser->attr_encoded(1);
   
       my $linkpc=0;
   
       $fn=~/\.(\w+)$/;
   
       $hash{'map_type_'.$lpc}=$1;
   
       my $randomize = ($randomorder{$parent_rid} =~ /^yes$/i);
   
       my @map_ids;
       while (my $token = $parser->get_token) {
    next if ($token->[0] ne 'S');
    if ($token->[1] eq 'resource') {
       push(@map_ids,&parse_resource($token,$lpc,$ispage,$uri));
    } elsif ($token->[1] eq 'link' && !$randomize) {
   # ----------------------------------------------------------------------- Links
       &make_link(++$linkpc,$lpc,$token->[2]->{'to'},
          $token->[2]->{'from'},
          $token->[2]->{'condition'});
    } elsif ($token->[1] eq 'condition' && !$randomize) {
       &parse_condition($token,$lpc);
    }
       }
   
         $fn=~/\.(\w+)$/;      if ($randomize) {
    if (!$env{'request.role.adv'}) {
       my $seed;
       if (defined($randompickseed{$parent_rid})) {
    $seed = $randompickseed{$parent_rid};
       } else {
    my ($mapid,$resid)=split(/\./,$parent_rid);
    my $symb=
       &Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},
    $resid,$hash{'src_'.$parent_rid});
   
    $seed = $symb;
       }
   
       my $rndseed=&Apache::lonnet::rndseed($seed);
       &Apache::lonnet::setup_random_from_rndseed($rndseed);
       @map_ids=&Math::Random::random_permutation(@map_ids);
    }
    my $from = shift(@map_ids);
    my $from_rid = $lpc.'.'.$from;
    $hash{'map_start_'.$uri} = $from_rid;
    $hash{'type_'.$from_rid}='start';
   
    while (my $to = shift(@map_ids)) {
       &make_link(++$linkpc,$lpc,$to,$from);
       my $to_rid =  $lpc.'.'.$to;
       $hash{'type_'.$to_rid}='normal';
       $from = $to;
       $from_rid = $to_rid;
    }
   
    $hash{'map_finish_'.$uri}= $from_rid;
    $hash{'type_'.$from_rid}='finish';
       }
   
       my $parser = HTML::TokeParser->new(\$instr);
       $parser->attr_encoded(1);
       # last parse out the mapalias params so as to ignore anything
       # refering to non-existant resources
       while (my $token = $parser->get_token) {
    next if ($token->[0] ne 'S');
    if ($token->[1] eq 'param') {
       &parse_mapalias_param($token,$lpc);
    } 
       }
   }
   
         $hash{'map_type_'.$lpc}=$1;  
   
         while ($token = $parser->get_token) {  
     if ($token->[0] eq 'S') {  
                 if ($token->[1] eq 'resource') {  
 # -------------------------------------------------------------------- Resource  # -------------------------------------------------------------------- Resource
                     if ($token->[2]->{'type'} eq 'zombie') { next; }  sub parse_resource {
                     my $rid=$lpc.'.'.$token->[2]->{'id'};      my ($token,$lpc,$ispage,$uri) = @_;
       if ($token->[2]->{'type'} eq 'zombie') { next; }
                     $hash{'kind_'.$rid}='res';      my $rid=$lpc.'.'.$token->[2]->{'id'};
                     $hash{'title_'.$rid}=$token->[2]->{'title'};      
                     my $turi=&versiontrack($token->[2]->{'src'});      $hash{'kind_'.$rid}='res';
                     if ($token->[2]->{'version'}) {      $hash{'title_'.$rid}=$token->[2]->{'title'};
  unless ($hash{'version_'.$turi}) {      my $turi=&versiontrack($token->[2]->{'src'});
     $hash{'version_'.$turi}=$1;      if ($token->[2]->{'version'}) {
  }   unless ($hash{'version_'.$turi}) {
     }      $hash{'version_'.$turi}=$1;
     my $title=$token->[2]->{'title'};   }
     $title=~s/\&colon\;/\:/gs;      }
 #    my $symb=&Apache::lonnet::encode_symb($uri,      my $title=$token->[2]->{'title'};
 #  $token->[2]->{'id'},      $title=~s/\&colon\;/\:/gs;
 #  $turi);  #   my $symb=&Apache::lonnet::encode_symb($uri,
 #    &Apache::lonnet::do_cache_new('title',$symb,$title);  #  $token->[2]->{'id'},
                     unless ($ispage) {  #  $turi);
                         $turi=~/\.(\w+)$/;  #   &Apache::lonnet::do_cache_new('title',$symb,$title);
                         my $embstyle=&Apache::loncommon::fileembstyle($1);      unless ($ispage) {
                         if ($token->[2]->{'external'} eq 'true') { # external   $turi=~/\.(\w+)$/;
                             $turi=~s/^http\:\/\//\/adm\/wrapper\/ext\//;   my $embstyle=&Apache::loncommon::fileembstyle($1);
                         } elsif ($turi=~/^\/*uploaded\//) { # uploaded   if ($token->[2]->{'external'} eq 'true') { # external
     if (($embstyle eq 'img')       $turi=~s/^http\:\/\//\/adm\/wrapper\/ext\//;
  || ($embstyle eq 'emb')   } elsif ($turi=~/^\/*uploaded\//) { # uploaded
  || ($embstyle eq 'wrp')) {      if (($embstyle eq 'img') 
                                 $turi='/adm/wrapper'.$turi;   || ($embstyle eq 'emb')
     } elsif ($embstyle eq 'ssi') {   || ($embstyle eq 'wrp')) {
  #do nothing with these   $turi='/adm/wrapper'.$turi;
     } elsif ($turi!~/\.(sequence|page)$/) {      } elsif ($embstyle eq 'ssi') {
  $turi='/adm/coursedocs/showdoc'.$turi;   #do nothing with these
                             }      } elsif ($turi!~/\.(sequence|page)$/) {
                         } elsif ($turi=~/\S/) { # normal non-empty internal resource   $turi='/adm/coursedocs/showdoc'.$turi;
     my $mapdir=$uri;      }
     $mapdir=~s/[^\/]+$//;   } elsif ($turi=~/\S/) { # normal non-empty internal resource
     $turi=&Apache::lonnet::hreflocation($mapdir,$turi);      my $mapdir=$uri;
     if (($embstyle eq 'img')       $mapdir=~s/[^\/]+$//;
  || ($embstyle eq 'emb')      $turi=&Apache::lonnet::hreflocation($mapdir,$turi);
  || ($embstyle eq 'wrp')) {      if (($embstyle eq 'img') 
  $turi='/adm/wrapper'.$turi;   || ($embstyle eq 'emb')
     }   || ($embstyle eq 'wrp')) {
                         }   $turi='/adm/wrapper'.$turi;
     }      }
    }
       }
 # Store reverse lookup, remove query string  # Store reverse lookup, remove query string
     my $idsuri=$turi;      my $idsuri=$turi;
     $idsuri=~s/\?.+$//;      $idsuri=~s/\?.+$//;
                     if (defined($hash{'ids_'.$idsuri})) {      if (defined($hash{'ids_'.$idsuri})) {
                         $hash{'ids_'.$idsuri}.=','.$rid;   $hash{'ids_'.$idsuri}.=','.$rid;
                     } else {      } else {
                         $hash{'ids_'.$idsuri}=''.$rid;   $hash{'ids_'.$idsuri}=''.$rid;
                     }      }
                      
                     if ($turi=~/\/(syllabus|aboutme|navmaps|smppg|bulletinboard)$/) {      if ($turi=~/\/(syllabus|aboutme|navmaps|smppg|bulletinboard)$/) {
  $turi.='?register=1';   $turi.='?register=1';
     }      }
       
                     $hash{'src_'.$rid}=$turi;      $hash{'src_'.$rid}=$turi;
       
                     if ($token->[2]->{'external'} eq 'true') {      if ($token->[2]->{'external'} eq 'true') {
                         $hash{'ext_'.$rid}='true:';   $hash{'ext_'.$rid}='true:';
                     } else {      } else {
                         $hash{'ext_'.$rid}='false:';   $hash{'ext_'.$rid}='false:';
                     }      }
                     if ($token->[2]->{'type'}) {      if ($token->[2]->{'type'}) {
  $hash{'type_'.$rid}=$token->[2]->{'type'};   $hash{'type_'.$rid}=$token->[2]->{'type'};
                         if ($token->[2]->{'type'} eq 'start') {   if ($token->[2]->{'type'} eq 'start') {
     $hash{'map_start_'.$uri}="$rid";      $hash{'map_start_'.$uri}="$rid";
                         }   }
                         if ($token->[2]->{'type'} eq 'finish') {   if ($token->[2]->{'type'} eq 'finish') {
     $hash{'map_finish_'.$uri}="$rid";      $hash{'map_finish_'.$uri}="$rid";
                         }   }
                     }  else {      }  else {
                         $hash{'type_'.$rid}='normal';   $hash{'type_'.$rid}='normal';
                     }      }
       
                     if (($turi=~/\.sequence$/) ||      if (($turi=~/\.sequence$/) ||
                         ($turi=~/\.page$/)) {   ($turi=~/\.page$/)) {
                         $hash{'is_map_'.$rid}=1;   $hash{'is_map_'.$rid}=1;
                         &loadmap($turi);   &loadmap($turi,$rid);
                     }       } 
                           return $token->[2]->{'id'};
                 } elsif ($token->[1] eq 'condition') {  }
 # ------------------------------------------------------------------- Condition  
   
                     my $rid=$lpc.'.'.$token->[2]->{'id'};  
   
                     $hash{'kind_'.$rid}='cond';  sub make_link {
                     $cond[$#cond+1]=$token->[2]->{'value'};      my ($linkpc,$lpc,$to,$from,$condition) = @_;
                     $hash{'condid_'.$rid}=$#cond;      
                     if ($token->[2]->{'type'}) {      my $linkid=$lpc.'.'.$linkpc;
                         $cond[$#cond].=':'.$token->[2]->{'type'};      my $goesto=$lpc.'.'.$to;
                     }  else {      my $comesfrom=$lpc.'.'.$from;
                         $cond[$#cond].=':normal';      my $undercond=0;
                     }  
       if ($condition) {
    $undercond=$lpc.'.'.$condition;
       }
   
       $hash{'goesto_'.$linkid}=$goesto;
       $hash{'comesfrom_'.$linkid}=$comesfrom;
       $hash{'undercond_'.$linkid}=$undercond;
   
                 } elsif ($token->[1] eq 'link') {      if (defined($hash{'to_'.$comesfrom})) {
 # ----------------------------------------------------------------------- Links   $hash{'to_'.$comesfrom}.=','.$linkid;
       } else {
    $hash{'to_'.$comesfrom}=''.$linkid;
       }
       if (defined($hash{'from_'.$goesto})) {
    $hash{'from_'.$goesto}.=','.$linkid;
       } else {
    $hash{'from_'.$goesto}=''.$linkid;
       }
   }
   
                     $linkpc++;  # ------------------------------------------------------------------- Condition
                     my $linkid=$lpc.'.'.$linkpc;  sub parse_condition {
       my ($token,$lpc) = @_;
       my $rid=$lpc.'.'.$token->[2]->{'id'};
       
       $hash{'kind_'.$rid}='cond';
   
       my $condition = $token->[2]->{'value'};
       $condition =~ s/[\n\r]+/ /gs;
       push(@cond, $condition);
       $hash{'condid_'.$rid}=$#cond;
       if ($token->[2]->{'type'}) {
    $cond[$#cond].=':'.$token->[2]->{'type'};
       }  else {
    $cond[$#cond].=':normal';
       }
   }
   
                     my $goesto=$lpc.'.'.$token->[2]->{'to'};  
                     my $comesfrom=$lpc.'.'.$token->[2]->{'from'};  
                     my $undercond=0;  
   
                     if ($token->[2]->{'condition'}) {  
  $undercond=$lpc.'.'.$token->[2]->{'condition'};  
                     }  
   
                     $hash{'goesto_'.$linkid}=$goesto;  
                     $hash{'comesfrom_'.$linkid}=$comesfrom;  
                     $hash{'undercond_'.$linkid}=$undercond;  
   
                     if (defined($hash{'to_'.$comesfrom})) {  
                         $hash{'to_'.$comesfrom}.=','.$linkid;  
                     } else {  
                         $hash{'to_'.$comesfrom}=''.$linkid;  
                     }  
                     if (defined($hash{'from_'.$goesto})) {  
                         $hash{'from_'.$goesto}.=','.$linkid;  
                     } else {  
                         $hash{'from_'.$goesto}=''.$linkid;  
                     }  
                 } elsif ($token->[1] eq 'param') {  
 # ------------------------------------------------------------------- Parameter  # ------------------------------------------------------------------- Parameter
   
                     my $referid=$lpc.'.'.$token->[2]->{'to'};  sub parse_param {
     my $name=$token->[2]->{'name'};      my ($token,$lpc) = @_;
     my $part;      my $referid=$lpc.'.'.$token->[2]->{'to'};
     if ($name=~/^parameter_(.*)_/) {      my $name=$token->[2]->{'name'};
  $part=$1;      my $part;
     } else {      if ($name=~/^parameter_(.*)_/) {
  $part=0;   $part=$1;
     }  
     $name=~s/^.*_([^_]*)$/$1/;  
                     my $newparam=  
  &Apache::lonnet::escape($token->[2]->{'type'}).':'.  
  &Apache::lonnet::escape($part.'.'.$name).'='.  
  &Apache::lonnet::escape($token->[2]->{'value'});  
                     if (defined($hash{'param_'.$referid})) {  
                         $hash{'param_'.$referid}.='&'.$newparam;  
                     } else {  
                         $hash{'param_'.$referid}=''.$newparam;  
                     }  
                     if ($token->[2]->{'name'}=~/^parameter_(0_)*mapalias$/) {  
  $hash{'mapalias_'.$token->[2]->{'value'}}=$referid;  
                     }  
                     if ($token->[2]->{'name'}=~/^parameter_(0_)*randompick$/) {  
  $randompick{$referid}=$token->[2]->{'value'};  
                     }  
                     if ($token->[2]->{'name'}=~/^parameter_(0_)*randompickseed$/) {  
  $randompick{$referid}=$token->[2]->{'value'};  
                     }  
                     if ($token->[2]->{'name'}=~/^parameter_(0_)*encrypturl$/) {  
  if ($token->[2]->{'value'}=~/^yes$/i) {  
     $encurl{$referid}=1;  
  }  
                     }  
                     if ($token->[2]->{'name'}=~/^parameter_(0_)*hiddenresource$/) {  
  if ($token->[2]->{'value'}=~/^yes$/i) {  
     $hiddenurl{$referid}=1;  
  }  
                     }  
                 }   
   
             }  
         }  
   
     } else {      } else {
         $errtext.='Map not loaded: The file ('.$fn.') does not exist. ';   $part=0;
       }
       $name=~s/^.*_([^_]*)$/$1/;
       my $newparam=
    &escape($token->[2]->{'type'}).':'.
    &escape($part.'.'.$name).'='.
    &escape($token->[2]->{'value'});
       if (defined($hash{'param_'.$referid})) {
    $hash{'param_'.$referid}.='&'.$newparam;
       } else {
    $hash{'param_'.$referid}=''.$newparam;
       }
       if ($token->[2]->{'name'}=~/^parameter_(0_)*randompick$/) {
    $randompick{$referid}=$token->[2]->{'value'};
       }
       if ($token->[2]->{'name'}=~/^parameter_(0_)*randompickseed$/) {
    $randompickseed{$referid}=$token->[2]->{'value'};
       }
       if ($token->[2]->{'name'}=~/^parameter_(0_)*randomorder$/) {
    $randomorder{$referid}=$token->[2]->{'value'};
       }
       if ($token->[2]->{'name'}=~/^parameter_(0_)*encrypturl$/) {
    if ($token->[2]->{'value'}=~/^yes$/i) {
       $encurl{$referid}=1;
    }
       }
       if ($token->[2]->{'name'}=~/^parameter_(0_)*hiddenresource$/) {
    if ($token->[2]->{'value'}=~/^yes$/i) {
       $hiddenurl{$referid}=1;
    }
       }
   }
   
   sub parse_mapalias_param {
       my ($token,$lpc) = @_;
       my $referid=$lpc.'.'.$token->[2]->{'to'};
       return if (!exists($hash{'src_'.$referid}));
   
       if ($token->[2]->{'name'}=~/^parameter_(0_)*mapalias$/) {
    &count_mapalias($token->[2]->{'value'},$referid);
    $hash{'mapalias_'.$token->[2]->{'value'}}=$referid;
     }      }
 }  }
   
Line 342  sub simplify { Line 437  sub simplify {
 sub traceroute {  sub traceroute {
     my ($sofar,$rid,$beenhere,$encflag,$hdnflag)=@_;      my ($sofar,$rid,$beenhere,$encflag,$hdnflag)=@_;
     my $newsofar=$sofar=simplify($sofar);      my $newsofar=$sofar=simplify($sofar);
     unless ($beenhere=~/\&$rid\&/) {      unless ($beenhere=~/\&\Q$rid\E\&/) {
  $beenhere.=$rid.'&';     $beenhere.=$rid.'&';  
  my ($mapid,$resid)=split(/\./,$rid);   my ($mapid,$resid)=split(/\./,$rid);
  my $symb=&Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid,$hash{'src_'.$rid});   my $symb=&Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid,$hash{'src_'.$rid});
Line 357  sub traceroute { Line 452  sub traceroute {
   
  my $encrypt=&Apache::lonnet::EXT('resource.0.encrypturl',$symb);   my $encrypt=&Apache::lonnet::EXT('resource.0.encrypturl',$symb);
  if ($encflag || lc($encrypt) eq 'yes') { $encurl{$rid}=1; }   if ($encflag || lc($encrypt) eq 'yes') { $encurl{$rid}=1; }
  if (($retfurl eq '') && ($hash{'src_'.$rid})   if (($retfrid eq '') && ($hash{'src_'.$rid})
     && ($hash{'src_'.$rid}!~/\.sequence$/)) {      && ($hash{'src_'.$rid}!~/\.sequence$/)) {
     $retfurl=$hash{'src_'.$rid}.(($hash{'src_'.$rid}=~/\?/)?'&':'?').      $retfrid=$rid;
  'symb='.$symb;  
  }   }
  if (defined($hash{'conditions_'.$rid})) {   if (defined($hash{'conditions_'.$rid})) {
     $hash{'conditions_'.$rid}=simplify(      $hash{'conditions_'.$rid}=simplify(
Line 390  sub traceroute { Line 484  sub traceroute {
  $further=simplify('('.'_'.$rid.')&('.   $further=simplify('('.'_'.$rid.')&('.
   $hash{'condid_'.$hash{'undercond_'.$id}}.')');    $hash{'condid_'.$hash{'undercond_'.$id}}.')');
     } else {      } else {
  $errtext.='Undefined condition ID: '   $errtext.=&mt('<br />Undefined condition ID: [_1]',$hash{'undercond_'.$id});
     .$hash{'undercond_'.$id}.'. ';  
     }      }
                 }                  }
                 $newsofar=&traceroute($further,$hash{'goesto_'.$id},$beenhere,                  $newsofar=&traceroute($further,$hash{'goesto_'.$id},$beenhere,
Line 438  sub accinit { Line 531  sub accinit {
     foreach my $param (split(/\&/,$hash{$key})) {      foreach my $param (split(/\&/,$hash{$key})) {
  my ($typename,$value)=split(/\=/,$param);   my ($typename,$value)=split(/\=/,$param);
  my ($type,$name)=split(/\:/,$typename);   my ($type,$name)=split(/\:/,$typename);
  $parmhash{$prefix.'.'.&Apache::lonnet::unescape($name)}=   $parmhash{$prefix.'.'.&unescape($name)}=
     &Apache::lonnet::unescape($value);      &unescape($value);
  $parmhash{$prefix.'.'.&Apache::lonnet::unescape($name).'.type'}=   $parmhash{$prefix.'.'.&unescape($name).'.type'}=
     &Apache::lonnet::unescape($type);      &unescape($type);
     }      }
  }   }
     }      }
Line 545  sub hiddenurls { Line 638  sub hiddenurls {
 sub readmap {  sub readmap {
     my $short=shift;      my $short=shift;
     $short=~s/^\///;      $short=~s/^\///;
     my %cenv=&Apache::lonnet::coursedescription($short);      my %cenv=&Apache::lonnet::coursedescription($short,{'freshen_cache'=>1});
     my $fn=$cenv{'fn'};      my $fn=$cenv{'fn'};
     my $uri;      my $uri;
     $short=~s/\//\_/g;      $short=~s/\//\_/g;
     unless ($uri=$cenv{'url'}) {       unless ($uri=$cenv{'url'}) { 
  &Apache::lonnet::logthis("<font color=blue>WARNING: ".   &Apache::lonnet::logthis("<font color=blue>WARNING: ".
  "Could not load course $short.</font>");    "Could not load course $short.</font>"); 
  return 'No course data available.';   return ('',&mt('No course data available.'));;
     }      }
     @cond=('true:normal');      @cond=('true:normal');
   
Line 568  sub readmap { Line 661  sub readmap {
     undef %randompick;      undef %randompick;
     undef %hiddenurl;      undef %hiddenurl;
     undef %encurl;      undef %encurl;
     $retfurl='';      $retfrid='';
     if ($lock && (tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT(),0640)) &&      if ($lock && (tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT(),0640)) &&
  (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_WRCREAT(),0640))) {   (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_WRCREAT(),0640))) {
  %hash=();   %hash=();
  %parmhash=();   %parmhash=();
  $errtext='';   $errtext='';
  $pc=0;   $pc=0;
    &clear_mapalias_count();
  &processversionfile(%cenv);   &processversionfile(%cenv);
  my $furi=&Apache::lonnet::clutter($uri);   my $furi=&Apache::lonnet::clutter($uri);
  $hash{'src_0.0'}=&versiontrack($furi);   $hash{'src_0.0'}=&versiontrack($furi);
  $hash{'title_0.0'}=&Apache::lonnet::metadata($uri,'title');   $hash{'title_0.0'}=&Apache::lonnet::metadata($uri,'title');
  $hash{'ids_'.$furi}='0.0';   $hash{'ids_'.$furi}='0.0';
  $hash{'is_map_0.0'}=1;   $hash{'is_map_0.0'}=1;
  loadmap($uri);   loadmap($uri,'0.0');
  if (defined($hash{'map_start_'.$uri})) {   if (defined($hash{'map_start_'.$uri})) {
     &Apache::lonnet::appenv("request.course.id"  => $short,      &Apache::lonnet::appenv("request.course.id"  => $short,
     "request.course.fn"  => $fn,      "request.course.fn"  => $fn,
     "request.course.uri" => $uri);      "request.course.uri" => $uri);
       $env{'request.course.id'}=$short;
     &traceroute('0',$hash{'map_start_'.$uri},'&');      &traceroute('0',$hash{'map_start_'.$uri},'&');
     &accinit($uri,$short,$fn);      &accinit($uri,$short,$fn);
     &hiddenurls();      &hiddenurls();
  }   }
    $errtext .= &get_mapalias_errors();
 # ------------------------------------------------------- Put versions into src  # ------------------------------------------------------- Put versions into src
  foreach my $key (keys(%hash)) {   foreach my $key (keys(%hash)) {
     if ($key=~/^src_/) {      if ($key=~/^src_/) {
Line 597  sub readmap { Line 693  sub readmap {
     } elsif ($key =~ /^(map_(?:start|finish|pc)_)(.*)/) {      } elsif ($key =~ /^(map_(?:start|finish|pc)_)(.*)/) {
  my ($type, $url) = ($1,$2);   my ($type, $url) = ($1,$2);
  my $value = $hash{$key};   my $value = $hash{$key};
  delete($hash{$key});  
  $hash{$type.&putinversion($url)}=$value;   $hash{$type.&putinversion($url)}=$value;
     }      }
  }   }
Line 608  sub readmap { Line 703  sub readmap {
  }   }
 # ----------------------------------------------- Close hashes to finally store  # ----------------------------------------------- Close hashes to finally store
 # --------------------------------- Routine must pass this point, no early outs  # --------------------------------- Routine must pass this point, no early outs
    $hash{'first_rid'}=$retfrid;
    my ($mapid,$resid)=split(/\./,$retfrid);
    $hash{'first_mapurl'}=$hash{'map_id_'.$mapid};
    my $symb=&Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid,$hash{'src_'.$retfrid});
    $retfurl=&add_get_param($hash{'src_'.$retfrid},{ 'symb' => $symb });
    if ($hash{'encrypted_'.$retfrid}) {
       $retfurl=&Apache::lonenc::encrypted($retfurl,(&Apache::lonnet::allowed('adv') ne 'F'));
    }
  $hash{'first_url'}=$retfurl;   $hash{'first_url'}=$retfurl;
  unless ((untie(%hash)) && (untie(%parmhash))) {   unless ((untie(%hash)) && (untie(%parmhash))) {
     &Apache::lonnet::logthis("<font color=blue>WARNING: ".      &Apache::lonnet::logthis("<font color=blue>WARNING: ".
Line 682  sub evalstate { Line 785  sub evalstate {
     if (-e $fn) {      if (-e $fn) {
  my @conditions=();   my @conditions=();
  {   {
     my $fh=Apache::File->new($fn);      open(my $fh,"<$fn");
     @conditions=<$fh>;      @conditions=<$fh>;
               close($fh);
  }     }  
  my $safeeval = new Safe;   my $safeeval = new Safe;
  my $safehole = new Safe::Hole;   my $safehole = new Safe::Hole;
Line 713  sub evalstate { Line 817  sub evalstate {
     return $state;      return $state;
 }  }
   
   {
       my %mapalias_cache;
       sub count_mapalias {
    my ($value,$resid) = @_;
     push(@{ $mapalias_cache{$value} }, $resid);
       }
   
       sub get_mapalias_errors {
    my $error_text;
    foreach my $mapalias (sort(keys(%mapalias_cache))) {
       next if (scalar(@{ $mapalias_cache{$mapalias} } ) == 1);
       my $count;
       my $which =
    join('</li><li>', 
        map {
    my $id = $_;
    if (exists($hash{'src_'.$id})) {
        $count++;
    }
    my ($mapid) = split(/\./,$id);
                            &mt('[_1] in [_2]', $hash{'title_'.$id},
   
        $hash{'title_'.$hash{'ids_'.$hash{'map_id_'.$mapid}}});
        } (@{ $mapalias_cache{$mapalias} }));
       next if ($count < 2);
       $error_text .= '<div class="LC_error">'.
    &mt('Error: Found the mapalias "[_1]" defined multiple times.',
       $mapalias).
    '</div><ul><li>'.$which.'</li></ul>';
    }
    &clear_mapalias_count();
    return $error_text;
       }
       sub clear_mapalias_count {
    undef(%mapalias_cache);
       }
   }
 1;  1;
 __END__  __END__
   
Removed from v.1.107.2.2  
changed lines
  Added in v.1.124

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.