loncom/interface/loncoursedata.pm - diff

Return to loncoursedata.pm CVS log

Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/loncoursedata.pm between versions 1.27 and 1.40

version 1.27, 2002/08/31 18:31:15	version 1.40, 2002/12/11 21:41:02
Line 139 sub DownloadClasslist {	Line 139 sub DownloadClasslist {
%classlist=&Apache::lonnet::dump('classlist',$courseDomain, $courseNumber);	%classlist=&Apache::lonnet::dump('classlist',$courseDomain, $courseNumber);
foreach(keys (%classlist)) {	foreach(keys (%classlist)) {
if(/^(con_lost\|error\|no_such_host)/i) {	if(/^(con_lost\|error\|no_such_host)/i) {
return \%classlist;	return;
}	}
}	}

Line 309 sub ProcessTopResourceMap {	Line 309 sub ProcessTopResourceMap {
return 'Can not open Coursemap.';	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.	# Initialize state machine. Set information pointing to top level map.
my (@sequences, @currentResource, @finishResource);	my (@sequences, @currentResource, @finishResource);
my ($currentSequence, $currentResourceID, $lastResourceID);	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);	push(@currentResource, $currentResourceID);
$lastResourceID=-1;	$lastResourceID=-1;
$currentSequence=-1;	$currentSequence=-1;
my $topLevelSequenceNumber = $currentSequence;	my $topLevelSequenceNumber = $currentSequence;

my %sequenceRecord;	my %sequenceRecord;
	my %allkeys;
while(1) {	while(1) {
if($c->aborted()) {	if($c->aborted()) {
last;	last;
Line 344 sub ProcessTopResourceMap {	Line 356 sub ProcessTopResourceMap {
} else {	} else {
$cache->{'orderedSequences'}.=':'.$currentSequence;	$cache->{'orderedSequences'}.=':'.$currentSequence;
}	}
	$allkeys{'orderedSequences'}++;

$lastResourceID=$hash{'map_finish_'.	$lastResourceID=$hash{'map_finish_'.
$hash{'src_'.$currentResourceID}};	$hash{'src_'.$currentResourceID}};
Line 378 sub ProcessTopResourceMap {	Line 391 sub ProcessTopResourceMap {
$currentResourceID}));	$currentResourceID}));

$cache->{$currentResourceID.':problem'}=$Problem;	$cache->{$currentResourceID.':problem'}=$Problem;
	$allkeys{$currentResourceID.':problem'}++;
if(!defined($cache->{$currentSequence.':problems'})) {	if(!defined($cache->{$currentSequence.':problems'})) {
$cache->{$currentSequence.':problems'}=$currentResourceID;	$cache->{$currentSequence.':problems'}=$currentResourceID;
} else {	} else {
$cache->{$currentSequence.':problems'}.=	$cache->{$currentSequence.':problems'}.=
':'.$currentResourceID;	':'.$currentResourceID;
}	}
	$allkeys{$currentSequence.':problems'}++;

my $meta=$hash{'src_'.$currentResourceID};	my $meta=$hash{'src_'.$currentResourceID};
# $cache->{$currentResourceID.':title'}=	# $cache->{$currentResourceID.':title'}=
# &Apache::lonnet::metdata($meta,'title');	# &Apache::lonnet::metdata($meta,'title');
$cache->{$currentResourceID.':title'}=	$cache->{$currentResourceID.':title'}=
$hash{'title_'.$currentResourceID};	$hash{'title_'.$currentResourceID};
	$allkeys{$currentResourceID.':title'}++;
$cache->{$currentResourceID.':source'}=	$cache->{$currentResourceID.':source'}=
$hash{'src_'.$currentResourceID};	$hash{'src_'.$currentResourceID};
	$allkeys{$currentResourceID.':source'}++;

# Get Parts for problem	# Get Parts for problem
my %beenHere;	my %beenHere;
Line 408 sub ProcessTopResourceMap {	Line 425 sub ProcessTopResourceMap {
$cache->{$currentSequence.':'.$currentResourceID.	$cache->{$currentSequence.':'.$currentResourceID.
':parts'}.=':'.$partId;	':parts'}.=':'.$partId;
}	}
	$allkeys{$currentSequence.':'.$currentResourceID.
	':parts'}++;
}	}
if($beenHere{'r:'.$partId.':'.$responseId} == 0) {	if($beenHere{'r:'.$partId.':'.$responseId} == 0) {
$beenHere{'r:'.$partId.':'.$responseId}++;	$beenHere{'r:'.$partId.':'.$responseId}++;
Line 421 sub ProcessTopResourceMap {	Line 440 sub ProcessTopResourceMap {
':'.$partId.':responseIDs'}.=':'.	':'.$partId.':responseIDs'}.=':'.
$responseId;	$responseId;
}	}
	$allkeys{$currentSequence.':'.$currentResourceID.':'.
	$partId.':responseIDs'}++;
}	}
if(/^optionresponse/ &&	if(/^optionresponse/ &&
$beenHere{'o:'.$partId.':'.$currentResourceID} == 0) {	$beenHere{'o:'.$partId.':'.$currentResourceID} == 0) {
Line 434 sub ProcessTopResourceMap {	Line 455 sub ProcessTopResourceMap {
$currentResourceID.':'.	$currentResourceID.':'.
$partId.':'.$responseId;	$partId.':'.$responseId;
}	}
	$allkeys{'OptionResponses'}++;
}	}
}	}
}	}
Line 449 sub ProcessTopResourceMap {	Line 471 sub ProcessTopResourceMap {
# Capture sequence information here	# Capture sequence information here
$cache->{$currentSequence.':title'}=	$cache->{$currentSequence.':title'}=
$hash{'title_'.$currentResourceID};	$hash{'title_'.$currentResourceID};
	$allkeys{$currentSequence.':title'}++;
$cache->{$currentSequence.':source'}=	$cache->{$currentSequence.':source'}=
$hash{'src_'.$currentResourceID};	$hash{'src_'.$currentResourceID};
	$allkeys{$currentSequence.':source'}++;

my $totalProblems=0;	my $totalProblems=0;
foreach my $currentProblem (split(/\:/,	foreach my $currentProblem (split(/\:/,
Line 464 sub ProcessTopResourceMap {	Line 488 sub ProcessTopResourceMap {
}	}
my @titleLength=split(//,$cache->{$currentSequence.	my @titleLength=split(//,$cache->{$currentSequence.
':title'});	':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	# between problems correct and problem output
my $extra = 6;	my $extra = 8;
if(($totalProblems + $extra) > (scalar @titleLength)) {	if(($totalProblems + $extra) > (scalar @titleLength)) {
$cache->{$currentSequence.':columnWidth'}=	$cache->{$currentSequence.':columnWidth'}=
$totalProblems + $extra;	$totalProblems + $extra;
Line 474 sub ProcessTopResourceMap {	Line 498 sub ProcessTopResourceMap {
$cache->{$currentSequence.':columnWidth'}=	$cache->{$currentSequence.':columnWidth'}=
(scalar @titleLength);	(scalar @titleLength);
}	}
	$allkeys{$currentSequence.':columnWidth'}++;
} else {	} else {
# Remove sequence from list, if it contains no problems to	# Remove sequence from list, if it contains no problems to
# display.	# display.
Line 510 sub ProcessTopResourceMap {	Line 535 sub ProcessTopResourceMap {
$currentResourceID=pop(@currentResource);	$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)) {	unless (untie(%hash)) {
&Apache::lonnet::logthis("<font color=blue>WARNING: ".	&Apache::lonnet::logthis("<font color=blue>WARNING: ".
"Could not untie coursemap $fn (browse)".	"Could not untie coursemap $fn (browse)".
Line 553 browser	Line 587 browser
Output: @names	Output: @names

@names: An array of students whose information has been processed, and are to	@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	=back

Line 576 sub ProcessClasslist {	Line 627 sub ProcessClasslist {
if($c->aborted()) {	if($c->aborted()) {
return ();	return ();
}	}
my $studentInformation = $classlist->{$name.':studentInformation'},	my $studentInformation = $classlist->{$name.':studentInformation'};
my $sectionData = $classlist->{$name.':sections'},	my $date = $classlist->{$name};
my $date = $classlist->{$name},
my ($studentName,$studentDomain) = split(/\:/,$name);	my ($studentName,$studentDomain) = split(/\:/,$name);

$cache->{$name.':username'}=$studentName;	$cache->{$name.':username'}=$studentName;
Line 613 sub ProcessClasslist {	Line 663 sub ProcessClasslist {
$courseID=~s/^(\w)/\/$1/;	$courseID=~s/^(\w)/\/$1/;

my $sec='';	my $sec='';
	my $sectionData = $classlist->{$name.':sections'};
foreach my $key (keys (%$sectionData)) {	foreach my $key (keys (%$sectionData)) {
my $value = $sectionData->{$key};	my $value = $sectionData->{$key};
if ($key=~/^$courseID(?:\/)(\w+)\_st$/) {	if ($key=~/^$courseID(?:\/)(\w+)\_st$/) {
Line 620 sub ProcessClasslist {	Line 671 sub ProcessClasslist {
if($key eq $courseID.'_st') {	if($key eq $courseID.'_st') {
$tempsection='';	$tempsection='';
}	}
my ($dummy,$roleend,$rolestart)=split(/\_/,$value);	my (undef,$roleend,$rolestart)=split(/\_/,$value);
if($roleend eq $end && $rolestart eq $start) {	if($roleend eq $end && $rolestart eq $start) {
$sec = $tempsection;	$sec = $tempsection;
last;	last;
Line 693 sub ProcessStudentData {	Line 744 sub ProcessStudentData {
return;	return;
}	}

	# This little delete thing, should not be here. Move some other
	# time though.
if(defined($cache->{$name.':keys'})) {	if(defined($cache->{$name.':keys'})) {
foreach (split(':::', $cache->{$name.':keys'})) {	foreach (split(':::', $cache->{$name.':keys'})) {
delete $cache->{$name.':'.$_};	delete $cache->{$name.':'.$_};
}	}
	delete $cache->{$name.':keys'};
}	}

my %courseKeys;	my %courseKeys;
# user name:domain was prepended earlier in DownloadCourseInformation	# user name:domain was prepended earlier in DownloadCourseInformation
foreach (keys %$courseData) {	foreach (keys %$courseData) {
my $currentKey =~ s/^$name//;	my $currentKey = $_;
	$currentKey =~ s/^$name//;
$courseKeys{$currentKey}++;	$courseKeys{$currentKey}++;
$cache->{$_}=$courseData->{$_};	$cache->{$_}=$courseData->{$_};
}	}
Line 764 sub ExtractStudentData {	Line 819 sub ExtractStudentData {
return;	return;
}	}

	# This little delete thing, should not be here. Move some other
	# time though.
my %allkeys;	my %allkeys;
if(defined($output->{$name.':keys'})) {	if(defined($output->{$name.':keys'})) {
foreach (split(':::', $output->{$name.':keys'})) {	foreach (split(':::', $output->{$name.':keys'})) {
delete $output->{$name.':'.$_};	delete $output->{$name.':'.$_};
}	}
	delete $output->{$name.':keys'};
}	}

my ($username,$domain)=split(':',$name);	my ($username,$domain)=split(':',$name);
Line 1027 sub ProcessFullName {	Line 1085 sub ProcessFullName {
my ($lastname, $generation, $firstname, $middlename)=@_;	my ($lastname, $generation, $firstname, $middlename)=@_;
my $Str = '';	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 '') {	if($lastname ne '') {
$Str .= $lastname.' ';	$Str .= $lastname;
if($generation ne '') {	$Str .= ' '.$generation if ($generation ne '');
$Str .= $generation;	$Str .= ',';
} else {	$Str .= ' '.$firstname if ($firstname ne '');
chop($Str);	$Str .= ' '.$middlename if ($middlename ne '');
}
$Str .= ', ';
if($firstname ne '') {
$Str .= $firstname.' ';
}
if($middlename ne '') {
$Str .= $middlename;
} else {
chop($Str);
if($firstname eq '') {
chop($Str);
}
}
} else {	} else {
if($firstname ne '') {	$Str .= $firstname if ($firstname ne '');
$Str .= $firstname.' ';	$Str .= ' '.$middlename if ($middlename ne '');
}	$Str .= ' '.$generation if ($generation ne '');
if($middlename ne '') {
$Str .= $middlename.' ';
}
if($generation ne '') {
$Str .= $generation;
} else {
chop($Str);
}
}	}

return $Str;	return $Str;
Line 1160 sub DownloadStudentCourseData {	Line 1203 sub DownloadStudentCourseData {
}	}

my $downloadTime='Not downloaded';	my $downloadTime='Not downloaded';
	my $needUpdate = 'false';
if($checkDate eq 'true' &&	if($checkDate eq 'true' &&
tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {	tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
$downloadTime = $cache{$_.':lastDownloadTime'};	$downloadTime = $cache{$_.':lastDownloadTime'};
	$needUpdate = $cache{'ResourceUpdated'};
untie(%cache);	untie(%cache);
}	}

if($c->aborted()) { return 'Aborted'; }	if($c->aborted()) { return 'Aborted'; }

#if($downloadTime ne 'Not downloaded') {	if($needUpdate eq 'true') {
# next;	$downloadTime = 'Not downloaded';
#}	}
my $courseData =	my $courseData =
&DownloadCourseInformation($_, $courseID, $downloadTime,	&DownloadCourseInformation($_, $courseID, $downloadTime,
$WhatIWant);	$WhatIWant);
Line 1209 sub DownloadStudentCourseDataSeparate {	Line 1254 sub DownloadStudentCourseDataSeparate {
$WhatIWant .= '\|timestamp)';	$WhatIWant .= '\|timestamp)';
$WhatIWant .= ')';	$WhatIWant .= ')';

&CheckForResidualDownload($courseID, $cacheDB, $students, $c);	&CheckForResidualDownload($cacheDB, 'true', 'true', $courseID, $r, $c);

my $studentCount = scalar(@$students);	my $studentCount = scalar(@$students);
if($status eq 'true') {	if($status eq 'true') {
Line 1230 sub DownloadStudentCourseDataSeparate {	Line 1275 sub DownloadStudentCourseDataSeparate {

my %cache;	my %cache;
my $downloadTime='Not downloaded';	my $downloadTime='Not downloaded';
	my $needUpdate = 'false';
if($checkDate eq 'true' &&	if($checkDate eq 'true' &&
tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {	tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
$downloadTime = $cache{$_.':lastDownloadTime'};	$downloadTime = $cache{$_.':lastDownloadTime'};
	$needUpdate = $cache{'ResourceUpdated'};
untie(%cache);	untie(%cache);
}	}

Line 1240 sub DownloadStudentCourseDataSeparate {	Line 1287 sub DownloadStudentCourseDataSeparate {
return 'Aborted';	return 'Aborted';
}	}

#if($downloadTime eq 'Not downloaded') {	if($needUpdate eq 'true') {
my $error = 0;	$downloadTime = 'Not downloaded';
my $courseData =	}
&DownloadCourseInformation($_, $courseID, $downloadTime,
$WhatIWant);	my $error = 0;
my %downloadData;	my $courseData =
unless(tie(%downloadData,'GDBM_File',$residualFile,	&DownloadCourseInformation($_, $courseID, $downloadTime,
&GDBM_WRCREAT(),0640)) {	$WhatIWant);
return 'Failed to tie temporary download hash.';	my %downloadData;
}	unless(tie(%downloadData,'GDBM_File',$residualFile,
foreach my $key (keys(%$courseData)) {	&GDBM_WRCREAT(),0640)) {
$downloadData{$key} = $courseData->{$key};	return 'Failed to tie temporary download hash.';
if($key =~ /^(con_lost\|error\|no_such_host)/i) {	}
$error = 1;	foreach my $key (keys(%$courseData)) {
last;	$downloadData{$key} = $courseData->{$key};
}	if($key =~ /^(con_lost\|error\|no_such_host)/i) {
	$error = 1;
	last;
}	}
if($error) {	}
foreach my $deleteKey (keys(%$courseData)) {	if($error) {
delete $downloadData{$deleteKey};	foreach my $deleteKey (keys(%$courseData)) {
}	delete $downloadData{$deleteKey};
$downloadData{$_.':error'} = 'No course data for '.$_;
}	}
untie(%downloadData);	$downloadData{$_.':error'} = 'No course data for '.$_;
#}	}
	untie(%downloadData);
}	}
if($status eq 'true') { &Apache::lonhtmlcommon::Close_PrgWin($r); }	if($status eq 'true') { &Apache::lonhtmlcommon::Close_PrgWin($r); }

Line 1339 sub CheckForResidualDownload {	Line 1388 sub CheckForResidualDownload {
return 'OK';	return 'OK';
}	}

	################################################
	################################################

	=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 --------------------------------------------	# ----- END HELPER FUNCTIONS --------------------------------------------

1;	1;
__END__	__END__

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

Removed from v.1.27
changed lines
	Added in v.1.40