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

Diff for /rat/lonuserstate.pm between versions 1.122 and 1.128

version 1.122, 2007/08/28 01:13:19 version 1.128, 2008/03/12 02:45: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.='<p class="LC_error">'.   $errtext.='<p class="LC_error">'.
     &mt('Multiple use of sequence/page [_1]! The course will not function properly.','<tt>'.$uri.'</tt>').      &mt('Multiple use of sequence/page [_1]! The course will not function properly.','<tt>'.$uri.'</tt>').
Line 131  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') {
         $fn=~/\.(\w+)$/;      &parse_param($token,$lpc);
    } 
         $hash{'map_type_'.$lpc}=$1;      }
       #reset parser
         while ($token = $parser->get_token) {      $parser = HTML::TokeParser->new(\$instr);
     if ($token->[0] eq 'S') {      $parser->attr_encoded(1);
                 if ($token->[1] eq 'resource') {  
 # -------------------------------------------------------------------- Resource  
                     if ($token->[2]->{'type'} eq 'zombie') { next; }  
                     my $rid=$lpc.'.'.$token->[2]->{'id'};  
   
                     $hash{'kind_'.$rid}='res';      my $linkpc=0;
                     $hash{'title_'.$rid}=$token->[2]->{'title'};  
                     my $turi=&versiontrack($token->[2]->{'src'});  
                     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,  
 #  $token->[2]->{'id'},  
 #  $turi);  
 #    &Apache::lonnet::do_cache_new('title',$symb,$title);  
                     unless ($ispage) {  
                         $turi=~/\.(\w+)$/;  
                         my $embstyle=&Apache::loncommon::fileembstyle($1);  
                         if ($token->[2]->{'external'} eq 'true') { # external  
                             $turi=~s/^http\:\/\//\/adm\/wrapper\/ext\//;  
                         } elsif ($turi=~/^\/*uploaded\//) { # uploaded  
     if (($embstyle eq 'img')   
  || ($embstyle eq 'emb')  
  || ($embstyle eq 'wrp')) {  
                                 $turi='/adm/wrapper'.$turi;  
     } elsif ($embstyle eq 'ssi') {  
  #do nothing with these  
     } elsif ($turi!~/\.(sequence|page)$/) {  
  $turi='/adm/coursedocs/showdoc'.$turi;  
                             }  
                         } elsif ($turi=~/\S/) { # normal non-empty internal resource  
     my $mapdir=$uri;  
     $mapdir=~s/[^\/]+$//;  
     $turi=&Apache::lonnet::hreflocation($mapdir,$turi);  
     if (($embstyle eq 'img')   
  || ($embstyle eq 'emb')  
  || ($embstyle eq 'wrp')) {  
  $turi='/adm/wrapper'.$turi;  
     }  
                         }  
     }  
 # Store reverse lookup, remove query string  
     my $idsuri=$turi;  
     $idsuri=~s/\?.+$//;  
                     if (defined($hash{'ids_'.$idsuri})) {  
                         $hash{'ids_'.$idsuri}.=','.$rid;  
                     } else {  
                         $hash{'ids_'.$idsuri}=''.$rid;  
                     }  
                  
                     if ($turi=~/\/(syllabus|aboutme|navmaps|smppg|bulletinboard)$/) {  
  $turi.='?register=1';  
     }  
   
                     $hash{'src_'.$rid}=$turi;      $fn=~/\.(\w+)$/;
   
                     if ($token->[2]->{'external'} eq 'true') {      $hash{'map_type_'.$lpc}=$1;
                         $hash{'ext_'.$rid}='true:';  
                     } else {  
                         $hash{'ext_'.$rid}='false:';  
                     }  
                     if ($token->[2]->{'type'}) {  
  $hash{'type_'.$rid}=$token->[2]->{'type'};  
                         if ($token->[2]->{'type'} eq 'start') {  
     $hash{'map_start_'.$uri}="$rid";  
                         }  
                         if ($token->[2]->{'type'} eq 'finish') {  
     $hash{'map_finish_'.$uri}="$rid";  
                         }  
                     }  else {  
                         $hash{'type_'.$rid}='normal';  
                     }  
   
                     if (($turi=~/\.sequence$/) ||  
                         ($turi=~/\.page$/)) {  
                         $hash{'is_map_'.$rid}=1;  
                         &loadmap($turi);  
                     }   
                       
                 } elsif ($token->[1] eq 'condition') {  
 # ------------------------------------------------------------------- Condition  
   
                     my $rid=$lpc.'.'.$token->[2]->{'id'};      my $randomize = ($randomorder{$parent_rid} =~ /^yes$/i);
   
                     $hash{'kind_'.$rid}='cond';      my @map_ids;
                     $cond[$#cond+1]=$token->[2]->{'value'};      while (my $token = $parser->get_token) {
                     $hash{'condid_'.$rid}=$#cond;   next if ($token->[0] ne 'S');
                     if ($token->[2]->{'type'}) {   if ($token->[1] eq 'resource') {
                         $cond[$#cond].=':'.$token->[2]->{'type'};      push(@map_ids,&parse_resource($token,$lpc,$ispage,$uri));
                     }  else {   } elsif ($token->[1] eq 'link' && !$randomize) {
                         $cond[$#cond].=':normal';  
                     }  
   
                 } elsif ($token->[1] eq 'link') {  
 # ----------------------------------------------------------------------- Links  # ----------------------------------------------------------------------- Links
       &make_link(++$linkpc,$lpc,$token->[2]->{'to'},
          $token->[2]->{'from'},
          $token->[2]->{'condition'});
    } elsif ($token->[1] eq 'condition' && !$randomize) {
       &parse_condition($token,$lpc);
    }
       }
   
                     $linkpc++;      if ($randomize) {
                     my $linkid=$lpc.'.'.$linkpc;   if (!$env{'request.role.adv'}) {
       my $seed;
                     my $goesto=$lpc.'.'.$token->[2]->{'to'};      if (defined($randompickseed{$parent_rid})) {
                     my $comesfrom=$lpc.'.'.$token->[2]->{'from'};   $seed = $randompickseed{$parent_rid};
                     my $undercond=0;      } else {
    my ($mapid,$resid)=split(/\./,$parent_rid);
                     if ($token->[2]->{'condition'}) {   my $symb=
  $undercond=$lpc.'.'.$token->[2]->{'condition'};      &Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},
                     }   $resid,$hash{'src_'.$parent_rid});
   
                     $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  
   
                     my $referid=$lpc.'.'.$token->[2]->{'to'};  
     my $name=$token->[2]->{'name'};  
     my $part;  
     if ($name=~/^parameter_(.*)_/) {  
  $part=$1;  
     } else {  
  $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_)*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;  
  }  
                     }  
                 }   
   
             }   $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';
   
     } else {   while (my $to = shift(@map_ids)) {
         $errtext.=&mt('<br />Map not loaded: The file <tt>[_1]</tt> does not exist.',$fn);      &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 = HTML::TokeParser->new(\$instr);
     $parser->attr_encoded(1);      $parser->attr_encoded(1);
     # last parse out the mapalias params so as to ignore anything      # last parse out the mapalias params so as to ignore anything
     # refering to non-existant resources      # refering to non-existant resources
Line 330  sub loadmap { Line 222  sub loadmap {
     }      }
 }  }
   
   
   # -------------------------------------------------------------------- Resource
   sub parse_resource {
       my ($token,$lpc,$ispage,$uri) = @_;
       if ($token->[2]->{'type'} eq 'zombie') { next; }
       my $rid=$lpc.'.'.$token->[2]->{'id'};
       
       $hash{'kind_'.$rid}='res';
       $hash{'title_'.$rid}=$token->[2]->{'title'};
       my $turi=&versiontrack($token->[2]->{'src'});
       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,
   #  $token->[2]->{'id'},
   #  $turi);
   #   &Apache::lonnet::do_cache_new('title',$symb,$title);
       unless ($ispage) {
    $turi=~/\.(\w+)$/;
    my $embstyle=&Apache::loncommon::fileembstyle($1);
    if ($token->[2]->{'external'} eq 'true') { # external
       $turi=~s/^http\:\/\//\/adm\/wrapper\/ext\//;
    } elsif ($turi=~/^\/*uploaded\//) { # uploaded
       if (($embstyle eq 'img') 
    || ($embstyle eq 'emb')
    || ($embstyle eq 'wrp')) {
    $turi='/adm/wrapper'.$turi;
       } elsif ($embstyle eq 'ssi') {
    #do nothing with these
       } elsif ($turi!~/\.(sequence|page)$/) {
    $turi='/adm/coursedocs/showdoc'.$turi;
       }
    } elsif ($turi=~/\S/) { # normal non-empty internal resource
       my $mapdir=$uri;
       $mapdir=~s/[^\/]+$//;
       $turi=&Apache::lonnet::hreflocation($mapdir,$turi);
       if (($embstyle eq 'img') 
    || ($embstyle eq 'emb')
    || ($embstyle eq 'wrp')) {
    $turi='/adm/wrapper'.$turi;
       }
    }
       }
   # Store reverse lookup, remove query string
       my $idsuri=$turi;
       $idsuri=~s/\?.+$//;
       if (defined($hash{'ids_'.$idsuri})) {
    $hash{'ids_'.$idsuri}.=','.$rid;
       } else {
    $hash{'ids_'.$idsuri}=''.$rid;
       }
       
       if ($turi=~/\/(syllabus|aboutme|navmaps|smppg|bulletinboard)$/) {
    $turi.='?register=1';
       }
       
       $hash{'src_'.$rid}=$turi;
       
       if ($token->[2]->{'external'} eq 'true') {
    $hash{'ext_'.$rid}='true:';
       } else {
    $hash{'ext_'.$rid}='false:';
       }
       if ($token->[2]->{'type'}) {
    $hash{'type_'.$rid}=$token->[2]->{'type'};
    if ($token->[2]->{'type'} eq 'start') {
       $hash{'map_start_'.$uri}="$rid";
    }
    if ($token->[2]->{'type'} eq 'finish') {
       $hash{'map_finish_'.$uri}="$rid";
    }
       }  else {
    $hash{'type_'.$rid}='normal';
       }
       
       if (($turi=~/\.sequence$/) ||
    ($turi=~/\.page$/)) {
    $hash{'is_map_'.$rid}=1;
    &loadmap($turi,$rid);
       } 
       return $token->[2]->{'id'};
   }
   
   sub make_link {
       my ($linkpc,$lpc,$to,$from,$condition) = @_;
       
       my $linkid=$lpc.'.'.$linkpc;
       my $goesto=$lpc.'.'.$to;
       my $comesfrom=$lpc.'.'.$from;
       my $undercond=0;
   
       if ($condition) {
    $undercond=$lpc.'.'.$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;
       }
   }
   
   # ------------------------------------------------------------------- Condition
   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';
       }
   }
   
   # ------------------------------------------------------------------- Parameter
   
   sub parse_param {
       my ($token,$lpc) = @_;
       my $referid=$lpc.'.'.$token->[2]->{'to'};
       my $name=$token->[2]->{'name'};
       my $part;
       if ($name=~/^parameter_(.*)_/) {
    $part=$1;
       } else {
    $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 {  sub parse_mapalias_param {
     my ($token,$lpc) = @_;      my ($token,$lpc) = @_;
     my $referid=$lpc.'.'.$token->[2]->{'to'};      my $referid=$lpc.'.'.$token->[2]->{'to'};
Line 403  sub traceroute { Line 471  sub traceroute {
     if (defined($hash{'map_start_'.$hash{'src_'.$rid}})) {      if (defined($hash{'map_start_'.$hash{'src_'.$rid}})) {
  $sofar=$newsofar=   $sofar=$newsofar=
     &traceroute($sofar,      &traceroute($sofar,
  $hash{'map_start_'.$hash{'src_'.$rid}},'&',   $hash{'map_start_'.$hash{'src_'.$rid}},
    $beenhere,
  $encflag || $encurl{$rid},   $encflag || $encurl{$rid},
  $hdnflag || $hiddenurl{$rid});   $hdnflag || $hiddenurl{$rid});
     }      }
Line 505  sub accinit { Line 574  sub accinit {
     my $courseuri=$uri;      my $courseuri=$uri;
     $courseuri=~s/^\/res\///;      $courseuri=~s/^\/res\///;
     &Apache::lonnet::delenv('(acc\.|httpref\.)');      &Apache::lonnet::delenv('(acc\.|httpref\.)');
     &Apache::lonnet::appenv(%acchash);      &Apache::lonnet::appenv(\%acchash);
 }  }
   
 # ---------------- Selectively delete from randompick maps and hidden url parms  # ---------------- Selectively delete from randompick maps and hidden url parms
Line 561  sub hiddenurls { Line 630  sub hiddenurls {
     }      }
 # --------------------------------------- append randomout entry to environment  # --------------------------------------- append randomout entry to environment
     if ($randomoutentry) {      if ($randomoutentry) {
  &Apache::lonnet::appenv('acc.randomout' => $randomoutentry);   &Apache::lonnet::appenv({'acc.randomout' => $randomoutentry});
     }      }
 }  }
   
Line 607  sub readmap { Line 676  sub readmap {
  $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;      $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);
Line 682  sub readmap { Line 751  sub readmap {
  (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER(),0640))) {   (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER(),0640))) {
  if (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_READER(),0640)) {   if (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_READER(),0640)) {
     $retfurl='/adm/navmaps';      $retfurl='/adm/navmaps';
     &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});
     untie(%hash);      untie(%hash);
     untie(%parmhash);      untie(%parmhash);
     last;      last;
Line 745  sub evalstate { Line 814  sub evalstate {
     }      }
  }   }
     }      }
     &Apache::lonnet::appenv('user.state.'.$env{'request.course.id'} => $state);      &Apache::lonnet::appenv({'user.state.'.$env{'request.course.id'} => $state});
     return $state;      return $state;
 }  }
   
Line 769  sub evalstate { Line 838  sub evalstate {
      $count++;       $count++;
  }   }
  my ($mapid) = split(/\./,$id);   my ($mapid) = split(/\./,$id);
                          &mt('[_1] in [_2]', $hash{'title_'.$id},                           &mt('Resource "[_1]" <br /> in Map "[_2]"',
        $hash{'title_'.$id},
      $hash{'title_'.$hash{'ids_'.$hash{'map_id_'.$mapid}}});       $hash{'title_'.$hash{'ids_'.$hash{'map_id_'.$mapid}}});
      } (@{ $mapalias_cache{$mapalias} }));       } (@{ $mapalias_cache{$mapalias} }));
     next if ($count < 2);      next if ($count < 2);
Removed from v.1.122  
changed lines
  Added in v.1.128

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