[prev in list] [next in list] [prev in thread] [next in thread]
List: lon-capa-cvs
Subject: [LON-CAPA-cvs] cvs: loncom /interface lonnavmaps.pm
From: bowersj2 <lon-capa-cvs () mail ! lon-capa ! org>
Date: 2003-01-31 22:46:50
Message-ID: cvsbowersj21044053210 () cvsserver
[Download RAW message or body]
This is a MIME encoded message
bowersj2 Fri Jan 31 17:46:50 2003 EDT
Modified files:
/loncom/interface lonnavmaps.pm
Log:
First column now works mostly correctly. That should be the hardest
by far of the four to convert.
["bowersj2-20030131174650.txt" (text/plain)]
Index: loncom/interface/lonnavmaps.pm
diff -u loncom/interface/lonnavmaps.pm:1.132 loncom/interface/lonnavmaps.pm:1.133
--- loncom/interface/lonnavmaps.pm:1.132 Thu Jan 30 16:36:57 2003
+++ loncom/interface/lonnavmaps.pm Fri Jan 31 17:46:50 2003
@@ -2,7 +2,7 @@
# The LearningOnline Network with CAPA
# Navigate Maps Handler
#
-# $Id: lonnavmaps.pm,v 1.132 2003/01/30 21:36:57 bowersj2 Exp $
+# $Id: lonnavmaps.pm,v 1.133 2003/01/31 22:46:50 bowersj2 Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -49,6 +49,14 @@
my %navmaphash;
my %parmhash;
+# symbolic constants
+sub SYMB { return 1; }
+sub URL { return 2; }
+sub NOTHING { return 3; }
+
+# Some data
+
+
sub cleanup {
if (tied(%navmaphash)){
&Apache::lonnet::logthis('Cleanup navmaps: navmaphash');
@@ -145,10 +153,9 @@
}
# Determine where the "here" marker is and where the screen jumps to.
- my $SYMB = 1; my $URL = 2; my $NOTHING = 3; # symbolic constants
- my $hereType; # the type of marker, $SYMB, $URL, or $NOTHING
+ my $hereType; # the type of marker, SYMB, URL, or NOTHING
my $here; # the actual URL or SYMB for the here marker
- my $jumpType; # The type of the thing we have a jump for, $SYMB or $URL
+ my $jumpType; # The type of the thing we have a jump for, SYMB or URL
my $jump; # the SYMB/URL of the resource we need to jump to
if ( $ENV{'form.alreadyHere'} ) { # we came from a user's manipulation of the \
nav page @@ -156,7 +163,7 @@
# from the querystring, and get the new "jump" marker
$hereType = $ENV{'form.hereType'};
$here = $ENV{'form.here'};
- $jumpType = $ENV{'form.jumpType'} || $NOTHING;
+ $jumpType = $ENV{'form.jumpType'} || NOTHING();
$jump = $ENV{'form.jump'};
} else { # the user is visiting the nav map from the remote
# We're coming from the remote. We have either a url, a symb, or nothing,
@@ -164,7 +171,7 @@
# Preference: Symb
if ($ENV{'form.symb'}) {
- $hereType = $jumpType = $SYMB;
+ $hereType = $jumpType = SYMB();
$here = $jump = $ENV{'form.symb'};
} elsif ($ENV{'form.postdata'}) {
# couldn't find a symb, is there a URL?
@@ -172,11 +179,11 @@
$currenturl=~s/^http\:\/\///;
$currenturl=~s/^[^\/]+//;
- $hereType = $jumpType = $URL;
+ $hereType = $jumpType = URL;
$here = $jump = $currenturl;
} else {
# Nothing
- $hereType = $jumpType = $NOTHING;
+ $hereType = $jumpType = NOTHING();
}
}
@@ -291,7 +298,7 @@
$mapIterator->next(); # discard the first BEGIN_MAP
my $curRes = $mapIterator->next();
my $counter = 0;
- my $foundJump = ($jumpType == $NOTHING); # look for jump point if we have one
+ my $foundJump = ($jumpType == NOTHING()); # look for jump point if we have one
my $looped = 0;
# We only need to do this if we need to open the maps to show the
@@ -302,8 +309,8 @@
if ($curRes == $mapIterator->END_MAP()) { $depth--; }
if (ref($curRes) && !$ENV{'form.alreadyHere'} &&
- ($hereType == $SYMB && $curRes->symb() eq $here) ||
- (ref($curRes) && $hereType == $URL && $curRes->src() eq $here)) {
+ ($hereType == SYMB() && $curRes->symb() eq $here) ||
+ (ref($curRes) && $hereType == URL() && $curRes->src() eq $here)) {
my $mapStack = $mapIterator->getStack();
# Ensure the parent maps are open
@@ -332,8 +339,8 @@
if (ref($curRes)) { $counter++; }
if (ref($curRes) &&
- (($jumpType == $SYMB && $curRes->symb() eq $jump) ||
- ($jumpType == $URL && $curRes->src() eq $jump))) {
+ (($jumpType == SYMB() && $curRes->symb() eq $jump) ||
+ ($jumpType == URL() && $curRes->src() eq $jump))) {
# If this is the correct resource, be sure to
# show it by making sure the containing maps
# are open.
@@ -542,7 +549,7 @@
removeFromFilter(\%filterHash, $mapId);
$linkopen .= "&condition=$condition&$queryAdd" .
"&hereType=$hereType&here=" .
- Apache::lonnet::escape($here) . "&jumpType=$SYMB&" .
+ Apache::lonnet::escape($here) . "&jumpType=".SYMB()."&" .
"jump=" . Apache::lonnet::escape($curRes->symb()) ."\">";
$linkclose = "</a>";
@@ -591,8 +598,8 @@
# Is this the current resource?
if (!$displayedHereMarker &&
- (($hereType == $SYMB && $curRes->symb eq $here) ||
- ($hereType == $URL && $curRes->src eq $here))) {
+ (($hereType == SYMB() && $curRes->symb eq $here) ||
+ ($hereType == URL() && $curRes->src eq $here))) {
$curMarkerBegin = '<font color="red" size="+2">> </font>';
$curMarkerEnd = '<font color="red" size="+2"> <</font>';
$displayedHereMarker = 1;
@@ -700,6 +707,13 @@
$r->print('<script>location += "#curloc";</script>');
}
+ # renderer call
+ $mapIterator = $navmap->getIterator(undef, undef, \%filterHash, 0);
+ my $render = render({ 'cols' => [0,1,2,3], 'iterator' => $mapIterator,
+ 'url' => '/adm/navmaps',
+ 'queryString' => 'alreadyHere=1' });
+ $r->print('|' . $render . '|');
+
$navmap->untieHashes();
$r->print("</body></html>");
@@ -950,490 +964,246 @@
}
}
-1;
-
-package Apache::lonnavmaps::navmap;
=pod
-lonnavmaps provides functions and objects for dealing with the compiled course \
hashes generated when a user enters the course, the Apache handler for the \
"Navigation Map" button, and a flexible prepared renderer for navigation maps that \
are easy to use anywhere. +=head1 navmap renderer
-=head1 navmap object: Encapsulating the compiled nav map
+The navmaprenderer package provides a sophisticated rendering of the standard \
navigation maps interface into HTML. The provided nav map handler is actually just a \
glorified call to this.
-navmap is an object that encapsulates a compiled course map and provides a \
reasonable interface to it. +Because of the large number of parameters this function \
presents, instead of passing it arguments as is normal, pass it in an anonymous hash \
with the given options. This is because there is no obvious order you may wish to \
override these in and a hash is easier to read and understand then "undef, undef, \
undef, 1, undef, undef, renderButton, undef, 0" when you mostly want default \
behaviors.
-Most notably it provides a way to navigate the map sensibly and a flexible iterator \
that makes it easy to write various renderers based on nav maps. +The package \
provides a function called 'render', called as \
Apache::lonnavmaps::renderer->render({}).
-You must obtain resource objects through the navmap object.
+=head2 Overview of Columns
-=head2 Methods
+The renderer will build an HTML table for the navmap and return it. The table is \
consists of several columns, and a row for each resource (or possibly each part). You \
tell the renderer how many columns to create and what to place in each column, \
optionally using one or more of the preparent columns, and the renderer will assemble \
the table.
-=over 4
+Any additional generally useful column types should be placed in the renderer code \
here, so anybody can use it anywhere else. Any code specific to the current \
application (such as the addition of <input> elements in a column) should be placed \
in the code of the thing using the renderer.
-=item * B<new>(navHashFile, parmHashFile, genCourseAndUserOptions, \
genMailDiscussStatus): Binds a new navmap object to the compiled nav map hash and \
parm hash given as filenames. genCourseAndUserOptions is a flag saying whether 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. +At the core of the \
renderer is the array reference COLS (see Example section below for how to pass this \
correctly). The COLS array will consist of entries of one of two types of things: \
Either an integer representing one of the pre-packaged column types, or a sub \
reference that takes a resource reference, a part number, and a reference to the \
argument hash passed to the renderer, and returns a string that will be inserted into \
the HTML representation as it.
-=item * B<getIterator>(first, finish, filter, condition): See iterator documentation \
below. +The pre-packaged column names are refered to by constants in the \
Apache::lonnavmaps::renderer namespace. The following currently exist:
-=cut
+=over 4
-use strict;
-use GDBM_File;
+=item * B<resource>: The general info about the resource: Link, icon for the type, \
etc. The first column in the standard nav map display. This column also accepts the \
following parameter in the renderer hash:
-sub new {
- # magic invocation to create a class instance
- my $proto = shift;
- my $class = ref($proto) || $proto;
- my $self = {};
+=over 4
- $self->{NAV_HASH_FILE} = shift;
- $self->{PARM_HASH_FILE} = shift;
- $self->{GENERATE_COURSE_USER_OPT} = shift;
- $self->{GENERATE_EMAIL_DISCUSS_STATUS} = shift;
+=item * B<resource_nolink>: If true, the resource will not be linked. Default: \
false, resource will have links.
- # 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.
- $self->{RESOURCE_CACHE} = {};
+=item * B<resource_part_count>: If true (default), the resource will show a part \
count if the full part list is not displayed. If false, the resource will never show \
a part count.
- # Network failure flag, if we accessed the course or user opt and
- # failed
- $self->{NETWORK_FAILURE} = 0;
+=back
- # tie the nav hash
+=item B<communication_status>: Whether there is discussion on the resource, email \
for the user, or (lumped in here) perl errors in the execution of the problem. This \
is the second column in the main nav map.
- if (!(tie(%navmaphash, 'GDBM_File', $self->{NAV_HASH_FILE},
- &GDBM_READER(), 0640))) {
- return undef;
- }
-
- if (!(tie(%parmhash, 'GDBM_File', $self->{PARM_HASH_FILE},
- &GDBM_READER(), 0640)))
- {
- untie $self->{PARM_HASH};
- return undef;
- }
+=item B<quick_status>: An icon for the status of a problem, with four possible \
states: Correct, incorrect, open, or none (not open yet, not a problem). The third \
column of the standard navmap.
- $self->{HASH_TIED} = 1;
- $self->{NAV_HASH} = \%navmaphash;
- $self->{PARM_HASH} = \%parmhash;
+=item B<long_status>: A text readout of the details of the current status of the \
problem, such as "Due in 22 hours". The fourth column of the standard navmap.
- bless($self);
-
- return $self;
-}
+=back
-sub init {
- my $self = shift;
+If you add any others please be sure to document them here.
- # If the course opt hash and the user opt hash should be generated,
- # generate them
- if ($self->{GENERATE_COURSE_USER_OPT}) {
- my $uname=$ENV{'user.name'};
- my $udom=$ENV{'user.domain'};
- my $uhome=$ENV{'user.home'};
- my $cid=$ENV{'request.course.id'};
- my $chome=$ENV{'course.'.$cid.'.home'};
- my ($cdom,$cnum)=split(/\_/,$cid);
-
- my $userprefix=$uname.'_'.$udom.'_';
-
- my %courserdatas; my %useropt; my %courseopt; my %userrdatas;
- unless ($uhome eq 'no_host') {
-# ------------------------------------------------- Get coursedata (if present)
- unless ((time-$courserdatas{$cid.'.last_cache'})<240) {
- my $reply=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum.
- ':resourcedata',$chome);
- if ($reply!~/^error\:/) {
- $courserdatas{$cid}=$reply;
- $courserdatas{$cid.'.last_cache'}=time;
- }
- # check to see if network failed
- elsif ( $reply=~/no.such.host/i || $reply=~/con.*lost/i )
- {
- $self->{NETWORK_FAILURE} = 1;
- }
- }
- foreach (split(/\&/,$courserdatas{$cid})) {
- my ($name,$value)=split(/\=/,$_);
- $courseopt{$userprefix.&Apache::lonnet::unescape($name)}=
- &Apache::lonnet::unescape($value);
- }
-# --------------------------------------------------- Get userdata (if present)
- unless ((time-$userrdatas{$uname.'___'.$udom.'.last_cache'})<240) {
- my $reply=&Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome);
- if ($reply!~/^error\:/) {
- $userrdatas{$uname.'___'.$udom}=$reply;
- $userrdatas{$uname.'___'.$udom.'.last_cache'}=time;
- }
- # check to see if network failed
- elsif ( $reply=~/no.such.host/i || $reply=~/con.*lost/i )
- {
- $self->{NETWORK_FAILURE} = 1;
- }
- }
- foreach (split(/\&/,$userrdatas{$uname.'___'.$udom})) {
- my ($name,$value)=split(/\=/,$_);
- $useropt{$userprefix.&Apache::lonnet::unescape($name)}=
- &Apache::lonnet::unescape($value);
- }
- $self->{COURSE_OPT} = \%courseopt;
- $self->{USER_OPT} = \%useropt;
- }
- }
+An example of a column renderer that will show the ID number of a resource, along \
with the part name if any:
- 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'});
+ sub {
+ my ($resource, $part, $params) = @_;
+ if ($part) { return '<td>' . $resource->{ID} . ' ' . $part . '</td>'; }
+ return '<td>' . $resource->{ID} . '</td>';
+ }
- 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;
-
- }
+Note these functions are responsible for the TD tags, which allow them to override \
vertical and horizontal alignment, etc.
- $self->{PARM_CACHE} = {};
-}
+=head2 Parameters
-# Internal function: Takes a key to look up in the nav hash and implements internal
-# memory caching of that key.
-sub navhash {
- my $self = shift; my $key = shift;
- return $self->{NAV_HASH}->{$key};
-}
+=over 4
-# Checks to see if coursemap is defined, matching test in old lonnavmaps
-sub courseMapDefined {
- my $self = shift;
- my $uri = &Apache::lonnet::clutter($ENV{'request.course.uri'});
+=item * B<iterator>: A reference to a fresh ::iterator to use from the navmaps. The \
rendering will reflect the options passed to the iterator, so you can use that to \
just render a certain part of the course, if you like.
- my $firstres = $self->navhash("map_start_$uri");
- my $lastres = $self->navhash("map_finish_$uri");
- return $firstres && $lastres;
-}
+=item * B<cols>: An array reference
-sub getIterator {
- my $self = shift;
- my $iterator = Apache::lonnavmaps::iterator->new($self, shift, shift,
- shift, undef, shift);
- return $iterator;
-}
+=item * B<showParts>: A flag. If yes (default), a line for the resource itself, and \
a line for each part will be displayed. If not, only one line for each resource will \
be displayed.
-# unties the hash when done
-sub untieHashes {
- my $self = shift;
- untie %{$self->{NAV_HASH}} if ($self->{HASH_TIED});
- untie %{$self->{PARM_HASH}} if ($self->{HASH_TIED});
- $self->{HASH_TIED} = 0;
-}
+=item * B<condenseParts>: A flag. If yes (default), if all parts of the problem have \
the same status and that status is Nothing Set, Correct, or Network Failure, then \
only one line will be displayed for that resource anyhow. If no, all parts will \
always be displayed. If showParts is 0, this is ignored.
-# when the object is destroyed, be sure to untie all the hashes we tied.
-sub DESTROY {
- my $self = shift;
- $self->untieHashes();
-}
+=item * B<jumpCount>: A string identifying the URL to place the anchor 'curloc' at. \
Default to no anchor at all. It is the responsibility of the renderer user to ensure \
that the #curloc is in the URL.
-# Private method: Does the given resource (as a symb string) have
-# current discussion? Returns 0 if chat/mail data not extracted.
-sub hasDiscussion {
- my $self = shift;
- my $symb = shift;
- if (!defined($self->{DISCUSSION_TIME})) { return 0; }
+=item * B<hereURL>: A URL identifying where to place the 'here' marker.
- #return defined($self->{DISCUSSION_TIME}->{$symb});
- return $self->{DISCUSSION_TIME}->{$symb} >
- $self->{LAST_CHECK};
-}
+=item * B<hereSymb>: A Symb identifying where to place the 'here' marker.
-# Private method: Does the given resource (as a symb string) have
-# current feedback? Returns the string in the feedback hash, which
-# will be false if it does not exist.
-sub getFeedback {
- my $self = shift;
- my $symb = shift;
+=item * B<indentString>: A string identifying the indentation string to use. By \
default, this is a 25 pixel whitespace image with no alt text.
- if (!defined($self->{FEEDBACK})) { return ""; }
-
- return $self->{FEEDBACK}->{$symb};
-}
+=item * B<queryString>: A string which will be prepended to the query string used \
when the folders are opened or closed.
-# Private method: Get the errors for that resource (by source).
-sub getErrors {
- my $self = shift;
- my $src = shift;
-
- if (!defined($self->{ERROR_MSG})) { return ""; }
- return $self->{ERROR_MSG}->{$src};
-}
+=item * B<url>: The url the folders will link to, which should be the current page. \
Required if the resource info column is shown.
-=pod
-
-=item * B<getById>(id): Based on the ID of the resource (1.1, 3.2, etc.), get a \
resource object for that resource. This method, or other methods that use it (as in \
the resource object) is the only proper way to obtain a resource \
object.
-
-=cut
-
-# The strategy here is to cache the resource objects, and only construct them
-# as we use them. The real point is to prevent reading any more from the tied
-# hash then we have to, which should hopefully alleviate speed problems.
-# Caching is just an incidental detail I throw in because it makes sense.
-
-sub getById {
- my $self = shift;
- my $id = shift;
-
- if (defined ($self->{RESOURCE_CACHE}->{$id}))
- {
- return $self->{RESOURCE_CACHE}->{$id};
- }
-
- # resource handles inserting itself into cache.
- return Apache::lonnavmaps::resource->new($self, $id);
-}
-
-=pod
-
-=item * B<firstResource>(): Returns a resource object reference corresponding to the \
first resource in the navmap. +=back
-=cut
+=head2 Additional Info
-sub firstResource {
- my $self = shift;
- my $firstResource = $self->navhash('map_start_' .
- &Apache::lonnet::clutter($ENV{'request.course.uri'}));
- return $self->getById($firstResource);
-}
+In addition to the parameters you can pass to the renderer, which will be passed \
through unchange to the column renderers, the renderer will generate the following \
information which your renderer may find useful:
-=pod
+=over 4
-=item * B<finishResource>(): Returns a resource object reference corresponding to \
the last resource in the navmap. +=back
=cut
-sub finishResource {
- my $self = shift;
- my $firstResource = $self->navhash('map_finish_' .
- &Apache::lonnet::clutter($ENV{'request.course.uri'}));
- return $self->getById($firstResource);
-}
-
-# Parmval reads the parm hash and cascades the lookups. parmval_real does
-# the actual lookup; parmval caches the results.
-sub parmval {
- my $self = shift;
- my ($what,$symb)=@_;
- my $hashkey = $what."|||".$symb;
-
- if (defined($self->{PARM_CACHE}->{$hashkey})) {
- return $self->{PARM_CACHE}->{$hashkey};
- }
-
- my $result = $self->parmval_real($what, $symb);
- $self->{PARM_CACHE}->{$hashkey} = $result;
- return $result;
-}
-
-sub parmval_real {
- my $self = shift;
- my ($what,$symb) = @_;
-
- my $cid=$ENV{'request.course.id'};
- my $csec=$ENV{'request.course.sec'};
- my $uname=$ENV{'user.name'};
- my $udom=$ENV{'user.domain'};
-
- unless ($symb) { return ''; }
- my $result='';
-
- my ($mapname,$id,$fn)=split(/\_\_\_/,$symb);
-
-# ----------------------------------------------------- Cascading lookup scheme
- my $rwhat=$what;
- $what=~s/^parameter\_//;
- $what=~s/\_/\./;
-
- my $symbparm=$symb.'.'.$what;
- my $mapparm=$mapname.'___(all).'.$what;
- my $usercourseprefix=$uname.'_'.$udom.'_'.$cid;
+sub resource { return 0; }
+sub communication_status { return 1; }
+sub quick_status { return 2; }
+sub long_status { return 3; }
- my $seclevel= $usercourseprefix.'.['.$csec.'].'.$what;
- my $seclevelr=$usercourseprefix.'.['.$csec.'].'.$symbparm;
- my $seclevelm=$usercourseprefix.'.['.$csec.'].'.$mapparm;
+# Data for render_resource
- my $courselevel= $usercourseprefix.'.'.$what;
- my $courselevelr=$usercourseprefix.'.'.$symbparm;
- my $courselevelm=$usercourseprefix.'.'.$mapparm;
+my $resObj = 'Apache::lonnavmaps::resource';
+# Defines a status->color mapping, null string means don't color
+my %colormap =
+ ( $resObj->NETWORK_FAILURE => '',
+ $resObj->CORRECT => '',
+ $resObj->EXCUSED => '#3333FF',
+ $resObj->PAST_DUE_ANSWER_LATER => '',
+ $resObj->PAST_DUE_NO_ANSWER => '',
+ $resObj->ANSWER_OPEN => '#006600',
+ $resObj->OPEN_LATER => '',
+ $resObj->TRIES_LEFT => '',
+ $resObj->INCORRECT => '',
+ $resObj->OPEN => '',
+ $resObj->NOTHING_SET => '' );
+# And a special case in the nav map; what to do when the assignment
+# is not yet done and due in less then 24 hours
+my $hurryUpColor = "#FF0000";
- my $useropt = $self->{USER_OPT};
- my $courseopt = $self->{COURSE_OPT};
- my $parmhash = $self->{PARM_HASH};
+sub render_resource {
+ my ($resource, $part, $params) = @_;
-# ---------------------------------------------------------- first, check user
- if ($uname and defined($useropt)) {
- if (defined($$useropt{$courselevelr})) { return $$useropt{$courselevelr}; }
- if (defined($$useropt{$courselevelm})) { return $$useropt{$courselevelm}; }
- if (defined($$useropt{$courselevel})) { return $$useropt{$courselevel}; }
- }
+ my $nonLinkedText = ''; # stuff after resource title not in link
-# ------------------------------------------------------- second, check course
- if ($csec and defined($courseopt)) {
- if (defined($$courseopt{$seclevelr})) { return $$courseopt{$seclevelr}; }
- if (defined($$courseopt{$seclevelm})) { return $$courseopt{$seclevelm}; }
- if (defined($$courseopt{$seclevel})) { return $$courseopt{$seclevel}; }
+ my $it = $params->{'iterator'};
+ my $filter = $it->{FILTER};
+ my $stack = $it->getStack();
+ my $src = getLinkForResource($stack);
+
+ my $srcHasQuestion = $src =~ /\?/;
+ my $link = $src.
+ ($srcHasQuestion?'&':'?') .
+ 'symb=' . &Apache::lonnet::escape($resource->symb()).
+ '"';
+
+ my $title = $resource->compTitle();
+ if ($src =~ /^\/uploaded\//) {
+ $nonLinkedText=$title;
+ $title = '';
}
-
- if (defined($courseopt)) {
- if (defined($$courseopt{$courselevelr})) { return \
$$courseopt{$courselevelr}; }
- if (defined($$courseopt{$courselevelm})) { return \
$$courseopt{$courselevelm}; }
- if (defined($$courseopt{$courselevel})) { return $$courseopt{$courselevel}; \
} + my $partLabel = "";
+ my $newBranchText = "";
+
+ # If this is a new branch, label it so
+ if ($params->{'isNewBranch'}) {
+ $newBranchText = "<img src='/adm/lonIcons/branch.gif' border='0' />";
+ $params->{'isNewBranch'} = 0;
}
-# ----------------------------------------------------- third, check map parms
-
- my $thisparm=$$parmhash{$symbparm};
- if (defined($thisparm)) { return $thisparm; }
-
-# ----------------------------------------------------- fourth , check default
-
- my $default=&Apache::lonnet::metadata($fn,$rwhat.'.default');
- if (defined($default)) { return $default}
-
-# --------------------------------------------------- fifth , cascade up parts
+ # links to open and close the folder
+ my $linkopen = "<a href='$link'>";
+ my $linkclose = "</a>";
- my ($space,@qualifier)=split(/\./,$rwhat);
- my $qualifier=join('.',@qualifier);
- unless ($space eq '0') {
- my ($part,$id)=split(/\_/,$space);
- if ($id) {
- my $partgeneral=$self->parmval($part.".$qualifier",$symb);
- if (defined($partgeneral)) { return $partgeneral; }
+ # Default icon: HTML page
+ my $icon = "<img src='/adm/lonIcons/html.gif' alt='' border='0' />";
+
+ if ($resource->is_problem()) {
+ if ($part eq "0" || $params->{'condensed'}) {
+ $icon = '<img src="/adm/lonIcons/problem.gif" alt="" border="0" />';
} else {
- my $resourcegeneral=$self->parmval("0.$qualifier",$symb);
- if (defined($resourcegeneral)) { return $resourcegeneral; }
+ $icon = $params->{'indentString'};
}
}
- return '';
-}
-
-
-1;
-
-package Apache::lonnavmaps::renderer;
-
-=pod
-
-=head1 navmap renderer
-
-The navmaprenderer package provides a sophisticated rendering of the standard \
navigation maps interface into HTML. The provided nav map handler is actually just a \
glorified call to this.
-
-Because of the large number of parameters this function presents, instead of passing \
it arguments as is normal, pass it in an anonymous hash with the given options. This \
is because there is no obvious order you may wish to override these in and a hash is \
easier to read and understand then "undef, undef, undef, 1, undef, undef, \
renderButton, undef, 0" when you mostly want default behaviors.
-
-The package provides a function called 'render', called as \
Apache::lonnavmaps::renderer->render({}).
-
-=head2 Overview of Columns
-
-The renderer will build an HTML table for the navmap and return it. The table is \
consists of several columns, and a row for each resource (or possibly each part). You \
tell the renderer how many columns to create and what to place in each column, \
optionally using one or more of the preparent columns, and the renderer will assemble \
the table.
-
-Any additional generally useful column types should be placed in the renderer code \
here, so anybody can use it anywhere else. Any code specific to the current \
application (such as the addition of <input> elements in a column) should be placed \
in the code of the thing using the renderer.
-
-At the core of the renderer is the array reference COLS (see Example section below \
for how to pass this correctly). The COLS array will consist of entries of one of two \
types of things: Either an integer representing one of the pre-packaged column types, \
or a sub reference that takes a resource reference, a part number, and a reference to \
the argument hash passed to the renderer, and returns a string that will be inserted \
into the HTML representation as it.
-
-The pre-packaged column names are refered to by constants in the \
Apache::lonnavmaps::renderer namespace. The following currently \
exist:
-
-=over 4
-
-=item * B<resource>: The general info about the resource: Link, icon for the type, \
etc. The first column in the standard nav map display. This column also accepts the \
following parameter in the renderer hash:
-
-=over 4
-
-=item * B<resource_nolink>: If true, the resource will not be linked. Default: \
false, resource will have links.
-
-=item * B<resource_part_count>: If true (default), the resource will show a part \
count if the full part list is not displayed. If false, the resource will never show \
a part count.
-
-=back
-
-=item B<communication_status>: Whether there is discussion on the resource, email \
for the user, or (lumped in here) perl errors in the execution of the problem. This \
is the second column in the main nav map.
-
-=item B<quick_status>: An icon for the status of a problem, with four possible \
states: Correct, incorrect, open, or none (not open yet, not a problem). The third \
column of the standard navmap.
-
-=item B<long_status>: A text readout of the details of the current status of the \
problem, such as "Due in 22 hours". The fourth column of the standard \
navmap.
-
-=back
-
-If you add any others please be sure to document them here.
-
-An example of a column renderer that will show the ID number of a resource, along \
with the part name if any:
-
- sub {
- my ($resource, $part, $params) = @_;
- if ($part) { return '<td>' . $resource->{ID} . ' ' . $part . '</td>'; }
- return '<td>' . $resource->{ID} . '</td>';
- }
-
-Note these functions are responsible for the TD tags, which allow them to override \
vertical and horizontal alignment, etc.
-
-=head2 Parameters
-
-=over 4
-
-=item * B<iterator>: A reference to a fresh ::iterator to use from the navmaps. The \
rendering will reflect the options passed to the iterator, so you can use that to \
just render a certain part of the course, if you like.
-=item * B<cols>: An array reference
+ # Display the correct map icon to open or shut map
+ if ($resource->is_map()) {
+ my $mapId = $resource->map_pc();
+ my $nowOpen = !defined($filter->{$mapId});
+ if ($it->{CONDITION}) {
+ $nowOpen = !$nowOpen;
+ }
+ $icon = 'navmap.folder.' . ($nowOpen ? 'closed' : 'open') . '.gif';
+ $icon = "<img src='/adm/lonIcons/$icon' alt='' border='0' />";
+
+ $linkopen = "<a href='" . $params->{'url'} . '?' .
+ $params->{'queryString'} . '&filter=';
+ $linkopen .= ($nowOpen xor $it->{CONDITION}) ?
+ addToFilter($filter, $mapId) :
+ removeFromFilter($filter, $mapId);
+ $linkopen .= "&condition=" . $it->{CONDITION} . '&hereType='
+ . $params->{'hereType'} . '&here=' .
+ &Apache::lonnet::escape($params->{'here'}) .
+ '&jumpType=' . SYMB() . '&jump=' .
+ &Apache::lonnet::escape($params->{$resource->symb()}) . "'>";
+ }
-=item * B<showParts>: A flag. If yes (default), a line for the resource itself, and \
a line for each part will be displayed. If not, only one line for each resource will \
be displayed. + if ($resource->randomout()) {
+ $nonLinkedText .= ' <i>(hidden)</i> ';
+ }
+
+ # We're done preparing and finally ready to start the rendering
+ my $result = "<td align='left' valign='center'>";
+
+ # print indentation
+ for (my $i = 0; $i < $params->{'indentLevel'} -
+ $params->{'deltaLevel'}; $i++) {
+ $result .= $params->{'indentString'};
+ }
-=item * B<condenseParts>: A flag. If yes (default), if all parts of the problem have \
the same status and that status is Nothing Set, Correct, or Network Failure, then \
only one line will be displayed for that resource anyhow. If no, all parts will \
always be displayed. If showParts is 0, this is ignored. + # Decide what to \
display + $result .= "$newBranchText$linkopen$icon$linkclose";
+
+ my $curMarkerBegin = '';
+ my $curMarkerEnd = '';
-=item * B<jumpCount>: A string identifying the URL to place the anchor 'curloc' at. \
Default to no anchor at all. It is the responsibility of the renderer user to ensure \
that the #curloc is in the URL. + # Is this the current resource?
+ if (!$params->{'displayedHereMarker'} &&
+ (($params->{'hereType'} == SYMB() &&
+ $resource->symb() eq $params->{'here'}) ||
+ ($params->{'hereType'} == URL() &&
+ $resource->src() eq $params->{'here'}))) {
+ $curMarkerBegin = '<font color="red" size="+2">> </font>';
+ $curMarkerEnd = '<font color="red" size="+2"><</font>';
+ }
-=item * B<hereURL>: A URL identifying where to place the 'here' marker.
+ if ($resource->is_problem() && $part ne "0" &&
+ !$params->{'condensed'}) {
+ $partLabel = " (Part $part)";
+ $title = "";
+ }
-=item * B<hereSymb>: A Symb identifying where to place the 'here' marker.
+ if ($params->{'multipart'} && $params->{'condensed'}) {
+ $nonLinkedText .= ' (' . $resource->countParts() . ' parts)';
+ }
-=item * B<indentString>: A string identifying the indentation string to use. By \
default, this is a 25 pixel whitespace image with no alt text. + $result .= " \
$curMarkerBegin<a href='$link'>$title$partLabel</a>$curMarkerEnd $nonLinkedText";
-=back
+ return $result;
+}
-=cut
+sub render_communication_status {
+ my ($resource, $part, $params) = @_;
+ return "<td align='center'>comm_status</td>";
+}
+sub render_quick_status {
+ my ($resource, $part, $params) = @_;
+ return "<td align='center'>quick_status</td>";
+}
+sub render_long_status {
+ my ($resource, $part, $params) = @_;
+ return "<td align='center'>long_status</td>";
+}
-sub resource { return 0; }
-sub communication_status { return 1; }
-sub quick_status { return 2; }
-sub long_status { return 3; }
+my @preparedColumns = (\&render_resource, \&render_communication_status,
+ \&render_quick_status, \&render_long_status);
sub setDefault {
my ($val, $default) = @_;
@@ -1460,10 +1230,14 @@
my $condenseParts = setDefault($args->{'condenseParts'}, 1);
my $jumpToURL = $args->{'jumpToURL'};
my $jumpToSymb = $args->{'jumpToSymb'};
- my $indentString = setDefault($args->{'indentString'}, "<img \
src='/adm/lonIcons/whitespace1.gif' width='25' height='1' alt='' \
border='0' />");
-
+ my $hereURL = $args->{'hereURL'};
+ my $hereSymb = $args->{'hereSymb'};
+
+ #if (defined($jumpToURL)) {
+ # $args->{'jumpType'} =
+
# End parameter setting
-
+
# Data
my $result .= '<table cellspacing="0" cellpadding="3" border="0" \
bgcolor="#FFFFFF">' ."\n"; my $res = "Apache::lonnavmaps::resource";
@@ -1472,17 +1246,27 @@
$res->NOTHING_SET => 1,
$res->CORRECT => 1 );
my @backgroundColors = ("#FFFFFF", "#F6F6F6");
+ my $currentJumpIndex = 0; # keeps track of when the current resource is found,
+ # so we can back up a few and put the anchor above the
+ # current resource
+ my $currentJumpDelta = 2; # change this to change how many resources are \
displayed + # before the current resource when using \
#current +
+ # Shared variables
+ $args->{'counter'} = 0; # counts the rows
+ $args->{'indentLevel'} = 0;
+ $args->{'isNewBranch'} = 0;
+ $args->{'condensed'} = 0;
+ $args->{'indentString'} = setDefault($args->{'indentString'}, "<img \
src='/adm/lonIcons/whitespace1.gif' width='25' height='1' alt='' border='0' />"); + \
$args->{'displayedHereMarker'} = 0;
+ my $displayedJumpMarker = 0;
# Set up iteration.
my $depth = 1;
$it->next(); # discard initial BEGIN_MAP
my $curRes = $it->next();
- my $indentLevel = 0;
- my $isNewBranch = 0;
my $now = time();
my $in24Hours = $now + 24 * 60 * 60;
- my $displayedHereMarker = 0;
- my $displayedJumpMarker = 0;
my $rownum = 0;
while ($depth > 0) {
@@ -1492,19 +1276,27 @@
# Maintain indentation level.
if ($curRes == $it->BEGIN_MAP() ||
$curRes == $it->BEGIN_BRANCH() ) {
- indentLevel++;
+ $args->{'indentLevel'}++;
}
if ($curRes == $it->END_MAP() ||
$curRes == $it->END_BRANCH() ) {
- $indentLevel--;
+ $args->{'indentLevel'}--;
}
# Notice new branches
if ($curRes == $it->BEGIN_BRANCH()) {
- $isNewBranch = 1;
+ $args->{'isNewBranch'} = 1;
}
-
- my $deltalevel = $isNewBranch? 1 : 0; # reserve space for branch symbol
- if ($indentLevel - $deltalevel < 0) {
+
+ # If this isn't an actual resource, continue on
+ if (!ref($curRes)) {
+ $curRes = $it->next();
+ next;
+ }
+
+ $args->{'counter'}++;
+ # reserve space for branch symbol
+ $args->{'deltalevel'} = $args->{'isNewBranch'}? 1 : 0;
+ if ($args->{'indentLevel'} - $args->{'deltalevel'} < 0) {
# If this would be at a negative depth (top-level maps in
# new-style courses, we want to suppress their title display)
# then ignore it.
@@ -1513,21 +1305,21 @@
}
# Does it have multiple parts?
- my $multipart = 0;
- my $condensed = 0;
+ $args->{'multipart'} = 0;
+ $args->{'condensed'} = 0;
my @parts;
# Decide what parts to show.
- if ($showParts) {
+ if ($curRes->is_problem() && $showParts) {
@parts = @{$curRes->parts()};
- $multipart = scalar(@parts) > 1;
+ $args->{'multipart'} = scalar(@parts) > 1;
if ($condenseParts) { # do the condensation
if (!$curRes->opendate("0")) {
@parts = ("0");
- $condensed = 1;
+ $args->{'condensed'} = 1;
}
- if (!$condensed) {
+ if (!$args->{'condensed'}) {
# Decide whether to condense based on similarity
my $status = $curRes->status($parts[1]);
my $due = $curRes->duedate($parts[1]);
@@ -1557,7 +1349,7 @@
($dueAllSame && $status == $curRes->OPEN && \
$statusAllSame)||
($openAllSame && $status == $curRes->OPEN_LATER && \
$statusAllSame) ){ @parts = ($parts[1]);
- $condensed = 1;
+ $args->{'condensed'} = 1;
}
}
@@ -1570,7 +1362,7 @@
# If the multipart problem was condensed, "forget" it was multipart
if (scalar(@parts) == 1) {
- $multipart = 0;
+ $args->{'multipart'} = 0;
}
# In the event of a network error, display one part.
@@ -1593,8 +1385,21 @@
foreach my $col (@$cols) {
$result .= " <td>";
- # Decide what to display
-
+ # If this is the first column and it's time to print
+ # the anchor, do so
+ if ($col == $cols->[0] &&
+ $args->{'counter'} == $args->{'currentJumpIndex'} -
+ $args->{'currentJumpDelta'}) {
+ $result .= '<a name="curloc" />';
+ $displayedJumpMarker = 1;
+ }
+
+
+ if (ref($col)) {
+ $result .= &$col($curRes, $part, $args);
+ } else {
+ $result .= &{$preparedColumns[$col]}($curRes, $part, $args);
+ }
$result .= "</td>\n";
}
@@ -1611,25 +1416,406 @@
return $result;
}
-sub render_resource {
- my ($resource, $part, $params) = @_;
- return "<td align='center'>resource</td>";
+1;
+
+package Apache::lonnavmaps::navmap;
+
+=pod
+
+lonnavmaps provides functions and objects for dealing with the compiled course \
hashes generated when a user enters the course, the Apache handler for the \
"Navigation Map" button, and a flexible prepared renderer for navigation maps that \
are easy to use anywhere. +
+=head1 navmap object: Encapsulating the compiled nav map
+
+navmap is an object that encapsulates a compiled course map and provides a \
reasonable interface to it. +
+Most notably it provides a way to navigate the map sensibly and a flexible iterator \
that makes it easy to write various renderers based on nav maps. +
+You must obtain resource objects through the navmap object.
+
+=head2 Methods
+
+=over 4
+
+=item * B<new>(navHashFile, parmHashFile, genCourseAndUserOptions, \
genMailDiscussStatus): Binds a new navmap object to the compiled nav map hash and \
parm hash given as filenames. genCourseAndUserOptions is a flag saying whether 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. +
+=item * B<getIterator>(first, finish, filter, condition): See iterator documentation \
below. +
+=cut
+
+use strict;
+use GDBM_File;
+
+sub new {
+ # magic invocation to create a class instance
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = {};
+
+ $self->{NAV_HASH_FILE} = shift;
+ $self->{PARM_HASH_FILE} = shift;
+ $self->{GENERATE_COURSE_USER_OPT} = shift;
+ $self->{GENERATE_EMAIL_DISCUSS_STATUS} = shift;
+
+ # 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.
+ $self->{RESOURCE_CACHE} = {};
+
+ # Network failure flag, if we accessed the course or user opt and
+ # failed
+ $self->{NETWORK_FAILURE} = 0;
+
+ # tie the nav hash
+
+ if (!(tie(%navmaphash, 'GDBM_File', $self->{NAV_HASH_FILE},
+ &GDBM_READER(), 0640))) {
+ return undef;
+ }
+
+ if (!(tie(%parmhash, 'GDBM_File', $self->{PARM_HASH_FILE},
+ &GDBM_READER(), 0640)))
+ {
+ untie $self->{PARM_HASH};
+ return undef;
+ }
+
+ $self->{HASH_TIED} = 1;
+ $self->{NAV_HASH} = \%navmaphash;
+ $self->{PARM_HASH} = \%parmhash;
+
+ bless($self);
+
+ return $self;
}
-sub render_communication_status {
- my ($resource, $part, $params) = @_;
- return "<td align='center'>comm_status</td>";
+
+sub init {
+ my $self = shift;
+
+ # If the course opt hash and the user opt hash should be generated,
+ # generate them
+ if ($self->{GENERATE_COURSE_USER_OPT}) {
+ my $uname=$ENV{'user.name'};
+ my $udom=$ENV{'user.domain'};
+ my $uhome=$ENV{'user.home'};
+ my $cid=$ENV{'request.course.id'};
+ my $chome=$ENV{'course.'.$cid.'.home'};
+ my ($cdom,$cnum)=split(/\_/,$cid);
+
+ my $userprefix=$uname.'_'.$udom.'_';
+
+ my %courserdatas; my %useropt; my %courseopt; my %userrdatas;
+ unless ($uhome eq 'no_host') {
+# ------------------------------------------------- Get coursedata (if present)
+ unless ((time-$courserdatas{$cid.'.last_cache'})<240) {
+ my $reply=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum.
+ ':resourcedata',$chome);
+ if ($reply!~/^error\:/) {
+ $courserdatas{$cid}=$reply;
+ $courserdatas{$cid.'.last_cache'}=time;
+ }
+ # check to see if network failed
+ elsif ( $reply=~/no.such.host/i || $reply=~/con.*lost/i )
+ {
+ $self->{NETWORK_FAILURE} = 1;
+ }
+ }
+ foreach (split(/\&/,$courserdatas{$cid})) {
+ my ($name,$value)=split(/\=/,$_);
+ $courseopt{$userprefix.&Apache::lonnet::unescape($name)}=
+ &Apache::lonnet::unescape($value);
+ }
+# --------------------------------------------------- Get userdata (if present)
+ unless ((time-$userrdatas{$uname.'___'.$udom.'.last_cache'})<240) {
+ my $reply=&Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome);
+ if ($reply!~/^error\:/) {
+ $userrdatas{$uname.'___'.$udom}=$reply;
+ $userrdatas{$uname.'___'.$udom.'.last_cache'}=time;
+ }
+ # check to see if network failed
+ elsif ( $reply=~/no.such.host/i || $reply=~/con.*lost/i )
+ {
+ $self->{NETWORK_FAILURE} = 1;
+ }
+ }
+ foreach (split(/\&/,$userrdatas{$uname.'___'.$udom})) {
+ my ($name,$value)=split(/\=/,$_);
+ $useropt{$userprefix.&Apache::lonnet::unescape($name)}=
+ &Apache::lonnet::unescape($value);
+ }
+ $self->{COURSE_OPT} = \%courseopt;
+ $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;
+
+ }
+
+ $self->{PARM_CACHE} = {};
}
-sub render_quick_status {
- my ($resource, $part, $params) = @_;
- return "<td align='center'>quick_status</td>";
+
+# Internal function: Takes a key to look up in the nav hash and implements internal
+# memory caching of that key.
+sub navhash {
+ my $self = shift; my $key = shift;
+ return $self->{NAV_HASH}->{$key};
}
-sub render_long_status {
- my ($resource, $part, $params) = @_;
- return "<td align='center'>long_status</td>";
+
+# Checks to see if coursemap is defined, matching test in old lonnavmaps
+sub courseMapDefined {
+ my $self = shift;
+ my $uri = &Apache::lonnet::clutter($ENV{'request.course.uri'});
+
+ my $firstres = $self->navhash("map_start_$uri");
+ my $lastres = $self->navhash("map_finish_$uri");
+ return $firstres && $lastres;
}
-my @preparedColumns = (\&render_resource, \&render_communication_status,
- \&render_quick_status, \&render_long_status);
+sub getIterator {
+ my $self = shift;
+ my $iterator = Apache::lonnavmaps::iterator->new($self, shift, shift,
+ shift, undef, shift);
+ return $iterator;
+}
+
+# unties the hash when done
+sub untieHashes {
+ my $self = shift;
+ untie %{$self->{NAV_HASH}} if ($self->{HASH_TIED});
+ untie %{$self->{PARM_HASH}} if ($self->{HASH_TIED});
+ $self->{HASH_TIED} = 0;
+}
+
+# when the object is destroyed, be sure to untie all the hashes we tied.
+sub DESTROY {
+ my $self = shift;
+ $self->untieHashes();
+}
+
+# Private method: Does the given resource (as a symb string) have
+# current discussion? Returns 0 if chat/mail data not extracted.
+sub hasDiscussion {
+ my $self = shift;
+ my $symb = shift;
+ if (!defined($self->{DISCUSSION_TIME})) { return 0; }
+
+ #return defined($self->{DISCUSSION_TIME}->{$symb});
+ return $self->{DISCUSSION_TIME}->{$symb} >
+ $self->{LAST_CHECK};
+}
+
+# Private method: Does the given resource (as a symb string) have
+# current feedback? Returns the string in the feedback hash, which
+# will be false if it does not exist.
+sub getFeedback {
+ my $self = shift;
+ my $symb = shift;
+
+ if (!defined($self->{FEEDBACK})) { return ""; }
+
+ return $self->{FEEDBACK}->{$symb};
+}
+
+# Private method: Get the errors for that resource (by source).
+sub getErrors {
+ my $self = shift;
+ my $src = shift;
+
+ if (!defined($self->{ERROR_MSG})) { return ""; }
+ return $self->{ERROR_MSG}->{$src};
+}
+
+=pod
+
+=item * B<getById>(id): Based on the ID of the resource (1.1, 3.2, etc.), get a \
resource object for that resource. This method, or other methods that use it (as in \
the resource object) is the only proper way to obtain a resource object. +
+=cut
+
+# The strategy here is to cache the resource objects, and only construct them
+# as we use them. The real point is to prevent reading any more from the tied
+# hash then we have to, which should hopefully alleviate speed problems.
+# Caching is just an incidental detail I throw in because it makes sense.
+
+sub getById {
+ my $self = shift;
+ my $id = shift;
+
+ if (defined ($self->{RESOURCE_CACHE}->{$id}))
+ {
+ return $self->{RESOURCE_CACHE}->{$id};
+ }
+
+ # resource handles inserting itself into cache.
+ # Not clear why the quotes are necessary, but as of this
+ # writing it doesn't work without them.
+ return "Apache::lonnavmaps::resource"->new($self, $id);
+}
+
+=pod
+
+=item * B<firstResource>(): Returns a resource object reference corresponding to the \
first resource in the navmap. +
+=cut
+
+sub firstResource {
+ my $self = shift;
+ my $firstResource = $self->navhash('map_start_' .
+ &Apache::lonnet::clutter($ENV{'request.course.uri'}));
+ return $self->getById($firstResource);
+}
+
+=pod
+
+=item * B<finishResource>(): Returns a resource object reference corresponding to \
the last resource in the navmap. +
+=cut
+
+sub finishResource {
+ my $self = shift;
+ my $firstResource = $self->navhash('map_finish_' .
+ &Apache::lonnet::clutter($ENV{'request.course.uri'}));
+ return $self->getById($firstResource);
+}
+
+# Parmval reads the parm hash and cascades the lookups. parmval_real does
+# the actual lookup; parmval caches the results.
+sub parmval {
+ my $self = shift;
+ my ($what,$symb)=@_;
+ my $hashkey = $what."|||".$symb;
+
+ if (defined($self->{PARM_CACHE}->{$hashkey})) {
+ return $self->{PARM_CACHE}->{$hashkey};
+ }
+
+ my $result = $self->parmval_real($what, $symb);
+ $self->{PARM_CACHE}->{$hashkey} = $result;
+ return $result;
+}
+
+sub parmval_real {
+ my $self = shift;
+ my ($what,$symb) = @_;
+
+ my $cid=$ENV{'request.course.id'};
+ my $csec=$ENV{'request.course.sec'};
+ my $uname=$ENV{'user.name'};
+ my $udom=$ENV{'user.domain'};
+
+ unless ($symb) { return ''; }
+ my $result='';
+
+ my ($mapname,$id,$fn)=split(/\_\_\_/,$symb);
+
+# ----------------------------------------------------- Cascading lookup scheme
+ my $rwhat=$what;
+ $what=~s/^parameter\_//;
+ $what=~s/\_/\./;
+
+ my $symbparm=$symb.'.'.$what;
+ my $mapparm=$mapname.'___(all).'.$what;
+ my $usercourseprefix=$uname.'_'.$udom.'_'.$cid;
+
+ my $seclevel= $usercourseprefix.'.['.$csec.'].'.$what;
+ my $seclevelr=$usercourseprefix.'.['.$csec.'].'.$symbparm;
+ my $seclevelm=$usercourseprefix.'.['.$csec.'].'.$mapparm;
+
+ my $courselevel= $usercourseprefix.'.'.$what;
+ my $courselevelr=$usercourseprefix.'.'.$symbparm;
+ my $courselevelm=$usercourseprefix.'.'.$mapparm;
+
+ my $useropt = $self->{USER_OPT};
+ my $courseopt = $self->{COURSE_OPT};
+ my $parmhash = $self->{PARM_HASH};
+
+# ---------------------------------------------------------- first, check user
+ if ($uname and defined($useropt)) {
+ if (defined($$useropt{$courselevelr})) { return $$useropt{$courselevelr}; }
+ if (defined($$useropt{$courselevelm})) { return $$useropt{$courselevelm}; }
+ if (defined($$useropt{$courselevel})) { return $$useropt{$courselevel}; }
+ }
+
+# ------------------------------------------------------- second, check course
+ if ($csec and defined($courseopt)) {
+ if (defined($$courseopt{$seclevelr})) { return $$courseopt{$seclevelr}; }
+ if (defined($$courseopt{$seclevelm})) { return $$courseopt{$seclevelm}; }
+ if (defined($$courseopt{$seclevel})) { return $$courseopt{$seclevel}; }
+ }
+
+ if (defined($courseopt)) {
+ if (defined($$courseopt{$courselevelr})) { return \
$$courseopt{$courselevelr}; } + if (defined($$courseopt{$courselevelm})) { \
return $$courseopt{$courselevelm}; } + if (defined($$courseopt{$courselevel})) \
{ return $$courseopt{$courselevel}; } + }
+
+# ----------------------------------------------------- third, check map parms
+
+ my $thisparm=$$parmhash{$symbparm};
+ if (defined($thisparm)) { return $thisparm; }
+
+# ----------------------------------------------------- fourth , check default
+
+ my $default=&Apache::lonnet::metadata($fn,$rwhat.'.default');
+ if (defined($default)) { return $default}
+
+# --------------------------------------------------- fifth , cascade up parts
+
+ my ($space,@qualifier)=split(/\./,$rwhat);
+ my $qualifier=join('.',@qualifier);
+ unless ($space eq '0') {
+ my ($part,$id)=split(/\_/,$space);
+ if ($id) {
+ my $partgeneral=$self->parmval($part.".$qualifier",$symb);
+ if (defined($partgeneral)) { return $partgeneral; }
+ } else {
+ my $resourcegeneral=$self->parmval("0.$qualifier",$symb);
+ if (defined($resourcegeneral)) { return $resourcegeneral; }
+ }
+ }
+ return '';
+}
1;
[prev in list] [next in list] [prev in thread] [next in thread]
Configure |
About |
News |
Add a list |
Sponsored by KoreLogic