File:
[LON-CAPA] /
loncom /
interface /
Attic /
lonchart.pm
Revision
1.54:
download - view:
text,
annotated -
select for diffs
Wed Jul 3 14:11:14 2002 UTC (22 years ago) by
stredwic
Branches:
MAIN
CVS tags:
version_0_4,
stable_2002_july,
STABLE,
HEAD
See bug 218. I changed the alignment of the column checkboxes to left
justified. The look is consistent, whereas the center wasn't always the
same above the column. I also added a note above the data specifing how
to remove columns. Lastly, the date stamp on the top of the page is
the time of download of data. If there is no cached time stamp, the
current local time is used.
1: # The LearningOnline Network with CAPA
2: # (Publication Handler
3: #
4: # $Id: lonchart.pm,v 1.54 2002/07/03 14:11: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: =pod
50:
51: =cut
52:
53: package Apache::lonchart;
54:
55: use strict;
56: use Apache::Constants qw(:common :http);
57: use Apache::lonnet();
58: use Apache::loncommon();
59: use HTML::TokeParser;
60: use GDBM_File;
61:
62: #my $jr;
63: # ----- FORMAT PRINT DATA ----------------------------------------------
64:
65: sub FormatStudentInformation {
66: my ($cache,$name,$studentInformation,$spacePadding)=@_;
67: my $Str='';
68:
69: for(my $index=0; $index<(scalar @$studentInformation); $index++) {
70: if(!&ShouldShowColumn($cache, 'heading'.$index)) {
71: next;
72: }
73: my $data=$cache->{$name.':'.$studentInformation->[$index]};
74: $Str .= $data;
75:
76: my @dataLength=split(//,$data);
77: my $length=scalar @dataLength;
78: $Str .= (' 'x($cache->{$studentInformation->[$index].'Length'}-
79: $length));
80: $Str .= $spacePadding;
81: }
82:
83: return $Str;
84: }
85:
86: sub FormatStudentData {
87: my ($name,$coid,$studentInformation,$spacePadding,$ChartDB)=@_;
88: my ($sname,$sdom) = split(/\:/,$name);
89: my $Str;
90: my %CacheData;
91:
92: unless(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_READER,0640)) {
93: return '';
94: }
95: # Handle Student information ------------------------------------------
96: # Handle user data
97: $Str=&FormatStudentInformation(\%CacheData, $name, $studentInformation,
98: $spacePadding);
99:
100: # Handle errors
101: if($CacheData{$name.':error'} =~ /environment/) {
102: $Str .= '<br>';
103: untie(%CacheData);
104: return $Str;
105: }
106:
107: if($CacheData{$name.':error'} =~ /course/) {
108: $Str .= '<br>';
109: untie(%CacheData);
110: return $Str;
111: }
112:
113: # Handle problem data ------------------------------------------------
114: my $Version;
115: my $problemsCorrect = 0;
116: my $totalProblems = 0;
117: my $problemsSolved = 0;
118: my $numberOfParts = 0;
119: foreach my $sequence (split(/\:/,$CacheData{'orderedSequences'})) {
120: if(!&ShouldShowColumn(\%CacheData, 'sequence'.$sequence)) {
121: next;
122: }
123:
124: my $characterCount=0;
125: foreach my $problemID (split(/\:/,$CacheData{$sequence.':problems'})) {
126: my $problem = $CacheData{$problemID.':problem'};
127: my $LatestVersion = $CacheData{$name.":version:$problem"};
128:
129: if(!$LatestVersion) {
130: foreach my $part (split(/\:/,$CacheData{$sequence.':'.
131: $problemID.
132: ':parts'})) {
133: $Str .= ' ';
134: $totalProblems++;
135: $characterCount++;
136: }
137: next;
138: }
139:
140: my %partData=undef;
141: #initialize data, displays skips correctly
142: foreach my $part (split(/\:/,$CacheData{$sequence.':'.
143: $problemID.
144: ':parts'})) {
145: $partData{$part.':tries'}=0;
146: $partData{$part.':code'}=' ';
147: }
148: for(my $Version=1; $Version<=$LatestVersion; $Version++) {
149: foreach my $part (split(/\:/,$CacheData{$sequence.':'.
150: $problemID.
151: ':parts'})) {
152:
153: if(!defined($CacheData{$name.":$Version:$problem".
154: ":resource.$part.solved"})) {
155: next;
156: }
157:
158: my $tries=0;
159: my $code=' ';
160:
161: $tries = $CacheData{$name.":$Version:$problem".
162: ":resource.$part.tries"};
163: $partData{$part.':tries'}=($tries) ? $tries : 0;
164:
165: my $val = $CacheData{$name.":$Version:$problem".
166: ":resource.$part.solved"};
167: if ($val eq 'correct_by_student') {$code = '*';}
168: elsif ($val eq 'correct_by_override') {$code = '+';}
169: elsif ($val eq 'incorrect_attempted') {$code = '.';}
170: elsif ($val eq 'incorrect_by_override'){$code = '-';}
171: elsif ($val eq 'excused') {$code = 'x';}
172: elsif ($val eq 'ungraded_attempted') {$code = '#';}
173: else {$code = ' ';}
174: $partData{$part.':code'}=$code;
175: }
176: }
177:
178: $Str.='<a href="/adm/grades?symb='.
179: &Apache::lonnet::escape($problem).
180: '&student='.$sname.'&domain='.$sdom.'&command=submission">';
181: foreach(split(/\:/,$CacheData{$sequence.':'.$problemID.
182: ':parts'})) {
183: if($partData{$_.':code'} eq '*') {
184: $problemsCorrect++;
185: if (($partData{$_.':tries'}<10) &&
186: ($partData{$_.':tries'} ne '')) {
187: $partData{$_.':code'}=$partData{$_.':tries'};
188: }
189: } elsif($partData{$_.':code'} eq '+') {
190: $problemsCorrect++;
191: }
192:
193: $Str .= $partData{$_.':code'};
194: $characterCount++;
195:
196: if($partData{$_.':code'} ne 'x') {
197: $totalProblems++;
198: }
199: }
200: $Str.='</a>';
201: }
202:
203: my $spacesNeeded=$CacheData{$sequence.':columnWidth'}-$characterCount;
204: $spacesNeeded -= 3;
205: $Str .= (' 'x$spacesNeeded);
206:
207: my $outputProblemsCorrect = sprintf( "%3d", $problemsCorrect );
208: $Str .= '<font color="#007700">'.$outputProblemsCorrect.'</font>';
209: $problemsSolved += $problemsCorrect;
210: $problemsCorrect=0;
211:
212: $Str .= $spacePadding;
213: }
214:
215: my $outputProblemsSolved = sprintf( "%4d", $problemsSolved );
216: my $outputTotalProblems = sprintf( "%4d", $totalProblems );
217: $Str .= '<font color="#000088">'.$outputProblemsSolved.
218: ' / '.$outputTotalProblems.'</font><br>';
219:
220: untie(%CacheData);
221: return $Str;
222: }
223:
224: sub CreateTableHeadings {
225: my ($CacheData,$studentInformation,$headings,$spacePadding)=@_;
226: my $Str='<tr>';
227:
228: for(my $index=0; $index<(scalar @$headings); $index++) {
229: if(!&ShouldShowColumn($CacheData, 'heading'.$index)) {
230: next;
231: }
232:
233: $Str .= '<td align="left"><pre>';
234: my $data=$$headings[$index];
235: $Str .= $data;
236:
237: my @dataLength=split(//,$data);
238: my $length=scalar @dataLength;
239: $Str .= (' 'x($CacheData->{$$studentInformation[$index].'Length'}-
240: $length));
241: $Str .= $spacePadding;
242: $Str .= '</pre></td>';
243: }
244:
245: foreach my $sequence (split(/\:/,$CacheData->{'orderedSequences'})) {
246: if(!&ShouldShowColumn($CacheData, 'sequence'.$sequence)) {
247: next;
248: }
249:
250: $Str .= '<td align="left"><pre>';
251: my $name = $CacheData->{$sequence.':title'};
252: $Str .= $name;
253: my @titleLength=split(//,$CacheData->{$sequence.':title'});
254: my $leftover=$CacheData->{$sequence.':columnWidth'}-
255: (scalar @titleLength);
256: $Str .= (' 'x$leftover);
257: $Str .= $spacePadding;
258: $Str .= '</pre></td>';
259: }
260:
261: $Str .= '<td><pre>Total Solved/Total Problems</pre></td>';
262: $Str .= '</tr></tbody></table>';
263:
264: return $Str;
265: }
266:
267: sub CreateColumnSelectionBox {
268: my ($CacheData,$studentInformation,$headings,$spacePadding)=@_;
269:
270: my $missing=0;
271: my $notThere='<tr><td align="right"><b>Select column to view:</b>';
272: my $name;
273: $notThere .= '<td align="left">';
274: $notThere .= '<select name="reselect" size="4" multiple="true">'."\n";
275:
276: for(my $index=0; $index<(scalar @$headings); $index++) {
277: if(&ShouldShowColumn($CacheData, 'heading'.$index)) {
278: next;
279: }
280: $name = $headings->[$index];
281: $notThere .= '<option value="heading'.$index.'">';
282: $notThere .= $name.'</option>'."\n";
283: $missing++;
284: }
285:
286: foreach my $sequence (split(/\:/,$CacheData->{'orderedSequences'})) {
287: if(&ShouldShowColumn($CacheData, 'sequence'.$sequence)) {
288: next;
289: }
290: $name = $CacheData->{$sequence.':title'};
291: $notThere .= '<option value="sequence'.$sequence.'">';
292: $notThere .= $name.'</option>'."\n";
293: $missing++;
294: }
295:
296: if($missing) {
297: $notThere .= '</select>';
298: } else {
299: $notThere='<tr><td>';
300: }
301:
302: return $notThere.'</td></tr></tbody></table>';
303: }
304:
305: sub CreateColumnSelectors {
306: my ($CacheData,$studentInformation,$headings,$spacePadding)=@_;
307:
308: my $found=0;
309: my ($name, $length, $position);
310:
311: my $present='<pre><b>Note: Uncheck the boxes above a column to ';
312: $present .= 'remove that column from the display.</b></pre>'."\n";
313:
314: $present .= '<table border="0" cellpadding="0" cellspacing="0">';
315: $present .= '<tbody><tr>';
316: for(my $index=0; $index<(scalar @$headings); $index++) {
317: if(!&ShouldShowColumn($CacheData, 'heading'.$index)) {
318: next;
319: }
320: $present .= '<td align="left">';
321: $present .= '<input type="checkbox" checked="on" ';
322: $present .= 'name="heading'.$index.'" />';
323: $present .= '</td>';
324: $found++;
325: }
326:
327: foreach my $sequence (split(/\:/,$CacheData->{'orderedSequences'})) {
328: if(!&ShouldShowColumn($CacheData, 'sequence'.$sequence)) {
329: next;
330: }
331: $present .= '<td align="left">';
332: $present .= '<input type="checkbox" checked="on" ';
333: $present .= 'name="sequence'.$sequence.'" />';
334: $present .= '</td>';
335: $found++;
336: }
337:
338: if(!$found) {
339: $present = '';
340: }
341:
342: return $present.'<td></td></tr></form>'."\n";;
343: }
344:
345: sub CreateForm {
346: my ($CacheData)=@_;
347: my $OpSel1='';
348: my $OpSel2='';
349: my $OpSel3='';
350: my $Status = $CacheData->{'form.status'};
351: if ( $Status eq 'Any' ) { $OpSel3='selected'; }
352: elsif ($Status eq 'Expired' ) { $OpSel2 = 'selected'; }
353: else { $OpSel1 = 'selected'; }
354:
355: my $Ptr .= '<form name="stat" method="post" action="/adm/chart" >'."\n";
356: $Ptr .= '<table border="0"><tbody>';
357: $Ptr .= '<tr><td align="right">';
358: $Ptr .= '</td><td align="left">';
359: $Ptr .= '<input type="submit" name="recalculate" ';
360: $Ptr .= 'value="Recalculate Chart"/>'."\n";
361: $Ptr .= ' ';
362: $Ptr .= '<input type="submit" name="refresh" ';
363: $Ptr .= 'value="Refresh Chart"/>'."\n";
364: $Ptr .= ' ';
365: $Ptr .= '<input type="submit" name="reset" ';
366: $Ptr .= 'value="Reset Selections"/></td>'."\n";
367: $Ptr .= '</tr><tr><td align="right">';
368: $Ptr .= '<b> Sort by: </b>'."\n";
369: $Ptr .= '</td><td align="left">';
370: $Ptr .= '<input type="submit" name="sort" value="User Name" />'."\n";
371: $Ptr .= ' ';
372: $Ptr .= '<input type="submit" name="sort" value="Last Name" />'."\n";
373: $Ptr .= ' ';
374: $Ptr .= '<input type="submit" name="sort" value="Section"/>'."\n";
375: $Ptr .= '</td></tr><tr><td align="right">';
376: $Ptr .= '<b> Student Status: </b>'."\n".
377: '</td><td align="left">'.
378: '<select name="status">'.
379: '<option '.$OpSel1.' >Active</option>'."\n".
380: '<option '.$OpSel2.' >Expired</option>'."\n".
381: '<option '.$OpSel3.' >Any</option> </select> '."\n";
382: $Ptr .= '</td></tr>';
383:
384: return $Ptr;
385: }
386:
387: sub CreateLegend {
388: my $Str = "<p><pre>".
389: "1..9: correct by student in 1..9 tries\n".
390: " *: correct by student in more than 9 tries\n".
391: " +: correct by override\n".
392: " -: incorrect by override\n".
393: " .: incorrect attempted\n".
394: " #: ungraded attempted\n".
395: " : not attempted\n".
396: " x: excused".
397: "</pre><p>";
398: return $Str;
399: }
400:
401: sub StartDocument {
402: my $Str = '';
403: $Str .= '<html>';
404: $Str .= '<head><title>';
405: $Str .= 'LON-CAPA Assessment Chart</title></head>';
406: $Str .= '<body bgcolor="#FFFFFF">';
407: $Str .= '<script>window.focus();</script>';
408: $Str .= '<img align=right src=/adm/lonIcons/lonlogos.gif>';
409: $Str .= '<h1>Assessment Chart</h1>';
410: $Str .= '<h1>'.$ENV{'course.'.$ENV{'request.course.id'}.'.description'};
411: $Str .= '</h1>';
412:
413: return $Str;
414: }
415:
416: # ----- END FORMAT PRINT DATA ------------------------------------------
417:
418: # ----- DOWNLOAD INFORMATION -------------------------------------------
419:
420: sub DownloadPrerequisiteData {
421: my ($courseID, $c)=@_;
422: my ($courseDomain,$courseNumber)=split(/\_/,$courseID);
423:
424: my %classlist=&Apache::lonnet::dump('classlist',$courseDomain,
425: $courseNumber);
426: my ($checkForError)=keys (%classlist);
427: if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
428: return \%classlist;
429: }
430:
431: foreach my $name (keys(%classlist)) {
432: if($c->aborted()) {
433: $classlist{'error'}='aborted';
434: return \%classlist;
435: }
436:
437: my ($studentName,$studentDomain) = split(/\:/,$name);
438: # Download student environment data, specifically the full name and id.
439: my %studentInformation=&Apache::lonnet::get('environment',
440: ['lastname','generation',
441: 'firstname','middlename',
442: 'id'],
443: $studentDomain,
444: $studentName);
445: $classlist{$name.':studentInformation'}=\%studentInformation;
446:
447: if($c->aborted()) {
448: $classlist{'error'}='aborted';
449: return \%classlist;
450: }
451:
452: #Section
453: my %section=&Apache::lonnet::dump('roles',$studentDomain,$studentName);
454: $classlist{$name.':section'}=\%section;
455: }
456:
457: return \%classlist;
458: }
459:
460: sub DownloadStudentCourseInformation {
461: my ($name,$courseID)=@_;
462: my ($studentName,$studentDomain) = split(/\:/,$name);
463:
464: # Download student course data
465: my %courseData=&Apache::lonnet::dump($courseID,$studentDomain,
466: $studentName);
467: return \%courseData;
468: }
469:
470: # ----- END DOWNLOAD INFORMATION ---------------------------------------
471:
472: # ----- END PROCESSING FUNCTIONS ---------------------------------------
473:
474: sub ProcessTopResourceMap {
475: my ($ChartDB,$c)=@_;
476: my %hash;
477: my $fn=$ENV{'request.course.fn'};
478: if(-e "$fn.db") {
479: my $tieTries=0;
480: while($tieTries < 3) {
481: if(tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER,0640)) {
482: last;
483: }
484: $tieTries++;
485: sleep 1;
486: }
487: if($tieTries >= 3) {
488: return 'Coursemap undefined.';
489: }
490: } else {
491: return 'Can not open Coursemap.';
492: }
493:
494: my %CacheData;
495: unless(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
496: untie(%hash);
497: return 'Could not tie cache hash.';
498: }
499:
500: my (@sequences, @currentResource, @finishResource);
501: my ($currentSequence, $currentResourceID, $lastResourceID);
502:
503: $currentResourceID=$hash{'ids_/res/'.$ENV{'request.course.uri'}};
504: push(@currentResource, $currentResourceID);
505: $lastResourceID=-1;
506: $currentSequence=-1;
507: my $topLevelSequenceNumber = $currentSequence;
508:
509: while(1) {
510: if($c->aborted()) {
511: last;
512: }
513: # HANDLE NEW SEQUENCE!
514: #if page || sequence
515: if(defined($hash{'map_pc_'.$hash{'src_'.$currentResourceID}})) {
516: push(@sequences, $currentSequence);
517: push(@currentResource, $currentResourceID);
518: push(@finishResource, $lastResourceID);
519:
520: $currentSequence=$hash{'map_pc_'.$hash{'src_'.$currentResourceID}};
521:
522: # Mark sequence as containing problems. If it doesn't, then
523: # it will be removed when processing for this sequence is
524: # complete. This allows the problems in a sequence
525: # to be outputed before problems in the subsequences
526: if(!defined($CacheData{'orderedSequences'})) {
527: $CacheData{'orderedSequences'}=$currentSequence;
528: } else {
529: $CacheData{'orderedSequences'}.=':'.$currentSequence;
530: }
531:
532: $lastResourceID=$hash{'map_finish_'.
533: $hash{'src_'.$currentResourceID}};
534: $currentResourceID=$hash{'map_start_'.
535: $hash{'src_'.$currentResourceID}};
536:
537: if(!($currentResourceID) || !($lastResourceID)) {
538: $currentSequence=pop(@sequences);
539: $currentResourceID=pop(@currentResource);
540: $lastResourceID=pop(@finishResource);
541: if($currentSequence eq $topLevelSequenceNumber) {
542: last;
543: }
544: }
545: }
546:
547: # Handle gradable resources: exams, problems, etc
548: $currentResourceID=~/(\d+)\.(\d+)/;
549: my $partA=$1;
550: my $partB=$2;
551: if($hash{'src_'.$currentResourceID}=~
552: /\.(problem|exam|quiz|assess|survey|form)$/ &&
553: $partA eq $currentSequence) {
554: my $Problem = &Apache::lonnet::symbclean(
555: &Apache::lonnet::declutter($hash{'map_id_'.$partA}).
556: '___'.$partB.'___'.
557: &Apache::lonnet::declutter($hash{'src_'.
558: $currentResourceID}));
559:
560: $CacheData{$currentResourceID.':problem'}=$Problem;
561: if(!defined($CacheData{$currentSequence.':problems'})) {
562: $CacheData{$currentSequence.':problems'}=$currentResourceID;
563: } else {
564: $CacheData{$currentSequence.':problems'}.=
565: ':'.$currentResourceID;
566: }
567:
568: #Get Parts for problem
569: my $meta=$hash{'src_'.$currentResourceID};
570: foreach (split(/\,/,&Apache::lonnet::metadata($meta,'keys'))) {
571: if($_=~/^stores\_(\d+)\_tries$/) {
572: my $Part=&Apache::lonnet::metadata($meta,$_.'.part');
573: if(!defined($CacheData{$currentSequence.':'.
574: $currentResourceID.':parts'})) {
575: $CacheData{$currentSequence.':'.$currentResourceID.
576: ':parts'}=$Part;
577: } else {
578: $CacheData{$currentSequence.':'.$currentResourceID.
579: ':parts'}.=':'.$Part;
580: }
581: }
582: }
583: }
584:
585: #if resource == finish resource
586: if($currentResourceID eq $lastResourceID) {
587: #pop off last resource of sequence
588: $currentResourceID=pop(@currentResource);
589: $lastResourceID=pop(@finishResource);
590:
591: if(defined($CacheData{$currentSequence.':problems'})) {
592: # Capture sequence information here
593: $CacheData{$currentSequence.':title'}=
594: $hash{'title_'.$currentResourceID};
595:
596: my $totalProblems=0;
597: foreach my $currentProblem (split(/\:/,
598: $CacheData{$currentSequence.
599: ':problems'})) {
600: foreach (split(/\:/,$CacheData{$currentSequence.':'.
601: $currentProblem.
602: ':parts'})) {
603: $totalProblems++;
604: }
605: }
606: my @titleLength=split(//,$CacheData{$currentSequence.
607: ':title'});
608: # $extra is 3 for problems correct and 3 for space
609: # between problems correct and problem output
610: my $extra = 6;
611: if(($totalProblems + $extra) > (scalar @titleLength)) {
612: $CacheData{$currentSequence.':columnWidth'}=
613: $totalProblems + $extra;
614: } else {
615: $CacheData{$currentSequence.':columnWidth'}=
616: (scalar @titleLength);
617: }
618: } else {
619: $CacheData{'orderedSequences'}=~s/$currentSequence//;
620: $CacheData{'orderedSequences'}=~s/::/:/g;
621: $CacheData{'orderedSequences'}=~s/^:|:$//g;
622: }
623:
624: $currentSequence=pop(@sequences);
625: if($currentSequence eq $topLevelSequenceNumber) {
626: last;
627: }
628: }
629:
630: # MOVE!!!
631: #move to next resource
632: unless(defined($hash{'to_'.$currentResourceID})) {
633: # big problem, need to handle. Next is probably wrong
634: last;
635: }
636: my @nextResources=();
637: foreach (split(/\,/,$hash{'to_'.$currentResourceID})) {
638: push(@nextResources, $hash{'goesto_'.$_});
639: }
640: push(@currentResource, @nextResources);
641: # Set the next resource to be processed
642: $currentResourceID=pop(@currentResource);
643: }
644:
645: unless (untie(%hash)) {
646: &Apache::lonnet::logthis("<font color=blue>WARNING: ".
647: "Could not untie coursemap $fn (browse)".
648: ".</font>");
649: }
650:
651: unless (untie(%CacheData)) {
652: &Apache::lonnet::logthis("<font color=blue>WARNING: ".
653: "Could not untie Cache Hash (browse)".
654: ".</font>");
655: }
656:
657: return 'OK';
658: }
659:
660: sub ProcessSection {
661: my ($sectionData, $courseid,$ActiveFlag)=@_;
662: $courseid=~s/\_/\//g;
663: $courseid=~s/^(\w)/\/$1/;
664:
665: my $cursection='-1';
666: my $oldsection='-1';
667: my $status='Expired';
668: my $section='';
669: foreach my $key (keys (%$sectionData)) {
670: my $value = $sectionData->{$key};
671: if ($key=~/^$courseid(?:\/)*(\w+)*\_st$/) {
672: $section=$1;
673: if($key eq $courseid.'_st') {
674: $section='';
675: }
676: my ($dummy,$end,$start)=split(/\_/,$value);
677: my $now=time;
678: my $notactive=0;
679: if ($start) {
680: if($now<$start) {
681: $notactive=1;
682: }
683: }
684: if($end) {
685: if ($now>$end) {
686: $notactive=1;
687: }
688: }
689: if($notactive == 0) {
690: $status='Active';
691: $cursection=$section;
692: last;
693: }
694: if($notactive == 1) {
695: $oldsection=$section;
696: }
697: }
698: }
699: if($status eq $ActiveFlag) {
700: if($cursection eq '-1') {
701: return $oldsection;
702: }
703: return $cursection;
704: }
705: if($ActiveFlag eq 'Any') {
706: if($cursection eq '-1') {
707: return $oldsection;
708: }
709: return $cursection;
710: }
711: return '-1';
712: }
713:
714: sub ProcessStudentInformation {
715: my ($CacheData,$studentInformation,$section,$date,$name,$courseID,$c)=@_;
716: my ($studentName,$studentDomain) = split(/\:/,$name);
717:
718: $CacheData->{$name.':username'}=$studentName;
719: $CacheData->{$name.':domain'}=$studentDomain;
720: $CacheData->{$name.':date'}=$date;
721:
722: my ($checkForError)=keys(%$studentInformation);
723: if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
724: $CacheData->{$name.':error'}=
725: 'Could not download student environment data.';
726: $CacheData->{$name.':fullname'}='';
727: $CacheData->{$name.':id'}='';
728: } else {
729: $CacheData->{$name.':fullname'}=&ProcessFullName(
730: $studentInformation->{'lastname'},
731: $studentInformation->{'generation'},
732: $studentInformation->{'firstname'},
733: $studentInformation->{'middlename'});
734: $CacheData->{$name.':id'}=$studentInformation->{'id'};
735: }
736:
737: # Get student's section number
738: my $sec=&ProcessSection($section, $courseID, $CacheData->{'form.status'});
739: if($sec != -1) {
740: $CacheData->{$name.':section'}=$sec;
741: } else {
742: $CacheData->{$name.':section'}='';
743: }
744:
745: return 0;
746: }
747:
748: sub ProcessClassList {
749: my ($classlist,$courseID,$ChartDB,$c)=@_;
750: my @names=();
751:
752: my %CacheData;
753: if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
754: foreach my $name (keys(%$classlist)) {
755: if($name =~ /\:section/ || $name =~ /\:studentInformation/ ||
756: $name eq '') {
757: next;
758: }
759: if($c->aborted()) {
760: last;
761: }
762: push(@names,$name);
763: &ProcessStudentInformation(
764: \%CacheData,
765: $classlist->{$name.':studentInformation'},
766: $classlist->{$name.':section'},
767: $classlist->{$name},
768: $name,$courseID,$c);
769: }
770:
771: # Time of download
772: $CacheData{'time'}=localtime();
773: untie(%CacheData);
774: }
775:
776: return @names;
777: }
778:
779: # ----- END PROCESSING FUNCTIONS ---------------------------------------
780:
781: # ----- HELPER FUNCTIONS -----------------------------------------------
782:
783: sub SpaceColumns {
784: my ($students,$studentInformation,$headings,$ChartDB)=@_;
785:
786: my %CacheData;
787: if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
788: # Initialize Lengths
789: for(my $index=0; $index<(scalar @$headings); $index++) {
790: my @titleLength=split(//,$$headings[$index]);
791: $CacheData{$$studentInformation[$index].'Length'}=
792: scalar @titleLength;
793: }
794:
795: foreach my $name (@$students) {
796: foreach (@$studentInformation) {
797: my @dataLength=split(//,$CacheData{$name.':'.$_});
798: my $length=scalar @dataLength;
799: if($length > $CacheData{$_.'Length'}) {
800: $CacheData{$_.'Length'}=$length;
801: }
802: }
803: }
804: untie(%CacheData);
805: }
806:
807: return;
808: }
809:
810: sub ProcessFullName {
811: my ($lastname, $generation, $firstname, $middlename)=@_;
812: my $Str = '';
813:
814: if($lastname ne '') {
815: $Str .= $lastname.' ';
816: if($generation ne '') {
817: $Str .= $generation;
818: } else {
819: chop($Str);
820: }
821: $Str .= ', ';
822: if($firstname ne '') {
823: $Str .= $firstname.' ';
824: }
825: if($middlename ne '') {
826: $Str .= $middlename;
827: } else {
828: chop($Str);
829: if($firstname eq '') {
830: chop($Str);
831: }
832: }
833: } else {
834: if($firstname ne '') {
835: $Str .= $firstname.' ';
836: }
837: if($middlename ne '') {
838: $Str .= $middlename.' ';
839: }
840: if($generation ne '') {
841: $Str .= $generation;
842: } else {
843: chop($Str);
844: }
845: }
846:
847: return $Str;
848: }
849:
850: sub SortStudents {
851: my ($students,$CacheData)=@_;
852:
853: my @sorted1Students=();
854: foreach (@$students) {
855: my ($end,$start)=split(/\:/,$CacheData->{$_.':date'});
856: my $active=1;
857: my $now=time;
858: my $Status=$CacheData->{'form.status'};
859: $Status = ($Status) ? $Status : 'Active';
860: if((($end) && $now > $end) && (($Status eq 'Active'))) {
861: $active=0;
862: }
863: if(($Status eq 'Expired') && ($end == 0 || $now < $end)) {
864: $active=0;
865: }
866: if($active) {
867: push(@sorted1Students, $_);
868: }
869: }
870:
871: my $Pos = $CacheData->{'form.sort'};
872: my %sortData;
873: if($Pos eq 'Last Name') {
874: for(my $index=0; $index<scalar @sorted1Students; $index++) {
875: $sortData{$CacheData->{$sorted1Students[$index].':fullname'}}=
876: $sorted1Students[$index];
877: }
878: } elsif($Pos eq 'Section') {
879: for(my $index=0; $index<scalar @sorted1Students; $index++) {
880: $sortData{$CacheData->{$sorted1Students[$index].':section'}.
881: $sorted1Students[$index]}=$sorted1Students[$index];
882: }
883: } else {
884: # Sort by user name
885: for(my $index=0; $index<scalar @sorted1Students; $index++) {
886: $sortData{$sorted1Students[$index]}=$sorted1Students[$index];
887: }
888: }
889:
890: my @order = ();
891: foreach my $key (sort(keys(%sortData))) {
892: push (@order,$sortData{$key});
893: }
894:
895: return @order;
896: }
897:
898: sub TestCacheData {
899: my ($ChartDB)=@_;
900: my $isCached=-1;
901: my %testData;
902: my $tieTries=0;
903:
904: if ((-e "$ChartDB") && (!defined($ENV{'form.recalculate'}))) {
905: $isCached = 1;
906: } else {
907: $isCached = 0;
908: }
909:
910: while($tieTries < 10) {
911: my $result=0;
912: if($isCached) {
913: $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_READER,0640);
914: } else {
915: $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_NEWDB,0640);
916: }
917: if($result) {
918: last;
919: }
920: $tieTries++;
921: sleep 1;
922: }
923: if($tieTries >= 10) {
924: return -1;
925: }
926:
927: untie(%testData);
928:
929: return $isCached;
930: }
931:
932: sub ExtractStudentData {
933: my ($courseData, $name, $ChartDB)=@_;
934:
935: my %CacheData;
936: if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
937: my ($checkForError) = keys(%$courseData);
938: if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
939: $CacheData{$name.':error'}='Could not download course data.';
940: } else {
941: foreach my $key (keys (%$courseData)) {
942: $CacheData{$name.':'.$key}=$courseData->{$key};
943: }
944: if(defined($CacheData{'NamesOfStudents'})) {
945: $CacheData{'NamesOfStudents'}.=':::'.$name;
946: } else {
947: $CacheData{'NamesOfStudents'}=$name;
948: }
949: }
950: untie(%CacheData);
951: }
952:
953: return;
954: }
955:
956: sub ShouldShowColumn {
957: my ($cache,$test)=@_;
958:
959: if($cache->{'form.reset'} eq 'true') {
960: return 1;
961: }
962:
963: my $headings=$cache->{'form.headings'};
964: my $sequences=$cache->{'form.sequences'};
965: if($headings eq 'ALLHEADINGS' || $sequences eq 'ALLSEQUENCES' ||
966: $headings=~/$test/ || $sequences=~/$test/) {
967: return 1;
968: }
969:
970: # my $reselected=$cache->{'form.reselect'};
971: # if($reselected=~/$test/) {
972: # return 1;
973: # }
974:
975: return 0;
976: }
977:
978: sub ProcessFormData {
979: my ($ChartDB)=@_;
980: my %CacheData;
981:
982: if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
983: if(defined($ENV{'form.sort'})) {
984: $CacheData{'form.sort'}=$ENV{'form.sort'};
985: } elsif(!defined($CacheData{'form.sort'})) {
986: $CacheData{'form.sort'}='username';
987: }
988:
989: # Ignore $ENV{'form.refresh'}
990: # Ignore $ENV{'form.recalculate'}
991:
992: if(defined($ENV{'form.status'})) {
993: $CacheData{'form.status'}=$ENV{'form.status'};
994: } elsif(!defined($CacheData{'form.status'})) {
995: $CacheData{'form.status'}='Active';
996: }
997:
998: my @headings=();
999: my @sequences=();
1000: my $found=0;
1001: foreach (keys(%ENV)) {
1002: if(/form\.heading/) {
1003: $found++;
1004: push(@headings, $_);
1005: } elsif(/form\.sequence/) {
1006: $found++;
1007: push(@sequences, $_);
1008: } elsif(/form\./) {
1009: $found++;
1010: }
1011: }
1012:
1013: if($found) {
1014: $CacheData{'form.headings'}=join(":::",@headings);
1015: $CacheData{'form.sequences'}=join(":::",@sequences);
1016: }
1017:
1018: if(defined($ENV{'form.reselect'})) {
1019: my @reselected = (ref($ENV{'form.reselect'}) ?
1020: @{$ENV{'form.reselect'}}
1021: : ($ENV{'form.reselect'}));
1022: foreach (@reselected) {
1023: if(/heading/) {
1024: $CacheData{'form.headings'}.=":::".$_;
1025: } elsif(/sequence/) {
1026: $CacheData{'form.sequences'}.=":::".$_;
1027: }
1028: }
1029: }
1030:
1031: if(defined($ENV{'form.reset'})) {
1032: $CacheData{'form.reset'}='true';
1033: $CacheData{'form.status'}='Active';
1034: $CacheData{'form.sort'}='username';
1035: $CacheData{'form.headings'}='ALLHEADINGS';
1036: $CacheData{'form.sequences'}='ALLSEQUENCES';
1037: } else {
1038: $CacheData{'form.reset'}='false';
1039: }
1040:
1041: untie(%CacheData);
1042: }
1043:
1044: return;
1045: }
1046:
1047: # ----- END HELPER FUNCTIONS --------------------------------------------
1048:
1049: sub BuildChart {
1050: my ($r)=@_;
1051: my $c = $r->connection;
1052:
1053: # Start the lonchart document
1054: $r->content_type('text/html');
1055: $r->send_http_header;
1056: $r->print(&StartDocument());
1057: $r->rflush();
1058:
1059: # Test for access to the CacheData
1060: my $isCached=0;
1061: my $cid=$ENV{'request.course.id'};
1062: my $ChartDB = "/home/httpd/perl/tmp/$ENV{'user.name'}".
1063: "_$ENV{'user.domain'}_$cid\_chart.db";
1064:
1065: $isCached=&TestCacheData($ChartDB);
1066: if($isCached < 0) {
1067: $r->print("Unable to tie hash to db file");
1068: $r->rflush();
1069: return;
1070: }
1071: &ProcessFormData($ChartDB);
1072:
1073: # Download class list information if not using cached data
1074: my %CacheData;
1075: my @students=();
1076: my @studentInformation=('username','domain','section','id','fullname');
1077: my @headings=('User Name','Domain','Section','PID','Full Name');
1078: my $spacePadding=' ';
1079: if(!$isCached) {
1080: my $processTopResourceMapReturn=&ProcessTopResourceMap($ChartDB,$c);
1081: if($processTopResourceMapReturn ne 'OK') {
1082: $r->print($processTopResourceMapReturn);
1083: return;
1084: }
1085: if($c->aborted()) { return; }
1086: my $classlist=&DownloadPrerequisiteData($cid, $c);
1087: my ($checkForError)=keys(%$classlist);
1088: if($checkForError =~ /^(con_lost|error|no_such_host)/i ||
1089: defined($classlist->{'error'})) {
1090: return;
1091: }
1092: if($c->aborted()) { return; }
1093: @students=&ProcessClassList($classlist,$cid,$ChartDB,$c);
1094: if($c->aborted()) { return; }
1095: &SpaceColumns(\@students,\@studentInformation,\@headings,
1096: $ChartDB);
1097: if($c->aborted()) { return; }
1098: } else {
1099: if(!$c->aborted() && tie(%CacheData,'GDBM_File',$ChartDB,
1100: &GDBM_READER,0640)) {
1101: @students=split(/:::/,$CacheData{'NamesOfStudents'});
1102: }
1103: }
1104:
1105: # Sort students and print out table desciptive data
1106: if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_READER,0640)) {
1107: if(!$c->aborted()) { @students=&SortStudents(\@students,\%CacheData); }
1108: my $downloadTime=0;
1109: if(defined($CacheData{'time'})) { $downloadTime=$CacheData{'time'}; }
1110: else { $downloadTime=localtime(); }
1111: if(!$c->aborted()) { $r->print('<h3>'.$downloadTime.'</h3>'); }
1112: if(!$c->aborted()) { $r->print('<h1>'.(scalar @students).
1113: ' students</h1>'); }
1114: if(!$c->aborted()) { $r->rflush(); }
1115: if(!$c->aborted()) { $r->print(&CreateLegend()); }
1116: if(!$c->aborted()) { $r->print(&CreateForm(\%CacheData)); }
1117: if(!$c->aborted()) { $r->print(&CreateColumnSelectionBox(
1118: \%CacheData,
1119: \@studentInformation,
1120: \@headings,
1121: $spacePadding)); }
1122: if(!$c->aborted()) { $r->print(&CreateColumnSelectors(
1123: \%CacheData,
1124: \@studentInformation,
1125: \@headings,
1126: $spacePadding)); }
1127: if(!$c->aborted()) { $r->print(&CreateTableHeadings(
1128: \%CacheData,
1129: \@studentInformation,
1130: \@headings,
1131: $spacePadding)); }
1132: if(!$c->aborted()) { $r->rflush(); }
1133: untie(%CacheData);
1134: } else {
1135: $r->print("Init2: Unable to tie hash to db file");
1136: return;
1137: }
1138:
1139: my @updateStudentList = ();
1140: my $courseData;
1141: $r->print('<pre>');
1142: foreach (@students) {
1143: if($c->aborted()) {
1144: last;
1145: }
1146:
1147: if(!$isCached) {
1148: $courseData=&DownloadStudentCourseInformation($_, $cid);
1149: if($c->aborted()) { last; }
1150: push(@updateStudentList, $_);
1151: &ExtractStudentData($courseData, $_, $ChartDB);
1152: }
1153: $r->print(&FormatStudentData($_, $cid, \@studentInformation,
1154: $spacePadding, $ChartDB));
1155: $r->rflush();
1156: }
1157:
1158: if(!$isCached && tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
1159: $CacheData{'NamesOfStudents'}=join(":::", @updateStudentList);
1160: # $CacheData{'NamesOfStudents'}=
1161: # &Apache::lonnet::arrayref2str(\@updateStudentList);
1162: untie(%CacheData);
1163: }
1164:
1165: $r->print('</pre></body></html>');
1166: $r->rflush();
1167:
1168: return;
1169: }
1170:
1171: # ================================================================ Main Handler
1172:
1173: sub handler {
1174: my $r=shift;
1175: # $jr=$r;
1176: unless(&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) {
1177: $ENV{'user.error.msg'}=
1178: $r->uri.":vgr:0:0:Cannot view grades for complete course";
1179: return HTTP_NOT_ACCEPTABLE;
1180: }
1181:
1182: # Set document type for header only
1183: if ($r->header_only) {
1184: if($ENV{'browser.mathml'}) {
1185: $r->content_type('text/xml');
1186: } else {
1187: $r->content_type('text/html');
1188: }
1189: &Apache::loncommon::no_cache($r);
1190: $r->send_http_header;
1191: return OK;
1192: }
1193:
1194: unless($ENV{'request.course.fn'}) {
1195: my $requrl=$r->uri;
1196: $ENV{'user.error.msg'}="$requrl:bre:0:0:Course not initialized";
1197: return HTTP_NOT_ACCEPTABLE;
1198: }
1199:
1200: &BuildChart($r);
1201:
1202: return OK;
1203: }
1204: 1;
1205: __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