File:
[LON-CAPA] /
loncom /
interface /
Attic /
lonchart.pm
Revision
1.44:
download - view:
text,
annotated -
select for diffs
Fri Jun 28 18:06:14 2002 UTC (22 years ago) by
stredwic
Branches:
MAIN
CVS tags:
HEAD
This commit involves bugs: 522, 484, 497, and 218.
A rework of the internal layout and clean up of code has completely changed
this module internally. The output is basically the same except that there
are header for the columns. The headers are the title of the sequence or
page in which the problems reside. This relates to bug 218. The width of
the column is now determined by the max of the width of the title and the
number of problems(plus number of correct problems).
This version also displays problems that reside in the top level map. The
only problem with this currently is that the problems are displayed after
all the sequences that reside in the top sequence have been displayed. This
also applies to any sequence that contains a mixture of problems and
sequences. This relates to bugs 522 and 497. The other current problem is
that the heading is missing for the top level sequence's problem's column.
Lastly, this version contains the ability to stop the download of material
using the browser stop button. This relates to bug 484. The ties to the
hash are kept down for writing, and there is a some give for tieing to
a the cached data if another daemon is using it. This give corresponds
to a total maximum sleep time of three seconds before giving up on tieing
the hash for the current httpd daemon.
Overall, there was a lot of code movement within the module and function
renaming. Some of the algorithms like tracetable were reworked and
added too. There is now a test procedure for this module call
lonchart.test_procedure which is kept in doc/homework.
1: # The LearningOnline Network with CAPA
2: # (Publication Handler
3: #
4: # $Id: lonchart.pm,v 1.44 2002/06/28 18:06:14 stredwic Exp $
5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
28: # Homework Performance Chart
29: #
30: # (Navigate Maps Handler
31: #
32: # (Page Handler
33: #
34: # (TeX Content Handler
35: # YEAR=2000
36: # 05/29/00,05/30 Gerd Kortemeyer)
37: # 08/30,08/31,09/06,09/14,09/15,09/16,09/19,09/20,09/21,09/23,
38: # 10/02,10/10,10/14,10/16,10/18,10/19,10/31,11/6,11/14,11/16 Gerd Kortemeyer)
39: # YEAR=2001
40: # 3/1/1,6/1,17/1,29/1,30/1,31/1 Gerd Kortemeyer)
41: # 7/10/01 Behrouz Minaei
42: # 9/8 Gerd Kortemeyer
43: # 10/1, 10/19, 11/17, 11/22, 11/24, 11/28 12/18 Behrouz Minaei
44: # YEAR=2002
45: # 2/1, 2/6, 2/19, 2/28 Behrouz Minaei
46: #
47: ###
48:
49: package Apache::lonchart;
50:
51: use strict;
52: use Apache::Constants qw(:common :http);
53: use Apache::lonnet();
54: use Apache::loncommon();
55: use HTML::TokeParser;
56: use GDBM_File;
57:
58: #my $jr;
59: # ----- FORMAT PRINT DATA ----------------------------------------------
60:
61: sub FormatStudentInformation {
62: my ($cache,$name,$studentInformation,$spacePadding)=@_;
63: my $Str='<pre>';
64:
65: foreach (@$studentInformation) {
66: my $data=$cache->{$name.':'.$_};
67: $Str .= $data;
68:
69: my @dataLength=split(//,$data);
70: my $length=scalar @dataLength;
71: $Str .= (' 'x($cache->{$_.'Length'}-$length));
72: $Str .= $spacePadding;
73: }
74:
75: return $Str;
76: }
77:
78: sub FormatStudentData {
79: my ($name,$coid,$studentInformation,$spacePadding,$ChartDB)=@_;
80: my ($sname,$sdom) = split(/\:/,$name);
81: my $Str;
82: my %CacheData;
83:
84: unless(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_READER,0640)) {
85: return '';
86: }
87: # Handle Student information ------------------------------------------
88: # Handle user data
89: $Str=&FormatStudentInformation(\%CacheData, $name, $studentInformation,
90: $spacePadding);
91:
92: # Handle errors
93: if($CacheData{$name.':error'} =~ /environment/) {
94: untie(%CacheData);
95: $Str .= '</pre>';
96: return $Str;
97: # my $errorMessage = $CacheData{$name.':error'};
98: # return '<td>'.$sname.'</td><td>'.$sdom.
99: # '</td><td><font color="#000088">'.$errorMessage.'</font></td>';
100: }
101:
102: if($CacheData{$name.':error'} =~ /course/) {
103: untie(%CacheData);
104: $Str .= '</pre>';
105: return $Str;
106: # my $errorMessage = 'May have no course data or '.
107: # $CacheData{$name.':error'};
108: # return '<td>'.$sname.'</td><td>'.$sdom.
109: # '</td><td><font color="#000088">'.$errorMessage.'</font></td>';
110: }
111:
112: # Handle problem data ------------------------------------------------
113: my $Version;
114: my $problemsCorrect = 0;
115: my $totalProblems = 0;
116: my $problemsSolved = 0;
117: my $numberOfParts = 0;
118: foreach my $sequence (split(/\:/,$CacheData{'orderedSequences'})) {
119: my $characterCount=0;
120: foreach my $problemID (split(/\:/,$CacheData{$sequence.':problems'})) {
121: my $problem = $CacheData{$problemID.':problem'};
122: my $LatestVersion = $CacheData{$name.":version:$problem"};
123:
124: if(!$LatestVersion) {
125: foreach my $part (split(/\:/,$CacheData{$sequence.':'.
126: $problemID.
127: ':parts'})) {
128: $Str .= ' ';
129: $totalProblems++;
130: $characterCount++;
131: }
132: next;
133: }
134:
135: my %partData=undef;
136: #initialize data, displays skips correctly
137: foreach my $part (split(/\:/,$CacheData{$sequence.':'.
138: $problemID.
139: ':parts'})) {
140: $partData{$part.':tries'}=0;
141: $partData{$part.':code'}=' ';
142: }
143: for(my $Version=1; $Version<=$LatestVersion; $Version++) {
144: foreach my $part (split(/\:/,$CacheData{$sequence.':'.
145: $problemID.
146: ':parts'})) {
147:
148: if(!defined($CacheData{$name.":$Version:$problem".
149: ":resource.$part.solved"})) {
150: next;
151: }
152:
153: my $tries=0;
154: my $code=' ';
155:
156: $tries = $CacheData{$name.":$Version:$problem".
157: ":resource.$part.tries"};
158: $partData{$part.':tries'}=($tries) ? $tries : 0;
159:
160: my $val = $CacheData{$name.":$Version:$problem".
161: ":resource.$part.solved"};
162: if ($val eq 'correct_by_student') {$code = '*';}
163: elsif ($val eq 'correct_by_override') {$code = '+';}
164: elsif ($val eq 'incorrect_attempted') {$code = '.';}
165: elsif ($val eq 'incorrect_by_override'){$code = '-';}
166: elsif ($val eq 'excused') {$code = 'x';}
167: elsif ($val eq 'ungraded_attempted') {$code = '#';}
168: else {$code = ' ';}
169: $partData{$part.':code'}=$code;
170: }
171: }
172:
173: $Str.='<a href="/adm/grades?symb='.
174: &Apache::lonnet::escape($problem).
175: '&student='.$sname.'&domain='.$sdom.'&command=submission">';
176: foreach(split(/\:/,$CacheData{$sequence.':'.$problemID.
177: ':parts'})) {
178: if($partData{$_.':code'} eq '*') {
179: $problemsCorrect++;
180: if (($partData{$_.':tries'}<10) &&
181: ($partData{$_.':tries'} ne '')) {
182: $partData{$_.':code'}=$partData{$_.':tries'};
183: }
184: } elsif($partData{$_.':code'} eq '+') {
185: $problemsCorrect++;
186: }
187:
188: $Str .= $partData{$_.':code'};
189: $characterCount++;
190:
191: if($partData{$_.':code'} ne 'x') {
192: $totalProblems++;
193: }
194: }
195: $Str.='</a>';
196: }
197:
198: my $spacesNeeded=$CacheData{$sequence.':columnWidth'}-$characterCount;
199: $spacesNeeded -= 3;
200: $Str .= (' 'x$spacesNeeded);
201:
202: my $outputProblemsCorrect = sprintf( "%3d", $problemsCorrect );
203: $Str .= '<font color="#007700">'.$outputProblemsCorrect.'</font>';
204: $problemsSolved += $problemsCorrect;
205: $problemsCorrect=0;
206:
207: $Str .= $spacePadding;
208: }
209:
210: $Str .= '<font color="#000088">'.$problemsSolved.
211: ' / '.$totalProblems.'</font></pre>';
212:
213: untie(%CacheData);
214: return $Str;
215: }
216:
217: sub CreateTableHeadings {
218: my ($CacheData,$studentInformation,$headings,$spacePadding)=@_;
219: my $Str='<pre>';
220:
221: for(my $index=0; $index<(scalar @$headings); $index++) {
222: my $data=$$headings[$index];
223: $Str .= $data;
224:
225: my @dataLength=split(//,$data);
226: my $length=scalar @dataLength;
227: $Str .= (' 'x($CacheData->{$$studentInformation[$index].'Length'}-
228: $length));
229: $Str .= $spacePadding;
230: }
231:
232: foreach my $sequence (split(/\:/,$CacheData->{'orderedSequences'})) {
233: $Str .= $CacheData->{$sequence.':title'};
234: my @titleLength=split(//,$CacheData->{$sequence.':title'});
235: my $leftover=$CacheData->{$sequence.':columnWidth'}-
236: (scalar @titleLength);
237: $Str .= (' 'x$leftover);
238: $Str .= $spacePadding;
239: }
240:
241: $Str .= 'Total Solved/Total Problems';
242: $Str .= '</pre>';
243:
244: return $Str;
245: }
246:
247: sub CreateForm {
248: my $OpSel1='';
249: my $OpSel2='';
250: my $OpSel3='';
251: my $Status = $ENV{'form.status'};
252: if ( $Status eq 'Any' ) { $OpSel3='selected'; }
253: elsif ($Status eq 'Expired' ) { $OpSel2 = 'selected'; }
254: else { $OpSel1 = 'selected'; }
255:
256: my $Ptr = '<form name="stat" method="post" action="/adm/chart" >'."\n";
257: $Ptr .= '<b> Sort by: </b>'."\n";
258: $Ptr .= ' ';
259: $Ptr .= '<input type="submit" name="sort" value="User Name" />'."\n";
260: $Ptr .= ' ';
261: $Ptr .= '<input type="submit" name="sort" value="Last Name" />'."\n";
262: $Ptr .= ' ';
263: $Ptr .= '<input type="submit" name="sort" value="Section"/>'."\n";
264: $Ptr .= '<br><br>';
265: $Ptr .= '<b> Student Status: </b>'."\n".
266: '<select name="status">'.
267: '<option '.$OpSel1.' >Active</option>'."\n".
268: '<option '.$OpSel2.' >Expired</option>'."\n".
269: '<option '.$OpSel3.' >Any</option> </select> '."\n";
270: $Ptr .= ' ';
271: $Ptr .= '<input type="submit" name="sort" value="Recalculate Chart"/>';
272: $Ptr .= "\n";
273: $Ptr .= '</form>'."\n";
274:
275: return $Ptr;
276: }
277:
278: sub CreateLegend {
279: my $Str = '<h1>'.$ENV{'course.'.$ENV{'request.course.id'}.'.description'}.
280: '</h1><h3>'.localtime().
281: "</h3><p><pre>1..9: correct by student in 1..9 tries\n".
282: " *: correct by student in more than 9 tries\n".
283: " +: correct by override\n".
284: " -: incorrect by override\n".
285: " .: incorrect attempted\n".
286: " #: ungraded attempted\n".
287: " : not attempted\n".
288: " x: excused</pre><p>";
289: return $Str;
290: }
291:
292: sub StartDocument {
293: my $Str = '';
294: $Str .= '<html>';
295: $Str .= '<head><title>';
296: $Str .= 'LON-CAPA Assessment Chart</title></head>';
297: $Str .= '<body bgcolor="#FFFFFF">';
298: $Str .= '<script>window.focus();</script>';
299: $Str .= '<img align=right src=/adm/lonIcons/lonlogos.gif>';
300: $Str .= '<h1>Assessment Chart</h1>';
301:
302: return $Str;
303: }
304:
305: # ----- END FORMAT PRINT DATA ------------------------------------------
306:
307: # ----- DOWNLOAD INFORMATION -------------------------------------------
308:
309: sub DownloadPrerequisiteData {
310: my ($courseID, $c)=@_;
311: my ($courseDomain,$courseNumber)=split(/\_/,$courseID);
312:
313: my %classlist=&Apache::lonnet::dump('classlist',$courseDomain,
314: $courseNumber);
315: my ($checkForError)=keys (%classlist);
316: if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
317: return \%classlist;
318: }
319:
320: foreach my $name (keys(%classlist)) {
321: if($c->aborted()) {
322: $classlist{'error'}='aborted';
323: return \%classlist;
324: }
325:
326: my ($studentName,$studentDomain) = split(/\:/,$name);
327: # Download student environment data, specifically the full name and id.
328: my %studentInformation=&Apache::lonnet::get('environment',
329: ['lastname','generation',
330: 'firstname','middlename',
331: 'id'],
332: $studentDomain,
333: $studentName);
334: $classlist{$name.':studentInformation'}=\%studentInformation;
335:
336: if($c->aborted()) {
337: $classlist{'error'}='aborted';
338: return \%classlist;
339: }
340:
341: #Section
342: my %section=&Apache::lonnet::dump('roles',$studentDomain,$studentName);
343: $classlist{$name.':section'}=\%section;
344: }
345:
346: return \%classlist;
347: }
348:
349: sub DownloadStudentCourseInformation {
350: my ($name,$courseID)=@_;
351: my ($studentName,$studentDomain) = split(/\:/,$name);
352:
353: # Download student course data
354: my %courseData=&Apache::lonnet::dump($courseID,$studentDomain,
355: $studentName);
356: return \%courseData;
357: }
358:
359: # ----- END DOWNLOAD INFORMATION ---------------------------------------
360:
361: # ----- END PROCESSING FUNCTIONS ---------------------------------------
362:
363: sub ProcessTopResourceMap {
364: my ($ChartDB,$c)=@_;
365: my %hash;
366: my $fn=$ENV{'request.course.fn'};
367: if(-e "$fn.db") {
368: my $tieTries=0;
369: while($tieTries < 3) {
370: if(tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER,0640)) {
371: last;
372: }
373: $tieTries++;
374: sleep 1;
375: }
376: if($tieTries >= 3) {
377: return 'Coursemap undefined.';
378: }
379: } else {
380: return 'Can not open Coursemap.';
381: }
382:
383: my %CacheData;
384: unless(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
385: untie(%hash);
386: return 'Could not tie cache hash.';
387: }
388:
389: my (@sequences, @currentResource, @finishResource);
390: my ($currentSequence, $currentResourceID, $lastResourceID);
391:
392: $currentResourceID=$hash{'ids_/res/'.$ENV{'request.course.uri'}};
393: $lastResourceID=-1;
394: $currentSequence=-1;
395: my $topLevelSequenceNumber = $currentSequence;
396:
397: while(1) {
398: if($c->aborted()) {
399: last;
400: }
401: # HANDLE NEW SEQUENCE!
402: #if page || sequence
403: if(defined($hash{'map_pc_'.$hash{'src_'.$currentResourceID}})) {
404: push(@sequences, $currentSequence);
405: push(@currentResource, $currentResourceID);
406: push(@finishResource, $lastResourceID);
407:
408: $currentSequence=$hash{'map_pc_'.$hash{'src_'.$currentResourceID}};
409: $lastResourceID=$hash{'map_finish_'.
410: $hash{'src_'.$currentResourceID}};
411: $currentResourceID=$hash{'map_start_'.
412: $hash{'src_'.$currentResourceID}};
413:
414: if(!($currentResourceID) || !($lastResourceID)) {
415: $currentSequence=pop(@sequences);
416: $currentResourceID=pop(@currentResource);
417: $lastResourceID=pop(@finishResource);
418: if($currentSequence eq $topLevelSequenceNumber) {
419: last;
420: }
421: }
422: }
423:
424: # Handle gradable resources: exams, problems, etc
425: $currentResourceID=~/(\d+)\.(\d+)/;
426: my $partA=$1;
427: my $partB=$2;
428: if($hash{'src_'.$currentResourceID}=~
429: /\.(problem|exam|quiz|assess|survey|form)$/ &&
430: $partA eq $currentSequence) {
431: my $Problem = &Apache::lonnet::symbclean(
432: &Apache::lonnet::declutter($hash{'map_id_'.$partA}).
433: '___'.$partB.'___'.
434: &Apache::lonnet::declutter($hash{'src_'.
435: $currentResourceID}));
436:
437: $CacheData{$currentResourceID.':problem'}=$Problem;
438: if(!defined($CacheData{$currentSequence.':problems'})) {
439: $CacheData{$currentSequence.':problems'}=$currentResourceID;
440: } else {
441: $CacheData{$currentSequence.':problems'}.=
442: ':'.$currentResourceID;
443: }
444:
445: #Get Parts for problem
446: my $meta=$hash{'src_'.$currentResourceID};
447: foreach (split(/\,/,&Apache::lonnet::metadata($meta,'keys'))) {
448: if($_=~/^stores\_(\d+)\_tries$/) {
449: my $Part=&Apache::lonnet::metadata($meta,$_.'.part');
450: if(!defined($CacheData{$currentSequence.':'.
451: $currentResourceID.':parts'})) {
452: $CacheData{$currentSequence.':'.$currentResourceID.
453: ':parts'}=$Part;
454: } else {
455: $CacheData{$currentSequence.':'.$currentResourceID.
456: ':parts'}.=':'.$Part;
457: }
458: }
459: }
460: }
461:
462: #if resource == finish resource
463: if($currentResourceID eq $lastResourceID) {
464: #pop off last resource of sequence
465: $currentResourceID=pop(@currentResource);
466: #pop to get last resource in previous sequence
467: $currentResourceID=pop(@currentResource);
468: $lastResourceID=pop(@finishResource);
469:
470: if(defined($CacheData{$currentSequence.':problems'})) {
471: # Capture sequence information here
472: if(!defined($CacheData{'orderedSequences'})) {
473: $CacheData{'orderedSequences'}=$currentSequence;
474: } else {
475: $CacheData{'orderedSequences'}.=':'.$currentSequence;
476: }
477:
478: $CacheData{$currentSequence.':title'}=
479: $hash{'title_'.$currentResourceID};
480:
481: my $totalProblems=0;
482: foreach (split(/\:/,$CacheData{$currentSequence.
483: ':problems'})) {
484: foreach ($CacheData{$currentSequence.':'.$_.':parts'}) {
485: $totalProblems++;
486: }
487: }
488: my @titleLength=split(//,$CacheData{$currentSequence.
489: ':title'});
490: # $extra is 3 for problems correct and 3 for space
491: # between problems correct and problem output
492: my $extra = 6;
493: if(($totalProblems + $extra) > (scalar @titleLength)) {
494: $CacheData{$currentSequence.':columnWidth'}=
495: $totalProblems + $extra;
496: } else {
497: $CacheData{$currentSequence.':columnWidth'}=
498: (scalar @titleLength);
499: }
500: }
501:
502: $currentSequence=pop(@sequences);
503: if($currentSequence eq $topLevelSequenceNumber) {
504: last;
505: }
506: #else
507: }
508:
509: # MOVE!!!
510: #move to next resource
511: unless(defined($hash{'to_'.$currentResourceID})) {
512: # big problem, need to handle. Next is probably wrong
513: last;
514: }
515: my @nextResources=();
516: foreach (split(/\,/,$hash{'to_'.$currentResourceID})) {
517: push(@nextResources, $hash{'goesto_'.$_});
518: }
519: pop(@currentResource);
520: push(@currentResource, @nextResources);
521: # Set the next resource to be popped(processed)
522: $currentResourceID=$currentResource[-1];
523: }
524:
525: unless (untie(%hash)) {
526: &Apache::lonnet::logthis("<font color=blue>WARNING: ".
527: "Could not untie coursemap $fn (browse)".
528: ".</font>");
529: }
530:
531: unless (untie(%CacheData)) {
532: &Apache::lonnet::logthis("<font color=blue>WARNING: ".
533: "Could not untie Cache Hash (browse)".
534: ".</font>");
535: }
536:
537: return 'OK';
538: }
539:
540: sub ProcessSection {
541: my ($sectionData, $courseid,$ActiveFlag)=@_;
542: $courseid=~s/\_/\//g;
543: $courseid=~s/^(\w)/\/$1/;
544:
545: my $cursection='-1';
546: my $oldsection='-1';
547: my $status='Expired';
548: my $section='';
549: foreach my $key (keys (%$sectionData)) {
550: my $value = $sectionData->{$key};
551: if ($key=~/^$courseid(?:\/)*(\w+)*\_st$/) {
552: $section=$1;
553: if($key eq $courseid.'_st') {
554: $section='';
555: }
556: my ($dummy,$end,$start)=split(/\_/,$value);
557: my $now=time;
558: my $notactive=0;
559: if ($start) {
560: if($now<$start) {
561: $notactive=1;
562: }
563: }
564: if($end) {
565: if ($now>$end) {
566: $notactive=1;
567: }
568: }
569: if($notactive == 0) {
570: $status='Active';
571: $cursection=$section;
572: last;
573: }
574: if($notactive == 1) {
575: $oldsection=$section;
576: }
577: }
578: }
579: if($status eq $ActiveFlag) {
580: if($cursection eq '-1') {
581: return $oldsection;
582: }
583: return $cursection;
584: }
585: if($ActiveFlag eq 'Any') {
586: if($cursection eq '-1') {
587: return $oldsection;
588: }
589: return $cursection;
590: }
591: return '-1';
592: }
593:
594: sub ProcessStudentInformation {
595: my ($CacheData,$studentInformation,$section,$date,$name,$courseID,$c)=@_;
596: my ($studentName,$studentDomain) = split(/\:/,$name);
597:
598: $CacheData->{$name.':username'}=$studentName;
599: $CacheData->{$name.':domain'}=$studentDomain;
600: $CacheData->{$name.':date'}=$date;
601:
602: my ($checkForError)=keys(%$studentInformation);
603: if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
604: $CacheData->{$name.':error'}=
605: 'Could not download student environment data.';
606: $CacheData->{$name.':fullname'}='';
607: $CacheData->{$name.':id'}='';
608: } else {
609: $CacheData->{$name.':fullname'}=&ProcessFullName(
610: $studentInformation->{'lastname'},
611: $studentInformation->{'generation'},
612: $studentInformation->{'firstname'},
613: $studentInformation->{'middlename'});
614: $CacheData->{$name.':id'}=$studentInformation->{'id'};
615: }
616:
617: # Get student's section number
618: my $sec=&ProcessSection($section, $courseID, $ENV{'form.status'});
619: if($sec != -1) {
620: $CacheData->{$name.':section'}=$sec;
621: } else {
622: $CacheData->{$name.':section'}='';
623: }
624:
625: return 0;
626: }
627:
628: sub ProcessClassList {
629: my ($classlist,$courseID,$ChartDB,$c)=@_;
630: my @names=();
631:
632: my %CacheData;
633: if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
634: foreach my $name (keys(%$classlist)) {
635: if($name =~ /\:section/ || $name =~ /\:studentInformation/) {
636: next;
637: }
638: if($c->aborted()) {
639: last;
640: }
641: push(@names,$name);
642: &ProcessStudentInformation(
643: \%CacheData,
644: $classlist->{$name.':studentInformation'},
645: $classlist->{$name.':section'},
646: $classlist->{$name},
647: $name,$courseID,$c);
648: }
649:
650: $CacheData{'NamesOfStudents'}=join(":::",@names);
651: # $CacheData{'NamesOfStudents'}=&Apache::lonnet::arrayref2str(\@names);
652: untie(%CacheData);
653: }
654:
655: return @names;
656: }
657:
658: # ----- END PROCESSING FUNCTIONS ---------------------------------------
659:
660: # ----- HELPER FUNCTIONS -----------------------------------------------
661:
662: sub SpaceColumns {
663: my ($students,$studentInformation,$headings,$ChartDB)=@_;
664:
665: my %CacheData;
666: if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
667: # Initialize Lengths
668: for(my $index=0; $index<(scalar @$headings); $index++) {
669: my @titleLength=split(//,$$headings[$index]);
670: $CacheData{$$studentInformation[$index].'Length'}=
671: scalar @titleLength;
672: }
673:
674: foreach my $name (@$students) {
675: foreach (@$studentInformation) {
676: my @dataLength=split(//,$CacheData{$name.':'.$_});
677: my $length=scalar @dataLength;
678: if($length > $CacheData{$_.'Length'}) {
679: $CacheData{$_.'Length'}=$length;
680: }
681: }
682: }
683: untie(%CacheData);
684: }
685:
686: return;
687: }
688:
689: sub ProcessFullName {
690: my ($lastname, $generation, $firstname, $middlename)=@_;
691: my $Str = '';
692:
693: if($lastname ne '') {
694: $Str .= $lastname.' ';
695: if($generation ne '') {
696: $Str .= $generation;
697: } else {
698: chop($Str);
699: }
700: $Str .= ', ';
701: if($firstname ne '') {
702: $Str .= $firstname.' ';
703: }
704: if($middlename ne '') {
705: $Str .= $middlename;
706: } else {
707: chop($Str);
708: if($firstname eq '') {
709: chop($Str);
710: }
711: }
712: } else {
713: if($firstname ne '') {
714: $Str .= $firstname.' ';
715: }
716: if($middlename ne '') {
717: $Str .= $middlename.' ';
718: }
719: if($generation ne '') {
720: $Str .= $generation;
721: } else {
722: chop($Str);
723: }
724: }
725:
726: return $Str;
727: }
728:
729: sub SortStudents {
730: my ($CacheData)=@_;
731: my @students = split(/:::/,$CacheData->{'NamesOfStudents'});
732: # my @students=&Apache::lonnet::str2array($CacheData->{'NamesOfStudents'});
733:
734: my @sorted1Students=();
735: foreach (@students) {
736: my ($end,$start)=split(/\:/,$CacheData->{$_.':date'});
737: my $active=1;
738: my $now=time;
739: my $Status=$ENV{'form.status'};
740: $Status = ($Status) ? $Status : 'Active';
741: if((($end) && $now > $end) && (($Status eq 'Active'))) {
742: $active=0;
743: }
744: if(($Status eq 'Expired') && ($end == 0 || $now < $end)) {
745: $active=0;
746: }
747: if($active) {
748: push(@sorted1Students, $_);
749: }
750: }
751:
752: my $Pos = $ENV{'form.sort'};
753: my %sortData;
754: if($Pos eq 'Last Name') {
755: for(my $index=0; $index<scalar @sorted1Students; $index++) {
756: $sortData{$CacheData->{$sorted1Students[$index].':fullname'}}=
757: $sorted1Students[$index];
758: }
759: } elsif($Pos eq 'Section') {
760: for(my $index=0; $index<scalar @sorted1Students; $index++) {
761: $sortData{$CacheData->{$sorted1Students[$index].':section'}.
762: $sorted1Students[$index]}=$sorted1Students[$index];
763: }
764: } else {
765: # Sort by user name
766: for(my $index=0; $index<scalar @sorted1Students; $index++) {
767: $sortData{$sorted1Students[$index]}=$sorted1Students[$index];
768: }
769: }
770:
771: my @order = ();
772: foreach my $key (sort keys(%sortData)) {
773: push (@order,$sortData{$key});
774: }
775:
776: return @order;
777: }
778:
779: sub TestCacheData {
780: my ($ChartDB)=@_;
781: my $isCached=-1;
782: my %testData;
783: my $tieTries=0;
784:
785: if ((-e "$ChartDB") && ($ENV{'form.sort'} ne 'Recalculate Chart')) {
786: $isCached = 1;
787: } else {
788: $isCached = 0;
789: }
790:
791: while($tieTries < 3) {
792: my $result=0;
793: if($isCached) {
794: $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_READER,0640);
795: } else {
796: $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_NEWDB,0640);
797: }
798: if($result) {
799: last;
800: }
801: $tieTries++;
802: sleep 1;
803: }
804: if($tieTries >= 3) {
805: return -1;
806: }
807:
808: untie(%testData);
809:
810: return $isCached;
811: }
812:
813: sub ExtractStudentData {
814: my ($courseData, $name, $ChartDB)=@_;
815:
816: my %CacheData;
817: if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
818: my ($checkForError) = keys(%$courseData);
819: if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
820: $CacheData{$name.':error'}='Could not download course data.';
821: } else {
822: foreach my $key (keys (%$courseData)) {
823: $CacheData{$name.':'.$key}=$courseData->{$key};
824: }
825: }
826: untie(%CacheData);
827: }
828:
829: return;
830: }
831:
832: # ----- END HELPER FUNCTIONS --------------------------------------------
833:
834: sub BuildChart {
835: my ($r)=@_;
836: my $c = $r->connection;
837:
838: # Start the lonchart document
839: $r->content_type('text/html');
840: $r->send_http_header;
841: $r->print(&StartDocument());
842: $r->rflush();
843:
844: # Test for access to the CacheData
845: my $isCached=0;
846: my $cid=$ENV{'request.course.id'};
847: my $ChartDB = "/home/httpd/perl/tmp/$ENV{'user.name'}".
848: "_$ENV{'user.domain'}_$cid\_chart.db";
849:
850: $isCached=&TestCacheData($ChartDB);
851: if($isCached < 0) {
852: $r->print("Unable to tie hash to db file");
853: $r->rflush();
854: return;
855: }
856:
857: # Download class list information if not using cached data
858: my @students=();
859: my @studentInformation=('username','domain','section','id','fullname');
860: my @headings=('User Name','Domain','Section','PID','Full Name');
861: my $spacePadding=' ';
862: if(!$isCached) {
863: my $processTopResourceMapReturn=&ProcessTopResourceMap($ChartDB,$c);
864: if($processTopResourceMapReturn ne 'OK') {
865: $r->print($processTopResourceMapReturn);
866: return;
867: }
868: if($c->aborted()) { return; }
869: my $classlist=&DownloadPrerequisiteData($cid, $c);
870: my ($checkForError)=keys(%$classlist);
871: if($checkForError =~ /^(con_lost|error|no_such_host)/i ||
872: defined($classlist->{'error'})) {
873: return;
874: }
875: if($c->aborted()) { return; }
876: @students=&ProcessClassList($classlist,$cid,$ChartDB,$c);
877: if($c->aborted()) { return; }
878: &SpaceColumns(\@students,\@studentInformation,\@headings,
879: $ChartDB);
880: if($c->aborted()) { return; }
881: }
882:
883: # Sort students and print out table desciptive data
884: my %CacheData;
885: if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_READER,0640)) {
886: if(!$c->aborted()) { @students=&SortStudents(\%CacheData); }
887: if(!$c->aborted()) { $r->print(&CreateLegend()); }
888: if(!$c->aborted()) { $r->print(&CreateForm()); }
889: if(!$c->aborted()) { $r->print('<h3>'.(scalar @students).
890: ' students</h3>'); }
891: if(!$c->aborted()) { $r->rflush(); }
892: if(!$c->aborted()) { $r->print(&CreateTableHeadings(
893: \%CacheData,
894: \@studentInformation,
895: \@headings,
896: $spacePadding)); }
897: untie(%CacheData);
898: } else {
899: $r->print("Init2: Unable to tie hash to db file");
900: return;
901: }
902:
903: my @updateStudentList = ();
904: my $courseData;
905: foreach (@students) {
906: if($c->aborted()) {
907: if(!$isCached &&
908: tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
909: $CacheData{'NamesOfStudents'}=join(":::", @updateStudentList);
910: # $CacheData{'NamesOfStudents'}=
911: # &Apache::lonnet::arrayref2str(\@updateStudentList);
912: untie(%CacheData);
913: }
914: last;
915: }
916:
917: if(!$isCached) {
918: $courseData=&DownloadStudentCourseInformation($_, $cid);
919: if($c->aborted()) { next; }
920: push(@updateStudentList, $_);
921: &ExtractStudentData($courseData, $_, $ChartDB);
922: }
923: $r->print(&FormatStudentData($_, $cid, \@studentInformation,
924: $spacePadding, $ChartDB));
925: $r->rflush();
926: }
927:
928: $r->print('</body></html>');
929: $r->rflush();
930:
931: return;
932: }
933:
934: # ================================================================ Main Handler
935:
936: sub handler {
937: my $r=shift;
938: # $jr=$r;
939: unless(&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) {
940: $ENV{'user.error.msg'}=
941: $r->uri.":vgr:0:0:Cannot view grades for complete course";
942: return HTTP_NOT_ACCEPTABLE;
943: }
944:
945: # Set document type for header only
946: if ($r->header_only) {
947: if($ENV{'browser.mathml'}) {
948: $r->content_type('text/xml');
949: } else {
950: $r->content_type('text/html');
951: }
952: &Apache::loncommon::no_cache($r);
953: $r->send_http_header;
954: return OK;
955: }
956:
957: unless($ENV{'request.course.fn'}) {
958: my $requrl=$r->uri;
959: $ENV{'user.error.msg'}="$requrl:bre:0:0:Course not initialized";
960: return HTTP_NOT_ACCEPTABLE;
961: }
962:
963: &BuildChart($r);
964:
965: return OK;
966: }
967: 1;
968: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonchart.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface