[BACK]Return to lonnavmaps.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/lonnavmaps.pm between versions 1.218 and 1.221

version 1.218, 2003/07/25 01:18:04 version 1.221, 2003/08/07 17:26:44
Line 129  sub real_handler { Line 129  sub real_handler {
     $r->send_http_header;      $r->send_http_header;
   
     # Create the nav map      # Create the nav map
     my $navmap = Apache::lonnavmaps::navmap->new(      my $navmap = Apache::lonnavmaps::navmap->new();
                         $ENV{"request.course.fn"}.".db",  
                         $ENV{"request.course.fn"}."_parms.db", 1, 1);  
   
   
     if (!defined($navmap)) {      if (!defined($navmap)) {
Line 161  sub real_handler { Line 159  sub real_handler {
   
     $r->rflush();      $r->rflush();
   
     # Now that we've displayed some stuff to the user, init the navmap  
     $navmap->init();  
   
     $r->rflush();  
   
     # Check that it's defined      # Check that it's defined
     if (!($navmap->courseMapDefined())) {      if (!($navmap->courseMapDefined())) {
         $r->print('<font size="+2" color="red">Coursemap undefined.</font>' .          $r->print('<font size="+2" color="red">Coursemap undefined.</font>' .
Line 1172  sub render { Line 1165  sub render {
     if (!$ENV{'form.folderManip'} && !defined($args->{'iterator'})) {      if (!$ENV{'form.folderManip'} && !defined($args->{'iterator'})) {
         # Step 1: Check to see if we have a navmap          # Step 1: Check to see if we have a navmap
         if (!defined($navmap)) {          if (!defined($navmap)) {
             $navmap = Apache::lonnavmaps::navmap->new(              $navmap = Apache::lonnavmaps::navmap->new();
                         $ENV{"request.course.fn"}.".db",  
                         $ENV{"request.course.fn"}."_parms.db", 1, 1);  
             $mustCloseNavMap = 1;              $mustCloseNavMap = 1;
         }          }
         $navmap->init();  
   
         # Step two: Locate what kind of here marker is necessary          # Step two: Locate what kind of here marker is necessary
         # Determine where the "here" marker is and where the screen jumps to.          # Determine where the "here" marker is and where the screen jumps to.
Line 1238  sub render { Line 1228  sub render {
                   
         # Step 1: Check to see if we have a navmap          # Step 1: Check to see if we have a navmap
         if (!defined($navmap)) {          if (!defined($navmap)) {
             $navmap = Apache::lonnavmaps::navmap->new($r,               $navmap = Apache::lonnavmaps::navmap->new();
                         $ENV{"request.course.fn"}.".db",  
                         $ENV{"request.course.fn"}."_parms.db", 1, 1);  
             $mustCloseNavMap = 1;              $mustCloseNavMap = 1;
         }          }
         # Paranoia: Make sure it's ready  
         $navmap->init();  
   
         # See if we're being passed a specific map          # See if we're being passed a specific map
         if ($args->{'iterator_map'}) {          if ($args->{'iterator_map'}) {
Line 1646  To create a navmap object, use the follo Line 1632  To create a navmap object, use the follo
   
 =over 4  =over 4
   
 =item * B<Apache::lonnavmaps::navmap-E<gt>new>(navHashFile, parmHashFile,   =item * B<Apache::lonnavmaps::navmap-E<gt>new>():
   genCourseAndUserOptions, genMailDiscussStatus, getUserData):  
   
 Binds a new navmap object to the compiled nav map hash and parm hash  Creates a new navmap object. Returns the navmap object if this is
 given as filenames. genCourseAndUserOptions is a flag saying whether  successful, or B<undef> if not.
 the course options and user options hash should be generated. This is  
 for when you are using the parameters of the resources that require  
 them; see documentation in resource object  
 documentation. genMailDiscussStatus causes the nav map to retreive  
 information about the email and discussion status of  
 resources. Returns the navmap object if this is successful, or  
 B<undef> if not. You must check for undef; errors will occur when you  
 try to use the other methods otherwise. getUserData, if true, will   
 retreive the user's performance data for various problems.  
   
 =back  =back
   
 Once you have the $navmap object, call ->init() on it when you are ready  
 to use it. This allows you to check if the course map is defined (see  
 B<courseMapDefined> below) before engaging in potentially expensive   
 initialization routines for the genCourseAndUserOptions and   
 genMailDiscussStatus option.  
   
 When you are done with the $navmap object, you I<must> call   When you are done with the $navmap object, you I<must> call 
 $navmap->untieHashes(), or you'll prevent the current user from using that   $navmap->untieHashes(), or you'll prevent the current user from using that 
 course until the web server is restarted. (!)  course until the web server is restarted. (!)
Line 1692  sub new { Line 1662  sub new {
     my $class = ref($proto) || $proto;      my $class = ref($proto) || $proto;
     my $self = {};      my $self = {};
   
     $self->{NAV_HASH_FILE} = shift;  
     $self->{PARM_HASH_FILE} = shift;  
     $self->{GENERATE_COURSE_USER_OPT} = shift;  
     $self->{GENERATE_EMAIL_DISCUSS_STATUS} = shift;  
     $self->{GET_USER_DATA} = shift;  
   
     # Resource cache stores navmap resources as we reference them. We generate      # Resource cache stores navmap resources as we reference them. We generate
     # them on-demand so we don't pay for creating resources unless we use them.      # them on-demand so we don't pay for creating resources unless we use them.
     $self->{RESOURCE_CACHE} = {};      $self->{RESOURCE_CACHE} = {};
Line 1710  sub new { Line 1674  sub new {
   
     my %navmaphash;      my %navmaphash;
     my %parmhash;      my %parmhash;
     if (!(tie(%navmaphash, 'GDBM_File', $self->{NAV_HASH_FILE},      my $courseFn = $ENV{"request.course.fn"};
       if (!(tie(%navmaphash, 'GDBM_File', "${courseFn}.db",
               &GDBM_READER(), 0640))) {                &GDBM_READER(), 0640))) {
         return undef;          return undef;
     }      }
           
     if (!(tie(%parmhash, 'GDBM_File', $self->{PARM_HASH_FILE},      if (!(tie(%parmhash, 'GDBM_File', "${courseFn}_parms.db",
               &GDBM_READER(), 0640)))                &GDBM_READER(), 0640)))
     {      {
         untie %{$self->{PARM_HASH}};          untie %{$self->{PARM_HASH}};
Line 1724  sub new { Line 1689  sub new {
   
     $self->{NAV_HASH} = \%navmaphash;      $self->{NAV_HASH} = \%navmaphash;
     $self->{PARM_HASH} = \%parmhash;      $self->{PARM_HASH} = \%parmhash;
     $self->{INITED} = 0;      $self->{PARM_CACHE} = {};
   
     bless($self);      bless($self);
                   
     return $self;      return $self;
 }  }
   
 sub init {  sub generate_course_user_opt {
     my $self = shift;      my $self = shift;
     if ($self->{INITED}) { return; }      if ($self->{COURSE_USER_OPT_GENERATED}) { return; }
   
     # If the course opt hash and the user opt hash should be generated,      my $uname=$ENV{'user.name'};
     # generate them      my $udom=$ENV{'user.domain'};
     if ($self->{GENERATE_COURSE_USER_OPT}) {      my $uhome=$ENV{'user.home'};
         my $uname=$ENV{'user.name'};      my $cid=$ENV{'request.course.id'};
         my $udom=$ENV{'user.domain'};      my $chome=$ENV{'course.'.$cid.'.home'};
         my $uhome=$ENV{'user.home'};      my ($cdom,$cnum)=split(/\_/,$cid);
         my $cid=$ENV{'request.course.id'};      
         my $chome=$ENV{'course.'.$cid.'.home'};      my $userprefix=$uname.'_'.$udom.'_';
         my ($cdom,$cnum)=split(/\_/,$cid);      
               my %courserdatas; my %useropt; my %courseopt; my %userrdatas;
         my $userprefix=$uname.'_'.$udom.'_';      unless ($uhome eq 'no_host') { 
           
         my %courserdatas; my %useropt; my %courseopt; my %userrdatas;  
         unless ($uhome eq 'no_host') {   
 # ------------------------------------------------- Get coursedata (if present)  # ------------------------------------------------- Get coursedata (if present)
             unless ((time-$courserdatas{$cid.'.last_cache'})<240) {   unless ((time-$courserdatas{$cid.'.last_cache'})<240) {
                 my $reply=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum.      my $reply=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum.
                                                  ':resourcedata',$chome);       ':resourcedata',$chome);
                 # Check for network failure      # Check for network failure
                 if ( $reply =~ /no.such.host/i || $reply =~ /con_lost/i) {      if ( $reply =~ /no.such.host/i || $reply =~ /con_lost/i) {
                     $self->{NETWORK_FAILURE} = 1;   $self->{NETWORK_FAILURE} = 1;
                 } elsif ($reply!~/^error\:/) {      } elsif ($reply!~/^error\:/) {
                     $courserdatas{$cid}=$reply;   $courserdatas{$cid}=$reply;
                     $courserdatas{$cid.'.last_cache'}=time;   $courserdatas{$cid.'.last_cache'}=time;
                 }      }
             }   }
             foreach (split(/\&/,$courserdatas{$cid})) {   foreach (split(/\&/,$courserdatas{$cid})) {
                 my ($name,$value)=split(/\=/,$_);      my ($name,$value)=split(/\=/,$_);
                 $courseopt{$userprefix.&Apache::lonnet::unescape($name)}=      $courseopt{$userprefix.&Apache::lonnet::unescape($name)}=
                     &Apache::lonnet::unescape($value);   &Apache::lonnet::unescape($value);
             }   }
 # --------------------------------------------------- Get userdata (if present)  # --------------------------------------------------- Get userdata (if present)
             unless ((time-$userrdatas{$uname.'___'.$udom.'.last_cache'})<240) {   unless ((time-$userrdatas{$uname.'___'.$udom.'.last_cache'})<240) {
                 my $reply=&Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome);      my $reply=&Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome);
                 if ($reply!~/^error\:/) {      if ($reply!~/^error\:/) {
                     $userrdatas{$uname.'___'.$udom}=$reply;   $userrdatas{$uname.'___'.$udom}=$reply;
                     $userrdatas{$uname.'___'.$udom.'.last_cache'}=time;   $userrdatas{$uname.'___'.$udom.'.last_cache'}=time;
                 }      }
                 # check to see if network failed      # check to see if network failed
                 elsif ( $reply=~/no.such.host/i || $reply=~/con.*lost/i )      elsif ( $reply=~/no.such.host/i || $reply=~/con.*lost/i )
                 {      {
                     $self->{NETWORK_FAILURE} = 1;   $self->{NETWORK_FAILURE} = 1;
                 }      }
             }   }
             foreach (split(/\&/,$userrdatas{$uname.'___'.$udom})) {   foreach (split(/\&/,$userrdatas{$uname.'___'.$udom})) {
                 my ($name,$value)=split(/\=/,$_);      my ($name,$value)=split(/\=/,$_);
                 $useropt{$userprefix.&Apache::lonnet::unescape($name)}=      $useropt{$userprefix.&Apache::lonnet::unescape($name)}=
                     &Apache::lonnet::unescape($value);   &Apache::lonnet::unescape($value);
             }   }
             $self->{COURSE_OPT} = \%courseopt;   $self->{COURSE_OPT} = \%courseopt;
             $self->{USER_OPT} = \%useropt;   $self->{USER_OPT} = \%useropt;
         }  
     }     
   
     if ($self->{GENERATE_EMAIL_DISCUSS_STATUS}) {  
         my $cid=$ENV{'request.course.id'};  
         my ($cdom,$cnum)=split(/\_/,$cid);  
           
         my %emailstatus = &Apache::lonnet::dump('email_status');  
         my $logoutTime = $emailstatus{'logout'};  
         my $courseLeaveTime = $emailstatus{'logout_'.$ENV{'request.course.id'}};  
         $self->{LAST_CHECK} = (($courseLeaveTime > $logoutTime) ?  
                                $courseLeaveTime : $logoutTime);  
         my %discussiontime = &Apache::lonnet::dump('discussiontimes',   
                                                    $cdom, $cnum);  
         my %feedback=();  
         my %error=();  
         my $keys = &Apache::lonnet::reply('keys:'.  
                                           $ENV{'user.domain'}.':'.  
                                           $ENV{'user.name'}.':nohist_email',  
                                           $ENV{'user.home'});  
   
         foreach my $msgid (split(/\&/, $keys)) {  
             $msgid=&Apache::lonnet::unescape($msgid);  
             my $plain=&Apache::lonnet::unescape(&Apache::lonnet::unescape($msgid));  
             if ($plain=~/(Error|Feedback) \[([^\]]+)\]/) {  
                 my ($what,$url)=($1,$2);  
                 my %status=  
                     &Apache::lonnet::get('email_status',[$msgid]);  
                 if ($status{$msgid}=~/^error\:/) {   
                     $status{$msgid}='';   
                 }  
                   
                 if (($status{$msgid} eq 'new') ||   
                     (!$status{$msgid})) {   
                     if ($what eq 'Error') {  
                         $error{$url}.=','.$msgid;   
                     } else {  
                         $feedback{$url}.=','.$msgid;  
                     }  
                 }  
             }  
         }  
           
         $self->{FEEDBACK} = \%feedback;  
         $self->{ERROR_MSG} = \%error; # what is this? JB  
         $self->{DISCUSSION_TIME} = \%discussiontime;  
         $self->{EMAIL_STATUS} = \%emailstatus;  
           
     }      }
   
     if ($self->{GET_USER_DATA}) {      $self->{COURSE_USER_OPT_GENERATED} = 1;
  # Retreive performance data on problems      
  my %student_data = Apache::lonnet::currentdump($ENV{'request.course.id'},      return;
        $ENV{'user.domain'},  }
        $ENV{'user.name'});  
  $self->{STUDENT_DATA} = \%student_data;  sub generate_email_discuss_status {
       my $self = shift;
       if ($self->{EMAIL_DISCUSS_GENERATED}) { return; }
   
       my $cid=$ENV{'request.course.id'};
       my ($cdom,$cnum)=split(/\_/,$cid);
       
       my %emailstatus = &Apache::lonnet::dump('email_status');
       my $logoutTime = $emailstatus{'logout'};
       my $courseLeaveTime = $emailstatus{'logout_'.$ENV{'request.course.id'}};
       $self->{LAST_CHECK} = (($courseLeaveTime > $logoutTime) ?
      $courseLeaveTime : $logoutTime);
       my %discussiontime = &Apache::lonnet::dump('discussiontimes', 
          $cdom, $cnum);
       my %feedback=();
       my %error=();
       my $keys = &Apache::lonnet::reply('keys:'.
         $ENV{'user.domain'}.':'.
         $ENV{'user.name'}.':nohist_email',
         $ENV{'user.home'});
       
       foreach my $msgid (split(/\&/, $keys)) {
    $msgid=&Apache::lonnet::unescape($msgid);
    my $plain=&Apache::lonnet::unescape(&Apache::lonnet::unescape($msgid));
    if ($plain=~/(Error|Feedback) \[([^\]]+)\]/) {
       my ($what,$url)=($1,$2);
       my %status=
    &Apache::lonnet::get('email_status',[$msgid]);
       if ($status{$msgid}=~/^error\:/) { 
    $status{$msgid}=''; 
       }
       
       if (($status{$msgid} eq 'new') || 
    (!$status{$msgid})) { 
    if ($what eq 'Error') {
       $error{$url}.=','.$msgid; 
    } else {
       $feedback{$url}.=','.$msgid;
    }
       }
    }
     }      }
       
       $self->{FEEDBACK} = \%feedback;
       $self->{ERROR_MSG} = \%error; # what is this? JB
       $self->{DISCUSSION_TIME} = \%discussiontime;
       $self->{EMAIL_STATUS} = \%emailstatus;
       
       $self->{EMAIL_DISCUSS_GENERATED} = 1;
   }
   
     $self->{PARM_CACHE} = {};  sub get_user_data {
     $self->{INITED} = 1;      my $self = shift;
       if ($self->{RETRIEVED_USER_DATA}) { return; }
   
       # Retrieve performance data on problems
       my %student_data = Apache::lonnet::currentdump($ENV{'request.course.id'},
      $ENV{'user.domain'},
      $ENV{'user.name'});
       $self->{STUDENT_DATA} = \%student_data;
   
       $self->{RETRIEVED_USER_DATA} = 1;
 }  }
   
 # Internal function: Takes a key to look up in the nav hash and implements internal  # Internal function: Takes a key to look up in the nav hash and implements internal
Line 1893  sub untieHashes { Line 1864  sub untieHashes {
 sub hasDiscussion {  sub hasDiscussion {
     my $self = shift;      my $self = shift;
     my $symb = shift;      my $symb = shift;
       
       $self->generate_email_discuss_status();
   
     if (!defined($self->{DISCUSSION_TIME})) { return 0; }      if (!defined($self->{DISCUSSION_TIME})) { return 0; }
   
     #return defined($self->{DISCUSSION_TIME}->{$symb});      #return defined($self->{DISCUSSION_TIME}->{$symb});
Line 1907  sub getFeedback { Line 1881  sub getFeedback {
     my $self = shift;      my $self = shift;
     my $symb = shift;      my $symb = shift;
   
       $self->generate_email_discuss_status();
   
     if (!defined($self->{FEEDBACK})) { return ""; }      if (!defined($self->{FEEDBACK})) { return ""; }
           
     return $self->{FEEDBACK}->{$symb};      return $self->{FEEDBACK}->{$symb};
Line 1916  sub getFeedback { Line 1892  sub getFeedback {
 sub getErrors {   sub getErrors { 
     my $self = shift;      my $self = shift;
     my $src = shift;      my $src = shift;
       
       $self->generate_email_discuss_status();
   
     if (!defined($self->{ERROR_MSG})) { return ""; }      if (!defined($self->{ERROR_MSG})) { return ""; }
     return $self->{ERROR_MSG}->{$src};      return $self->{ERROR_MSG}->{$src};
 }  }
Line 2027  sub parmval { Line 2005  sub parmval {
   
 sub parmval_real {  sub parmval_real {
     my $self = shift;      my $self = shift;
     my ($what,$symb) = @_;      my ($what,$symb,$recurse) = @_;
   
       # Make sure the {USER_OPT} and {COURSE_OPT} hashes are populated
       $self->generate_course_user_opt();
   
     my $cid=$ENV{'request.course.id'};      my $cid=$ENV{'request.course.id'};
     my $csec=$ENV{'request.course.sec'};      my $csec=$ENV{'request.course.sec'};
Line 2099  sub parmval_real { Line 2080  sub parmval_real {
  my $id=pop(@parts);   my $id=pop(@parts);
  my $part=join('_',@parts);   my $part=join('_',@parts);
  if ($part eq '') { $part='0'; }   if ($part eq '') { $part='0'; }
  my $partgeneral=$self->parmval($part.".$qualifier",$symb);   my $partgeneral=$self->parmval($part.".$qualifier",$symb,1);
  if (defined($partgeneral)) { return $partgeneral; }   if (defined($partgeneral)) { return $partgeneral; }
     }      }
       if ($recurse) { return undef; }
       my $pack_def=&Apache::lonnet::packages_tab_default($fn,'resource.'.$what);
       if (defined($pack_def)) { return $pack_def; }
     return '';      return '';
 }  }
   
Line 3304  sub answerdate { Line 3288  sub answerdate {
 }  }
 sub awarded {   sub awarded { 
     my $self = shift; my $part = shift;      my $self = shift; my $part = shift;
       $self->{NAV_MAP}->get_user_data();
     if (!defined($part)) { $part = '0'; }      if (!defined($part)) { $part = '0'; }
     return $self->{NAV_MAP}->{STUDENT_DATA}->{$self->symb()}->{'resource.'.$part.'.awarded'};      return $self->{NAV_MAP}->{STUDENT_DATA}->{$self->symb()}->{'resource.'.$part.'.awarded'};
 }  }
Removed from v.1.218  
changed lines
  Added in v.1.221

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