--- loncom/interface/loncoursedata.pm 2002/08/30 17:11:43 1.26 +++ loncom/interface/loncoursedata.pm 2003/02/25 15:55:15 1.50 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # (Publication Handler # -# $Id: loncoursedata.pm,v 1.26 2002/08/30 17:11:43 stredwic Exp $ +# $Id: loncoursedata.pm,v 1.50 2003/02/25 15:55:15 matthew Exp $ # # Copyright Michigan State University Board of Trustees # @@ -120,9 +120,10 @@ sub DownloadClasslist { my ($courseDomain,$courseNumber)=split(/\_/,$courseID); my %classlist; - my $modifiedTime = &Apache::lonnet::GetFileTimestamp($courseDomain, $courseNumber, + my $modifiedTime = &Apache::lonnet::GetFileTimestamp($courseDomain, + $courseNumber, 'classlist.db', - $Apache::lonnet::perlvar{'lonUsersDir'}); + $Apache::lonnet::perlvar{'lonUsersDir'}); # Always download the information if lastDownloadTime is set to # Not downloaded, otherwise it is only downloaded if the file @@ -139,7 +140,7 @@ sub DownloadClasslist { %classlist=&Apache::lonnet::dump('classlist',$courseDomain, $courseNumber); foreach(keys (%classlist)) { if(/^(con_lost|error|no_such_host)/i) { - return \%classlist; + return; } } @@ -218,7 +219,8 @@ sub DownloadCourseInformation { $courseID.'.db', $Apache::lonnet::perlvar{'lonUsersDir'}); - if($lastDownloadTime >= $modifiedTime && $modifiedTime >= 0) { + if($lastDownloadTime ne 'Not downloaded' && + $lastDownloadTime >= $modifiedTime && $modifiedTime >= 0) { # Data is not gathered so return UpToDate as true. This # will be interpreted in ProcessClasslist $courseData{$namedata.':lastDownloadTime'}=time; @@ -260,6 +262,125 @@ with stopping downloading then can not t # ----- PROCESSING FUNCTIONS --------------------------------------- +#################################################### +#################################################### + +=pod + +=item &get_sequence_assessment_data() + +AT THIS TIME THE USE OF THIS FUNCTION IS *NOT* RECOMMENDED + +Use lonnavmaps to build a data structure describing the order and +assessment contents of each sequence in the current course. + +The returned structure is a hash reference. + +{ title => 'title', + symb => 'symb', + source => '/s/o/u/r/c/e', + type => (container|assessment), + num_assess => 2, # only for container + contents => [ {},{},{},{} ], # only for container + parts => [11,13,15], # only for assessment + response_ids => [12,14,16], # only for assessment + contents => [........] # only for container +} + +$hash->{'contents'} is a reference to an array of hashes of the same structure. + +Also returned are array references to the sequences and assessments contained +in the course. + + +=cut + +#################################################### +#################################################### +sub get_sequence_assessment_data { + my $fn=$ENV{'request.course.fn'}; + ## + ## use navmaps + my $navmap = Apache::lonnavmaps::navmap->new($fn.".db",$fn."_parms.db", + 1,0); + if (!defined($navmap)) { + return 'Can not open Coursemap'; + } + my $iterator = $navmap->getIterator(undef, undef, undef, 1); + ## + ## Prime the pump + ## + ## We are going to loop until we run out of sequences/pages to explore for + ## resources. This means we have to start out with something to look + ## at. + my $curRes = $iterator->next(); # BEGIN_MAP + $curRes = $iterator->next(); # The sequence itself + # + my $title = $curRes->title(); + my $symb = $curRes->symb(); + my $src = $curRes->src(); + # + my @Sequences; + my @Assessments; + my @Nested_Sequences = (); # Stack of sequences, keeps track of depth + my $top = { title => $title, + symb => $symb, + type => 'container', + num_assess => 0, + contents => [], }; + push (@Sequences,$top); + push (@Nested_Sequences, $top); + # + # We need to keep track of which sequences contain homework problems + # + my $previous = $top; + while (scalar(@Nested_Sequences)) { + $previous = $curRes; + $curRes = $iterator->next(); + my $currentmap = $Nested_Sequences[-1]; # Last one on the stack + if ($curRes == $iterator->BEGIN_MAP()) { + # get the map itself, instead of BEGIN_MAP + $title = $previous->title();#$curRes->title(); + $symb = $previous->symb;#curRes->symb(); + $src = $previous->src();#$curRes->src(); + my $newmap = { title => $title, + src => $src, + symb => $symb, + type => 'container', + num_assess => 0, + contents => [], + }; + push (@{$currentmap->{'contents'}},$newmap); # this is permanent + push (@Sequences,$newmap); + push (@Nested_Sequences, $newmap); # this is a stack + next; + } + if ($curRes == $iterator->END_MAP()) { + pop(@Nested_Sequences); + next; + } + next if (! ref($curRes)); + next if (! $curRes->is_problem());# && !$curRes->randomout); + # Okay, from here on out we only deal with assessments + $title = $curRes->title(); + $symb = $curRes->symb(); + $src = $curRes->src(); + my $parts = $curRes->parts(); + my $assessment = { title => $title, + src => $src, + symb => $symb, + type => 'assessment', + }; + push(@Assessments,$assessment); + push(@{$currentmap->{'contents'}},$assessment); + $currentmap->{'num_assess'}++; + } + return ($top,\@Sequences,\@Assessments); +} + +################################################# +################################################# + =pod =item &ProcessTopResourceMap() @@ -309,17 +430,29 @@ sub ProcessTopResourceMap { return 'Can not open Coursemap.'; } + my $oldkeys; + delete $cache->{'OptionResponses'}; + if(defined($cache->{'ResourceKeys'})) { + $oldkeys = $cache->{'ResourceKeys'}; + foreach (split(':::', $cache->{'ResourceKeys'})) { + delete $cache->{$_}; + } + delete $cache->{'ResourceKeys'}; + } + # Initialize state machine. Set information pointing to top level map. my (@sequences, @currentResource, @finishResource); my ($currentSequence, $currentResourceID, $lastResourceID); - $currentResourceID=$hash{'ids_/res/'.$ENV{'request.course.uri'}}; + $currentResourceID=$hash{'ids_'. + &Apache::lonnet::clutter($ENV{'request.course.uri'})}; push(@currentResource, $currentResourceID); $lastResourceID=-1; $currentSequence=-1; my $topLevelSequenceNumber = $currentSequence; my %sequenceRecord; + my %allkeys; while(1) { if($c->aborted()) { last; @@ -344,6 +477,7 @@ sub ProcessTopResourceMap { } else { $cache->{'orderedSequences'}.=':'.$currentSequence; } + $allkeys{'orderedSequences'}++; $lastResourceID=$hash{'map_finish_'. $hash{'src_'.$currentResourceID}}; @@ -378,20 +512,24 @@ sub ProcessTopResourceMap { $currentResourceID})); $cache->{$currentResourceID.':problem'}=$Problem; + $allkeys{$currentResourceID.':problem'}++; if(!defined($cache->{$currentSequence.':problems'})) { $cache->{$currentSequence.':problems'}=$currentResourceID; } else { $cache->{$currentSequence.':problems'}.= ':'.$currentResourceID; } + $allkeys{$currentSequence.':problems'}++; my $meta=$hash{'src_'.$currentResourceID}; # $cache->{$currentResourceID.':title'}= # &Apache::lonnet::metdata($meta,'title'); $cache->{$currentResourceID.':title'}= $hash{'title_'.$currentResourceID}; + $allkeys{$currentResourceID.':title'}++; $cache->{$currentResourceID.':source'}= $hash{'src_'.$currentResourceID}; + $allkeys{$currentResourceID.':source'}++; # Get Parts for problem my %beenHere; @@ -408,6 +546,8 @@ sub ProcessTopResourceMap { $cache->{$currentSequence.':'.$currentResourceID. ':parts'}.=':'.$partId; } + $allkeys{$currentSequence.':'.$currentResourceID. + ':parts'}++; } if($beenHere{'r:'.$partId.':'.$responseId} == 0) { $beenHere{'r:'.$partId.':'.$responseId}++; @@ -421,6 +561,8 @@ sub ProcessTopResourceMap { ':'.$partId.':responseIDs'}.=':'. $responseId; } + $allkeys{$currentSequence.':'.$currentResourceID.':'. + $partId.':responseIDs'}++; } if(/^optionresponse/ && $beenHere{'o:'.$partId.':'.$currentResourceID} == 0) { @@ -434,6 +576,7 @@ sub ProcessTopResourceMap { $currentResourceID.':'. $partId.':'.$responseId; } + $allkeys{'OptionResponses'}++; } } } @@ -449,8 +592,10 @@ sub ProcessTopResourceMap { # Capture sequence information here $cache->{$currentSequence.':title'}= $hash{'title_'.$currentResourceID}; + $allkeys{$currentSequence.':title'}++; $cache->{$currentSequence.':source'}= $hash{'src_'.$currentResourceID}; + $allkeys{$currentSequence.':source'}++; my $totalProblems=0; foreach my $currentProblem (split(/\:/, @@ -464,9 +609,9 @@ sub ProcessTopResourceMap { } my @titleLength=split(//,$cache->{$currentSequence. ':title'}); - # $extra is 3 for problems correct and 3 for space + # $extra is 5 for problems correct and 3 for space # between problems correct and problem output - my $extra = 6; + my $extra = 8; if(($totalProblems + $extra) > (scalar @titleLength)) { $cache->{$currentSequence.':columnWidth'}= $totalProblems + $extra; @@ -474,6 +619,7 @@ sub ProcessTopResourceMap { $cache->{$currentSequence.':columnWidth'}= (scalar @titleLength); } + $allkeys{$currentSequence.':columnWidth'}++; } else { # Remove sequence from list, if it contains no problems to # display. @@ -494,9 +640,9 @@ sub ProcessTopResourceMap { # big problem, need to handle. Next is probably wrong my $errorMessage = 'Big problem in '; $errorMessage .= 'loncoursedata::ProcessTopLevelMap.'; - $errorMessage .= ' bighash to_$currentResourceID not defined!'; + $errorMessage .= " bighash to_$currentResourceID not defined!"; &Apache::lonnet::logthis($errorMessage); - last; + if (!defined($currentResourceID)) {last;} } my @nextResources=(); foreach (split(/\,/,$hash{'to_'.$currentResourceID})) { @@ -510,6 +656,15 @@ sub ProcessTopResourceMap { $currentResourceID=pop(@currentResource); } + my @theKeys = keys(%allkeys); + my $newkeys = join(':::', @theKeys); + $cache->{'ResourceKeys'} = join(':::', $newkeys); + if($newkeys ne $oldkeys) { + $cache->{'ResourceUpdated'} = 'true'; + } else { + $cache->{'ResourceUpdated'} = 'false'; + } + unless (untie(%hash)) { &Apache::lonnet::logthis("WARNING: ". "Could not untie coursemap $fn (browse)". @@ -553,7 +708,24 @@ browser Output: @names @names: An array of students whose information has been processed, and are to -be considered in an arbitrary order. +be considered in an arbitrary order. The entries in @names are of the form +username:domain. + +The values in $cache are as follows: + + *NOTE: for the following $name implies username:domain + $name.':error' only defined if an error occured. Value + contains the error message + $name.':lastDownloadTime' unconverted time of the last update of a + student\'s course data + $name.'updateTime' coverted time of the last update of a + student\'s course data + $name.':username' username of a student + $name.':domain' domain of a student + $name.':fullname' full name of a student + $name.':id' PID of a student + $name.':Status' active/expired status of a student + $name.':section' section of a student =back @@ -576,9 +748,8 @@ sub ProcessClasslist { if($c->aborted()) { return (); } - my $studentInformation = $classlist->{$name.':studentInformation'}, - my $sectionData = $classlist->{$name.':sections'}, - my $date = $classlist->{$name}, + my $studentInformation = $classlist->{$name.':studentInformation'}; + my $date = $classlist->{$name}; my ($studentName,$studentDomain) = split(/\:/,$name); $cache->{$name.':username'}=$studentName; @@ -613,6 +784,7 @@ sub ProcessClasslist { $courseID=~s/^(\w)/\/$1/; my $sec=''; + my $sectionData = $classlist->{$name.':sections'}; foreach my $key (keys (%$sectionData)) { my $value = $sectionData->{$key}; if ($key=~/^$courseID(?:\/)*(\w+)*\_st$/) { @@ -620,7 +792,7 @@ sub ProcessClasslist { if($key eq $courseID.'_st') { $tempsection=''; } - my ($dummy,$roleend,$rolestart)=split(/\_/,$value); + my (undef,$roleend,$rolestart)=split(/\_/,$value); if($roleend eq $end && $rolestart eq $start) { $sec = $tempsection; last; @@ -693,16 +865,20 @@ sub ProcessStudentData { return; } + # This little delete thing, should not be here. Move some other + # time though. if(defined($cache->{$name.':keys'})) { foreach (split(':::', $cache->{$name.':keys'})) { delete $cache->{$name.':'.$_}; } + delete $cache->{$name.':keys'}; } my %courseKeys; # user name:domain was prepended earlier in DownloadCourseInformation foreach (keys %$courseData) { - my $currentKey =~ s/^$name//; + my $currentKey = $_; + $currentKey =~ s/^$name//; $courseKeys{$currentKey}++; $cache->{$_}=$courseData->{$_}; } @@ -764,11 +940,14 @@ sub ExtractStudentData { return; } + # This little delete thing, should not be here. Move some other + # time though. my %allkeys; if(defined($output->{$name.':keys'})) { foreach (split(':::', $output->{$name.':keys'})) { delete $output->{$name.':'.$_}; } + delete $output->{$name.':keys'}; } my ($username,$domain)=split(':',$name); @@ -786,6 +965,8 @@ sub ExtractStudentData { # Output dashes for all the parts of this problem if there # is no version information about the current problem. + $output->{$name.':'.$problemID.':NoVersion'} = 'false'; + $allkeys{$name.':'.$problemID.':NoVersion'}++; if(!$LatestVersion) { foreach my $part (split(/\:/,$data->{$sequence.':'. $problemID. @@ -799,7 +980,6 @@ sub ExtractStudentData { $totalProblems++; } $output->{$name.':'.$problemID.':NoVersion'} = 'true'; - $allkeys{$name.':'.$problemID.':NoVersion'}++; next; } @@ -1026,37 +1206,22 @@ sub ProcessFullName { my ($lastname, $generation, $firstname, $middlename)=@_; my $Str = ''; + # Strip whitespace preceeding & following name components. + $lastname =~ s/(\s+$|^\s+)//g; + $generation =~ s/(\s+$|^\s+)//g; + $firstname =~ s/(\s+$|^\s+)//g; + $middlename =~ s/(\s+$|^\s+)//g; + if($lastname ne '') { - $Str .= $lastname.' '; - if($generation ne '') { - $Str .= $generation; - } else { - chop($Str); - } - $Str .= ', '; - if($firstname ne '') { - $Str .= $firstname.' '; - } - if($middlename ne '') { - $Str .= $middlename; - } else { - chop($Str); - if($firstname eq '') { - chop($Str); - } - } + $Str .= $lastname; + $Str .= ' '.$generation if ($generation ne ''); + $Str .= ','; + $Str .= ' '.$firstname if ($firstname ne ''); + $Str .= ' '.$middlename if ($middlename ne ''); } else { - if($firstname ne '') { - $Str .= $firstname.' '; - } - if($middlename ne '') { - $Str .= $middlename.' '; - } - if($generation ne '') { - $Str .= $generation; - } else { - chop($Str); - } + $Str .= $firstname if ($firstname ne ''); + $Str .= ' '.$middlename if ($middlename ne ''); + $Str .= ' '.$generation if ($generation ne ''); } return $Str; @@ -1136,7 +1301,7 @@ sub DownloadStudentCourseData { my $WhatIWant; $WhatIWant = '(^version:|'; $WhatIWant .= '^\d+:.+?:(resource\.\d+\.'; - $WhatIWant .= '(solved|tries|previous|awarded|(\d+\.submission))\s*$'; + $WhatIWant .= '(solved|tries|previous|awarded|(\d+\.submission))\s*$';#' $WhatIWant .= '|timestamp)'; $WhatIWant .= ')'; # $WhatIWant = '.'; @@ -1159,17 +1324,19 @@ sub DownloadStudentCourseData { } my $downloadTime='Not downloaded'; + my $needUpdate = 'false'; if($checkDate eq 'true' && tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) { $downloadTime = $cache{$_.':lastDownloadTime'}; + $needUpdate = $cache{'ResourceUpdated'}; untie(%cache); } if($c->aborted()) { return 'Aborted'; } - #if($downloadTime ne 'Not downloaded') { - # next; - #} + if($needUpdate eq 'true') { + $downloadTime = 'Not downloaded'; + } my $courseData = &DownloadCourseInformation($_, $courseID, $downloadTime, $WhatIWant); @@ -1197,18 +1364,18 @@ sub DownloadStudentCourseData { sub DownloadStudentCourseDataSeparate { my ($students,$checkDate,$cacheDB,$extract,$status,$courseID,$r,$c)=@_; - my $residualFile = '/home/httpd/perl/tmp/'.$courseID.'DownloadFile.db'; + my $residualFile = $Apache::lonnet::tmpdir.$courseID.'DownloadFile.db'; my $title = 'LON-CAPA Statistics'; my $heading = 'Download Course Data'; my $WhatIWant; $WhatIWant = '(^version:|'; $WhatIWant .= '^\d+:.+?:(resource\.\d+\.'; - $WhatIWant .= '(solved|tries|previous|awarded|(\d+\.submission))\s*$'; + $WhatIWant .= '(solved|tries|previous|awarded|(\d+\.submission))\s*$';#' $WhatIWant .= '|timestamp)'; $WhatIWant .= ')'; - &CheckForResidualDownload($courseID, $cacheDB, $students, $c); + &CheckForResidualDownload($cacheDB, 'true', 'true', $courseID, $r, $c); my $studentCount = scalar(@$students); if($status eq 'true') { @@ -1229,9 +1396,11 @@ sub DownloadStudentCourseDataSeparate { my %cache; my $downloadTime='Not downloaded'; + my $needUpdate = 'false'; if($checkDate eq 'true' && tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) { $downloadTime = $cache{$_.':lastDownloadTime'}; + $needUpdate = $cache{'ResourceUpdated'}; untie(%cache); } @@ -1239,31 +1408,33 @@ sub DownloadStudentCourseDataSeparate { return 'Aborted'; } - #if($downloadTime eq 'Not downloaded') { - my $error = 0; - my $courseData = - &DownloadCourseInformation($_, $courseID, $downloadTime, - $WhatIWant); - my %downloadData; - unless(tie(%downloadData,'GDBM_File',$residualFile, - &GDBM_WRCREAT(),0640)) { - return 'Failed to tie temporary download hash.'; - } - foreach my $key (keys(%$courseData)) { - $downloadData{$key} = $courseData->{$key}; - if($key =~ /^(con_lost|error|no_such_host)/i) { - $error = 1; - last; - } + if($needUpdate eq 'true') { + $downloadTime = 'Not downloaded'; + } + + my $error = 0; + my $courseData = + &DownloadCourseInformation($_, $courseID, $downloadTime, + $WhatIWant); + my %downloadData; + unless(tie(%downloadData,'GDBM_File',$residualFile, + &GDBM_WRCREAT(),0640)) { + return 'Failed to tie temporary download hash.'; + } + foreach my $key (keys(%$courseData)) { + $downloadData{$key} = $courseData->{$key}; + if($key =~ /^(con_lost|error|no_such_host)/i) { + $error = 1; + last; } - if($error) { - foreach my $deleteKey (keys(%$courseData)) { - delete $downloadData{$deleteKey}; - } - $downloadData{$_.':error'} = 'No course data for '.$_; + } + if($error) { + foreach my $deleteKey (keys(%$courseData)) { + delete $downloadData{$deleteKey}; } - untie(%downloadData); - #} + $downloadData{$_.':error'} = 'No course data for '.$_; + } + untie(%downloadData); } if($status eq 'true') { &Apache::lonhtmlcommon::Close_PrgWin($r); } @@ -1274,7 +1445,7 @@ sub DownloadStudentCourseDataSeparate { sub CheckForResidualDownload { my ($cacheDB,$extract,$status,$courseID,$r,$c)=@_; - my $residualFile = '/home/httpd/perl/tmp/'.$courseID.'DownloadFile.db'; + my $residualFile = $Apache::lonnet::tmpdir.$courseID.'DownloadFile.db'; if(!-e $residualFile) { return 'OK'; } @@ -1338,7 +1509,253 @@ sub CheckForResidualDownload { return 'OK'; } + +################################################ +################################################ + +=pod + +=item &make_into_hash($values); + +Returns a reference to a hash as described by $values. $values is +assumed to be the result of + join(':',map {&Apache::lonnet::escape($_)} %orighash; + +This is a helper function for get_current_state. + +=cut + +################################################ +################################################ +sub make_into_hash { + my $values = shift; + my %tmp = map { &Apache::lonnet::unescape($_); } + split(':',$values); + return \%tmp; +} + + +################################################ +################################################ + +=pod + +=item &get_current_state($sname,$sdom,$symb,$courseid); + +Retrieve the current status of a students performance. $sname and +$sdom are the only required parameters. If $symb is undef the results +of an &Apache::lonnet::currentdump() will be returned. +If $courseid is undef it will be retrieved from the environment. + +The return structure is based on &Apache::lonnet::currentdump. If +$symb is unspecified, all the students data is returned in a hash of +the form: +( + symb1 => { param1 => value1, param2 => value2 ... }, + symb2 => { param1 => value1, param2 => value2 ... }, +) + +If $symb is specified, a hash of +( + param1 => value1, + param2 => value2, +) +is returned. + +If no data is found for $symb, or if the student has not performance data, +an empty list is returned. + +=cut + +################################################ +################################################ +sub get_current_state { + my ($sname,$sdom,$symb,$courseid,$forcedownload)=@_; + return () if (! defined($sname) || ! defined($sdom)); + # + $courseid = $ENV{'request.course.id'} if (! defined($courseid)); + # + my $cachefilename = $Apache::lonnet::tmpdir.$ENV{'user.name'}.'_'. + $ENV{'user.domain'}.'_'. + $courseid.'_student_data.db'; + my %cache; + # + my %student_data; # return values go here + # + my $updatetime = 0; + my $key = &Apache::lonnet::escape($sname).':'. + &Apache::lonnet::escape($sdom).':'; + # Open the cache file + if (tie(%cache,'GDBM_File',$cachefilename,&GDBM_READER(),0640)) { + if (exists($cache{$key.'time'})) { + $updatetime = $cache{$key.'time'}; +# &Apache::lonnet::logthis('got updatetime of '.$updatetime); + } + untie(%cache); + } + # timestamp/devalidation + my $modifiedtime = 1; + # Take whatever steps are neccessary at this point to give $modifiedtime a + # new value + # + if (($updatetime < $modifiedtime) || + (defined($forcedownload) && $forcedownload)) { +# &Apache::lonnet::logthis("loading data"); + # Get all the students current data + my $time_of_retrieval = time; + my @tmp = &Apache::lonnet::currentdump($courseid,$sdom,$sname); + if ((scalar(@tmp) > 0) && ($tmp[0] =~ /^error:/)) { + &Apache::lonnet::logthis('error getting data for '. + $sname.':'.$sdom.' in course '.$courseid. + ':'.$tmp[0]); + return (); + } + %student_data = @tmp; + # + # Store away the data + # + # The cache structure is colon deliminated. + # $uname:$udom:time => timestamp + # $uname:$udom:$symb => $parm1:$val1:$parm2:$val2 ... + # + # BEWARE: The colons are NOT escaped so can search with escaped + # keys instead of unescaping every key. + # + if (tie(%cache,'GDBM_File',$cachefilename,&GDBM_WRCREAT(),0640)) { +# &Apache::lonnet::logthis("writing data"); + while (my ($current_symb,$param_hash) = each(%student_data)) { + my @Parameters = %{$param_hash}; + my $value = join(':',map { &Apache::lonnet::escape($_); } + @Parameters); + # Store away the values + $cache{$key.&Apache::lonnet::escape($current_symb)}=$value; + } + $cache{$key.'time'}=$time_of_retrieval; + untie(%cache); + } + } else { + &Apache::lonnet::logthis('retrieving cached data '); + if (tie(%cache,'GDBM_File',$cachefilename,&GDBM_READER(),0640)) { + if (defined($symb)) { + my $searchkey = $key.&Apache::lonnet::escape($symb); + if (exists($cache{$searchkey})) { + $student_data{$symb} = &make_into_hash($cache{$searchkey}); + } + } else { + my $searchkey = '^'.$key.'(.*)$';#' + while (my ($testkey,$params)=each(%cache)) { + if ($testkey =~ /$searchkey/) { # \Q \E? May be necc. + my $tmpsymb = $1; + next if ($tmpsymb =~ 'time'); +# &Apache::lonnet::logthis('found '.$tmpsymb.':'); + $student_data{&Apache::lonnet::unescape($tmpsymb)} = + &make_into_hash($params); + } + } + } + untie(%cache); + } + } + if (! defined($symb)) { +# &Apache::lonnet::logthis("returning all data"); + return %student_data; + } elsif (exists($student_data{$symb})) { +# &Apache::lonnet::logthis("returning data for symb=".$symb); + return %{$student_data{$symb}}; + } else { + return (); + } +} + +################################################ +################################################ + +=pod + +=item &get_classlist(); + +Retrieve the classist of a given class or of the current class. Student +information is returned from the classlist.db file and, if needed, +from the students environment. + +Optional arguments are $cid, $cdom, and $cnum (course id, course domain, +and course number, respectively). Any omitted arguments will be taken +from the current environment ($ENV{'request.course.id'}, +$ENV{'course.'.$cid.'.domain'}, and $ENV{'course.'.$cid.'.num'}). + +Returns a reference to a hash which contains: + keys '$sname:$sdom' + values [$end,$start,$id,$section,$fullname] + +=cut + +################################################ +################################################ + +sub get_classlist { + my ($cid,$cdom,$cnum) = @_; + $cid = $cid || $ENV{'request.course.id'}; + $cdom = $cdom || $ENV{'course.'.$cid.'.domain'}; + $cnum = $cnum || $ENV{'course.'.$cid.'.num'}; + my $now = time; + # + my %classlist=&Apache::lonnet::dump('classlist',$cdom,$cnum); + while (my ($student,$info) = each(%classlist)) { + return undef if ($student =~ /^(con_lost|error|no_such_host)/i); + my ($sname,$sdom) = split(/:/,$student); + my @Values = split(/:/,$info); + my ($end,$start,$id,$section,$fullname); + if (@Values > 2) { + ($end,$start,$id,$section,$fullname) = @Values; + } else { # We have to get the data ourselves + ($end,$start) = @Values; + $section = &Apache::lonnet::getsection($sdom,$sname,$cid); + my %info=&Apache::lonnet::get('environment', + ['firstname','middlename', + 'lastname','generation','id'], + $sdom, $sname); + my ($tmp) = keys(%info); + if ($tmp =~/^(con_lost|error|no_such_host)/i) { + $fullname = 'not available'; + $id = 'not available'; + &Apache::lonnet::logthis('unable to retrieve environment '. + 'for '.$sname.':'.$sdom); + } else { + $fullname = &ProcessFullName(@info{qw/lastname generation + firstname middlename/}); + $id = $info{'id'}; + } + # Update the classlist with this students information + if ($fullname ne 'not available') { + my $enrolldata = join(':',$end,$start,$id,$section,$fullname); + my $reply=&Apache::lonnet::cput('classlist', + {$student => $enrolldata}, + $cdom,$cnum); + if ($reply !~ /^(ok|delayed)/) { + &Apache::lonnet::logthis('Unable to update classlist for '. + 'student '.$sname.':'.$sdom. + ' error:'.$reply); + } + } + } + my $status='Expired'; + if(((!$end) || $now < $end) && ((!$start) || ($now > $start))) { + $status='Active'; + } + $classlist{$student} = + [$sdom,$sname,$end,$start,$id,$section,$fullname,$status]; + } + if (wantarray()) { + return (\%classlist,['domain','username','end','start','id', + 'section','fullname','status']); + } else { + return \%classlist; + } +} + # ----- END HELPER FUNCTIONS -------------------------------------------- 1; __END__ + + 500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.