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

Diff for /rat/lonuserstate.pm between versions 1.142 and 1.149.2.2.2.2

version 1.142, 2011/10/20 17:14:19 version 1.149.2.2.2.2, 2020/01/21 02:50:46
Line 42  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;  use LONCAPA qw(:DEFAULT :match);
 use File::Basename;  use File::Basename;
   
     
Line 59  my $retfurl; # first URL Line 59  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 %randomorder; # maps to order contents randomly
   my %randomizationcode; # code used to grade folder for bubblesheet exam 
 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
   my %rescount; # count of unhidden items in each map
   my %mapcount; # count of unhidden maps in each map
   
 # ----------------------------------- Remove version from URL and store in hash  # ----------------------------------- Remove version from URL and store in hash
   
Line 140  sub processversionfile { Line 143  sub processversionfile {
 # Parameters:  # Parameters:
 #    uri         - URI of the map file.  #    uri         - URI of the map file.
 #    parent_rid  - Resource id in the map of the parent resource (0.0 for the top level map)  #    parent_rid  - Resource id in the map of the parent resource (0.0 for the top level map)
 #  #    courseid    - Course id for the course for which the map is being loaded
 #  #
 sub loadmap {   sub loadmap { 
     my ($uri,$parent_rid)=@_;      my ($uri,$parent_rid,$courseid)=@_;
   
     # Is the map already included?      # Is the map already included?
   
Line 183  sub loadmap { Line 186  sub loadmap {
     # We can only nest sequences or pages.  Anything else is an illegal nest.      # We can only nest sequences or pages.  Anything else is an illegal nest.
   
     unless (($fn=~/\.sequence$/) || $ispage) {       unless (($fn=~/\.sequence$/) || $ispage) { 
  $errtext.=&mt("<br />Invalid map: <tt>[_1]</tt>",$fn);   $errtext.='<br />'.&mt('Invalid map: [_1]',"<tt>$fn</tt>");
  return;    return; 
     }      }
   
Line 192  sub loadmap { Line 195  sub loadmap {
     my $instr=&Apache::lonnet::getfile($fn);      my $instr=&Apache::lonnet::getfile($fn);
   
     if ($instr eq -1) {      if ($instr eq -1) {
         $errtext.=&mt('<br />Map not loaded: The file <tt>[_1]</tt> does not exist.',$fn);          $errtext.= '<br />'
                     .&mt('Map not loaded: The file [_1] does not exist.',
                          "<tt>$fn</tt>");
  return;   return;
     }      }
   
Line 236  sub loadmap { Line 241  sub loadmap {
     # This is handled in the next chunk of code.      # This is handled in the next chunk of code.
   
     my @map_ids;      my @map_ids;
       my $codechecked;
       $rescount{$lpc} = 0;
       $mapcount{$lpc} = 0;
     while (my $token = $parser->get_token) {      while (my $token = $parser->get_token) {
  next if ($token->[0] ne 'S');   next if ($token->[0] ne 'S');
   
  # Resource   # Resource
   
  if ($token->[1] eq 'resource') {   if ($token->[1] eq 'resource') {
     my $resource_id = &parse_resource($token,$lpc,$ispage,$uri);      my $resource_id = &parse_resource($token,$lpc,$ispage,$uri,$courseid);
     if (defined $resource_id) {      if (defined $resource_id) {
  push(@map_ids, $resource_id);    push(@map_ids, $resource_id);
                   if ($hash{'src_'.$lpc.'.'.$resource_id}) {
                       $rescount{$lpc} ++;
                       if (($hash{'src_'.$lpc.'.'.$resource_id}=~/\.sequence$/) ||
                           ($hash{'src_'.$lpc.'.'.$resource_id}=~/\.page$/)) {
                           $mapcount{$lpc} ++;
                       }
                   }
                   unless ($codechecked) {
                       my $startsymb =
                          &Apache::lonnet::encode_symb($hash{'map_id_'.$lpc},$resource_id,
                                                       $hash{'src_'."$lpc.$resource_id"});
                       my $code = 
                           &Apache::lonnet::EXT('resource.0.examcode',$startsymb,undef,undef,
                                                undef,undef,$courseid);
                       if ($code) {
                           $randomizationcode{$parent_rid} = $code;
                       }
                       $codechecked = 1; 
                   }
     }      }
   
        # Link         # Link
Line 260  sub loadmap { Line 287  sub loadmap {
     &parse_condition($token,$lpc);      &parse_condition($token,$lpc);
  }   }
     }      }
       undef($codechecked);
   
     # Handle randomization and random selection      # Handle randomization and random selection
   
     if ($randomize) {      if ($randomize) {
  if (!$env{'request.role.adv'}) {          my $advanced;
           if ($env{'request.course.id'}) {
               $advanced = (&Apache::lonnet::allowed('adv') eq 'F');
           } else {
               $env{'request.course.id'} = $courseid;
               $advanced = (&Apache::lonnet::allowed('adv') eq 'F');
               $env{'request.course.id'} = '';
           }
           unless ($advanced) {
               # Order of resources is not randomized if user has and advanced role in the course.
     my $seed;      my $seed;
   
     # In the advanced role, the map's random seed              # If the map's random seed parameter has been specified
     # parameter is used as the basis for computing the              # it is used as the basis for computing the seed ...
     # seed ... if it has been specified:  
   
     if (defined($randompickseed{$parent_rid})) {      if (defined($randompickseed{$parent_rid})) {
  $seed = $randompickseed{$parent_rid};   $seed = $randompickseed{$parent_rid};
Line 289  sub loadmap { Line 324  sub loadmap {
     # TODO: Here for sure we need to pass along the username/domain      # TODO: Here for sure we need to pass along the username/domain
     # so that we can impersonate users in lonprintout e.g.      # so that we can impersonate users in lonprintout e.g.
   
               my $setcode;
               if (defined($randomizationcode{$parent_rid})) {
                   if ($env{'form.CODE'} eq '') {
                       $env{'form.CODE'} = $randomizationcode{$parent_rid};
                       $setcode = 1;
                   }
               }
   
     my $rndseed=&Apache::lonnet::rndseed($seed);      my $rndseed=&Apache::lonnet::rndseed($seed);
     &Apache::lonnet::setup_random_from_rndseed($rndseed);      &Apache::lonnet::setup_random_from_rndseed($rndseed);
   
               if ($setcode) {
                   undef($env{'form.CODE'});
                   undef($setcode);
               }
   
     # Take the set of map ids we have decoded and permute them to a      # Take the set of map ids we have decoded and permute them to a
     # random order based on the seed set above. All of this is      # random order based on the seed set above. All of this is
     # processing the randomorder parameter if it is set, not      # processing the randomorder parameter if it is set, not
     # randompick.      # randompick.
   
     @map_ids=&Math::Random::random_permutation(@map_ids);       @map_ids=&Math::Random::random_permutation(@map_ids);
  }   }
   
   
  my $from = shift(@map_ids);   my $from = shift(@map_ids);
  my $from_rid = $lpc.'.'.$from;   my $from_rid = $lpc.'.'.$from;
  $hash{'map_start_'.$uri} = $from_rid;   $hash{'map_start_'.$uri} = $from_rid;
Line 325  sub loadmap { Line 372  sub loadmap {
     $parser = HTML::TokeParser->new(\$instr);      $parser = HTML::TokeParser->new(\$instr);
     $parser->attr_encoded(1);      $parser->attr_encoded(1);
   
     # last parse out the mapalias params.  Thes provide mnemonic      # last parse out the mapalias params.  These provide mnemonic
     # tags to resources that can be used in conditions      # tags to resources that can be used in conditions
   
     while (my $token = $parser->get_token) {      while (my $token = $parser->get_token) {
Line 352  sub loadmap { Line 399  sub loadmap {
 #    $lpc     - Map nesting level (?)  #    $lpc     - Map nesting level (?)
 #    $ispage  - True if this resource is encapsulated in a .page (assembled resourcde).  #    $ispage  - True if this resource is encapsulated in a .page (assembled resourcde).
 #    $uri     - URI of the enclosing resource.  #    $uri     - URI of the enclosing resource.
   #    $courseid - Course id of the course containing the resource being parsed. 
 # Returns:  # Returns:
 #   Value of the id attribute of the tag.  #   Value of the id attribute of the tag.
 #  #
Line 372  sub loadmap { Line 420  sub loadmap {
   
   
 sub parse_resource {  sub parse_resource {
     my ($token,$lpc,$ispage,$uri) = @_;      my ($token,$lpc,$ispage,$uri,$courseid) = @_;
           
     # I refuse to countenance code like this that has       # I refuse to countenance code like this that has 
     # such a dirty side effect (and forcing this sub to be called within a loop).      # such a dirty side effect (and forcing this sub to be called within a loop).
Line 436  sub parse_resource { Line 484  sub parse_resource {
     } elsif ($turi!~/\.(sequence|page)$/) {      } elsif ($turi!~/\.(sequence|page)$/) {
  $turi='/adm/coursedocs/showdoc'.$turi;   $turi='/adm/coursedocs/showdoc'.$turi;
     }      }
           } elsif ($turi=~ m{^/adm/$match_domain/$match_courseid/\d+/ext\.tool$}) {
               $turi='/adm/wrapper'.$turi;
  } elsif ($turi=~/\S/) { # normal non-empty internal resource   } elsif ($turi=~/\S/) { # normal non-empty internal resource
     my $mapdir=$uri;      my $mapdir=$uri;
     $mapdir=~s/[^\/]+$//;      $mapdir=~s/[^\/]+$//;
Line 511  sub parse_resource { Line 561  sub parse_resource {
     if (($turi=~/\.sequence$/) ||      if (($turi=~/\.sequence$/) ||
  ($turi=~/\.page$/)) {   ($turi=~/\.page$/)) {
  $hash{'is_map_'.$rid}=1;   $hash{'is_map_'.$rid}=1;
  &loadmap($turi,$rid);   &loadmap($turi,$rid,$courseid);
     }       } 
     return $token->[2]->{'id'};      return $token->[2]->{'id'};
 }  }
Line 667  sub parse_condition { Line 717  sub parse_condition {
 #  Typical attributes:  #  Typical attributes:
 #     to=n      - Number of the resource the parameter applies to.  #     to=n      - Number of the resource the parameter applies to.
 #     type=xx   - Type of parameter value (e.g. string_yesno or int_pos).  #     type=xx   - Type of parameter value (e.g. string_yesno or int_pos).
 #     name=xxx  - Name ofr parameter (e.g. parameter_randompick or parameter_randomorder).  #     name=xxx  - Name of parameter (e.g. parameter_randompick or parameter_randomorder).
 #     value=xxx - value of the parameter.  #     value=xxx - value of the parameter.
   
 sub parse_param {  sub parse_param {
Line 909  sub traceroute { Line 959  sub traceroute {
  $further=simplify('('.'_'.$rid.')&('.   $further=simplify('('.'_'.$rid.')&('.
   $hash{'condid_'.$hash{'undercond_'.$id}}.')');    $hash{'condid_'.$hash{'undercond_'.$id}}.')');
     } else {      } else {
  $errtext.=&mt('<br />Undefined condition ID: [_1]',$hash{'undercond_'.$id});   $errtext.= '<br />'.
                                      &mt('Undefined condition ID: [_1]',
                                          $hash{'undercond_'.$id});
     }      }
                 }                  }
  #  Recurse to resoruces that have to's to us.   #  Recurse to resoruces that have to's to us.
Line 1031  sub accinit { Line 1083  sub accinit {
   
 sub hiddenurls {  sub hiddenurls {
     my $randomoutentry='';      my $randomoutentry='';
     foreach my $rid (keys %randompick) {      foreach my $rid (keys(%randompick)) {
         my $rndpick=$randompick{$rid};          my $rndpick=$randompick{$rid};
         my $mpc=$hash{'map_pc_'.$hash{'src_'.$rid}};          my $mpc=$hash{'map_pc_'.$hash{'src_'.$rid}};
 # ------------------------------------------- put existing resources into array  # ------------------------------------------- put existing resources into array
Line 1052  sub hiddenurls { Line 1104  sub hiddenurls {
 # -------------------------------- randomly eliminate the ones that should stay  # -------------------------------- randomly eliminate the ones that should stay
  my (undef,$id)=split(/\./,$rid);   my (undef,$id)=split(/\./,$rid);
         if ($randompickseed{$rid}) { $id=$randompickseed{$rid}; }          if ($randompickseed{$rid}) { $id=$randompickseed{$rid}; }
           my $setcode;
           if (defined($randomizationcode{$rid})) {
               if ($env{'form.CODE'} eq '') {
                   $env{'form.CODE'} = $randomizationcode{$rid};
                   $setcode = 1;
               }
           }
  my $rndseed=&Apache::lonnet::rndseed($id); # use id instead of symb   my $rndseed=&Apache::lonnet::rndseed($id); # use id instead of symb
           if ($setcode) {
               undef($env{'form.CODE'});
               undef($setcode);
           }
  &Apache::lonnet::setup_random_from_rndseed($rndseed);   &Apache::lonnet::setup_random_from_rndseed($rndseed);
  my @whichids=&Math::Random::random_permuted_index($#currentrids+1);   my @whichids=&Math::Random::random_permuted_index($#currentrids+1);
         for (my $i=1;$i<=$rndpick;$i++) { $currentrids[$whichids[$i]]=''; }          for (my $i=1;$i<=$rndpick;$i++) { $currentrids[$whichids[$i]]=''; }
Line 1062  sub hiddenurls { Line 1125  sub hiddenurls {
             if ($currentrids[$k]) {              if ($currentrids[$k]) {
  $hash{'randomout_'.$currentrids[$k]}=1;   $hash{'randomout_'.$currentrids[$k]}=1;
                 my ($mapid,$resid)=split(/\./,$currentrids[$k]);                  my ($mapid,$resid)=split(/\./,$currentrids[$k]);
                   if ($rescount{$mapid}) {
                       $rescount{$mapid} --;
                   }
                   if ($hash{'is_map_'.$currentrids[$k]}) {
                       if ($mapcount{$mapid}) {
                           $mapcount{$mapid} --;
                       }
                   }
                 $randomoutentry.='&'.                  $randomoutentry.='&'.
     &Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},      &Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},
  $resid,   $resid,
Line 1071  sub hiddenurls { Line 1142  sub hiddenurls {
         }          }
     }      }
 # ------------------------------ take care of explicitly hidden urls or folders  # ------------------------------ take care of explicitly hidden urls or folders
     foreach my $rid (keys %hiddenurl) {      foreach my $rid (keys(%hiddenurl)) {
  $hash{'randomout_'.$rid}=1;   $hash{'randomout_'.$rid}=1;
  my ($mapid,$resid)=split(/\./,$rid);   my ($mapid,$resid)=split(/\./,$rid);
           if ($rescount{$mapid}) {
               $rescount{$mapid} --;
           }
           if ($hash{'is_map_'.$rid}) {
               if ($mapcount{$mapid}) {
                   $mapcount{$mapid} --;
               }
           }
  $randomoutentry.='&'.   $randomoutentry.='&'.
     &Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid,      &Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid,
  $hash{'src_'.$rid}).'&';   $hash{'src_'.$rid}).'&';
Line 1084  sub hiddenurls { Line 1163  sub hiddenurls {
     }      }
 }  }
   
   # -------------------------------------- populate big hash with map breadcrumbs
   
   # Create map_breadcrumbs_$pc from map_hierarchy_$pc by omitting intermediate
   # maps not shown in Course Contents table.
   
   sub mapcrumbs {
       foreach my $key (keys(%rescount)) {
           if ($hash{'map_hierarchy_'.$key}) {
               my $skipnext = 0;
               foreach my $id (split(/,/,$hash{'map_hierarchy_'.$key}),$key) {
                   unless ($skipnext) {
                       $hash{'map_breadcrumbs_'.$key} .= "$id,";
                   }
                   unless (($id == 0) || ($id == 1)) {
                       if ((!$rescount{$id}) || ($rescount{$id} == 1 && $mapcount{$id} == 1)) {
                           $skipnext = 1;
                       } else {
                           $skipnext = 0;
                       }
                   }
               }
               $hash{'map_breadcrumbs_'.$key} =~ s/,$//;
           }
       }
   }
   
 # ---------------------------------------------------- Read map and all submaps  # ---------------------------------------------------- Read map and all submaps
   
 sub readmap {  sub readmap {
Line 1104  sub readmap { Line 1209  sub readmap {
     }      }
     @cond=('true:normal');      @cond=('true:normal');
   
     unless (open(LOCKFILE,">$fn.db.lock")) {      unless (open(LOCKFILE,">","$fn.db.lock")) {
  #    # 
  # Most likely a permissions problem on the lockfile or its directory.   # Most likely a permissions problem on the lockfile or its directory.
  #   #
         $errtext.='<br />'.&mt('Map not loaded - Lock file could not be opened when reading map:').' <tt>'.$fn.'</tt>.';  
         $retfurl = '';          $retfurl = '';
         return ($retfurl,$errtext);          return ($retfurl,'<br />'.&mt('Map not loaded - Lock file could not be opened when reading map:').' <tt>'.$fn.'</tt>.');
     }      }
     my $lock=0;      my $lock=0;
     my $gotstate=0;      my $gotstate=0;
Line 1123  sub readmap { Line 1227  sub readmap {
         &unlink_tmpfiles($fn);          &unlink_tmpfiles($fn);
     }      }
     undef %randompick;      undef %randompick;
       undef %randompickseed;
       undef %randomorder;
       undef %randomizationcode;
     undef %hiddenurl;      undef %hiddenurl;
     undef %encurl;      undef %encurl;
       undef %rescount;
       undef %mapcount;
     $retfrid='';      $retfrid='';
       $errtext='';
     my ($untiedhash,$untiedparmhash,$tiedhash,$tiedparmhash); # More state flags.      my ($untiedhash,$untiedparmhash,$tiedhash,$tiedparmhash); # More state flags.
   
     # if we got the lock, regenerate course regnerate empty files and tie them.      # if we got the lock, regenerate course regnerate empty files and tie them.
Line 1220  sub readmap { Line 1330  sub readmap {
     #      #
             &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,
                                                        "request.course.tied" => time});
                               
             $untiedhash = untie(%hash);              $untiedhash = untie(%hash);
             $untiedparmhash = untie(%parmhash);              $untiedparmhash = untie(%parmhash);
                             $gotstate = 1;                              $gotstate = 1;
Line 1263  sub readmap { Line 1375  sub readmap {
             $lock=1;              $lock=1;
         }          }
         undef %randompick;          undef %randompick;
           undef %randompickseed;
           undef %randomorder;
           undef %randomizationcode;
         undef %hiddenurl;          undef %hiddenurl;
         undef %encurl;          undef %encurl;
           undef %rescount;
           undef %mapcount;
           $errtext='';
         $retfrid='';          $retfrid='';
  #   #
  # Once more through the routine of tying and loading and so on.   # Once more through the routine of tying and loading and so on.
Line 1367  sub build_tmp_hashes { Line 1485  sub build_tmp_hashes {
     # sub-maps.      # sub-maps.
   
   
     &loadmap($uri,'0.0');      &loadmap($uri,'0.0',$short);
   
     #  The code below only executes if there is a starting point for the map>      #  The code below only executes if there is a starting point for the map>
     #  Q/BUG??? If there is no start resource for the map should that be an error?      #  Q/BUG??? If there is no start resource for the map should that be an error?
Line 1376  sub build_tmp_hashes { Line 1494  sub build_tmp_hashes {
     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,
                                    "request.course.tied" => time});
         $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);
         &hiddenurls();          &hiddenurls();
           &mapcrumbs();
     }      }
     $errtext .= &get_mapalias_errors();      $errtext .= &get_mapalias_errors();
 # ------------------------------------------------------- Put versions into src  # ------------------------------------------------------- Put versions into src
Line 1412  sub build_tmp_hashes { Line 1532  sub build_tmp_hashes {
 # ---------------------------------------------------- Store away initial state  # ---------------------------------------------------- Store away initial state
     {      {
         my $cfh;          my $cfh;
         if (open($cfh,">$fn.state")) {          if (open($cfh,">","$fn.state")) {
             print $cfh join("\n",@cond);              print $cfh join("\n",@cond);
             $gotstate = 1;              $gotstate = 1;
         } else {          } else {
Line 1427  sub unlink_tmpfiles { Line 1547  sub unlink_tmpfiles {
     my ($fn) = @_;      my ($fn) = @_;
     my $file_dir = dirname($fn);      my $file_dir = dirname($fn);
   
     if ($fn eq LONCAPA::tempdir()) {      if ("$file_dir/" eq LONCAPA::tempdir()) {
         my @files = qw (.db _symb.db .state _parms.db);          my @files = qw (.db _symb.db .state _parms.db);
         foreach my $file (@files) {          foreach my $file (@files) {
             if (-e $fn.$file) {              if (-e $fn.$file) {
Line 1449  sub evalstate { Line 1569  sub evalstate {
     if (-e $fn) {      if (-e $fn) {
  my @conditions=();   my @conditions=();
  {   {
     open(my $fh,"<$fn");      open(my $fh,"<",$fn);
     @conditions=<$fh>;      @conditions=<$fh>;
             close($fh);              close($fh);
  }     }  
Line 1504  sub evalstate { Line 1624  sub evalstate {
      $count++;       $count++;
  }   }
  my ($mapid) = split(/\./,$id);   my ($mapid) = split(/\./,$id);
                          &mt('Resource "[_1]" <br /> in Map "[_2]"',                           &mt('Resource [_1][_2]in Map [_3]',
      $hash{'title_'.$id},       $hash{'title_'.$id},'<br />',
      $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.142  
changed lines
  Added in v.1.149.2.2.2.2

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