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

version 1.117, 2006/06/30 04:23:25 version 1.124, 2007/08/29 00:50:50
Line 56  my $retfrid; # variable with the very fi Line 56  my $retfrid; # variable with the very fi
 my $retfurl; # first URL  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 106  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}) {       if ($hash{'map_pc_'.$uri}) { 
  $errtext.=&mt('<br />Multiple use of sequence/page <tt>[_1]</tt>! The course will not function properly.',$uri);   $errtext.='<p class="LC_error">'.
       &mt('Multiple use of sequence/page [_1]! The course will not function properly.','<tt>'.$uri.'</tt>').
       '</p>';
  return;    return; 
     }      }
     $pc++;      $pc++;
Line 129  sub loadmap { Line 132  sub loadmap {
   
     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|grppg|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=  
  &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_)*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.=&mt('<br />Map not loaded: The file <tt>[_1]</tt> does not exist.',$fn);   $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 348  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 579  sub readmap { Line 668  sub readmap {
  %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,
Line 595  sub readmap { Line 685  sub readmap {
     &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 726  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.117  
changed lines
  Added in v.1.124


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