Annotation of loncom/interface/lonchart.pm, revision 1.48
1.1 www 1: # The LearningOnline Network with CAPA
1.25 minaeibi 2: # (Publication Handler
3: #
1.48 ! stredwic 4: # $Id: lonchart.pm,v 1.47 2002/07/01 13:59:13 stredwic Exp $
1.25 minaeibi 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: #
1.1 www 28: # Homework Performance Chart
29: #
30: # (Navigate Maps Handler
31: #
32: # (Page Handler
33: #
34: # (TeX Content Handler
1.27 minaeibi 35: # YEAR=2000
1.1 www 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)
1.27 minaeibi 39: # YEAR=2001
1.14 minaeibi 40: # 3/1/1,6/1,17/1,29/1,30/1,31/1 Gerd Kortemeyer)
1.5 minaeibi 41: # 7/10/01 Behrouz Minaei
1.6 www 42: # 9/8 Gerd Kortemeyer
1.27 minaeibi 43: # 10/1, 10/19, 11/17, 11/22, 11/24, 11/28 12/18 Behrouz Minaei
44: # YEAR=2002
1.33 minaeibi 45: # 2/1, 2/6, 2/19, 2/28 Behrouz Minaei
1.26 minaeibi 46: #
47: ###
1.1 www 48:
49: package Apache::lonchart;
50:
51: use strict;
52: use Apache::Constants qw(:common :http);
53: use Apache::lonnet();
1.28 albertel 54: use Apache::loncommon();
1.1 www 55: use HTML::TokeParser;
56: use GDBM_File;
57:
1.46 stredwic 58: my $jr;
1.44 stredwic 59: # ----- FORMAT PRINT DATA ----------------------------------------------
1.1 www 60:
1.44 stredwic 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)=@_;
1.43 stredwic 80: my ($sname,$sdom) = split(/\:/,$name);
81: my $Str;
1.44 stredwic 82: my %CacheData;
1.43 stredwic 83:
1.44 stredwic 84: unless(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_READER,0640)) {
85: return '';
86: }
1.43 stredwic 87: # Handle Student information ------------------------------------------
1.44 stredwic 88: # Handle user data
89: $Str=&FormatStudentInformation(\%CacheData, $name, $studentInformation,
90: $spacePadding);
91:
1.43 stredwic 92: # Handle errors
1.44 stredwic 93: if($CacheData{$name.':error'} =~ /environment/) {
94: untie(%CacheData);
95: $Str .= '</pre>';
96: return $Str;
97: # my $errorMessage = $CacheData{$name.':error'};
1.43 stredwic 98: # return '<td>'.$sname.'</td><td>'.$sdom.
99: # '</td><td><font color="#000088">'.$errorMessage.'</font></td>';
1.44 stredwic 100: }
1.43 stredwic 101:
1.44 stredwic 102: if($CacheData{$name.':error'} =~ /course/) {
103: untie(%CacheData);
104: $Str .= '</pre>';
1.40 stredwic 105: return $Str;
1.43 stredwic 106: # my $errorMessage = 'May have no course data or '.
1.44 stredwic 107: # $CacheData{$name.':error'};
1.43 stredwic 108: # return '<td>'.$sname.'</td><td>'.$sdom.
109: # '</td><td><font color="#000088">'.$errorMessage.'</font></td>';
1.40 stredwic 110: }
111:
1.43 stredwic 112: # Handle problem data ------------------------------------------------
1.44 stredwic 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: }
1.11 minaeibi 209:
1.44 stredwic 210: $Str .= '<font color="#000088">'.$problemsSolved.
211: ' / '.$totalProblems.'</font></pre>';
1.39 stredwic 212:
1.44 stredwic 213: untie(%CacheData);
214: return $Str;
215: }
1.43 stredwic 216:
1.44 stredwic 217: sub CreateTableHeadings {
218: my ($CacheData,$studentInformation,$headings,$spacePadding)=@_;
219: my $Str='<pre>';
1.43 stredwic 220:
1.44 stredwic 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;
1.1 www 239: }
1.39 stredwic 240:
1.44 stredwic 241: $Str .= 'Total Solved/Total Problems';
242: $Str .= '</pre>';
1.11 minaeibi 243:
1.43 stredwic 244: return $Str;
245: }
246:
1.46 stredwic 247: sub CreateColumnSelectors {
248: my ($CacheData,$studentInformation,$headings,$spacePadding)=@_;
249: my $Str='';
250:
251: $Str .= '<form name="stat" method="post" action="/adm/chart" >'."\n";
252: $Str .= '<input type="submit" name="sort" value="Refresh Chart"/>';
253: $Str .= '</form>'."\n";
254: return $Str;
255:
256: for(my $index=0; $index<(scalar @$headings); $index++) {
257: my $data=$$headings[$index];
258: $Str .= $data;
259:
260: my @dataLength=split(//,$data);
261: my $length=scalar @dataLength;
262: $Str .= (' 'x($CacheData->{$$studentInformation[$index].'Length'}-
263: $length));
264: $Str .= $spacePadding;
265: }
266:
267: foreach my $sequence (split(/\:/,$CacheData->{'orderedSequences'})) {
268: $Str .= $CacheData->{$sequence.':title'};
269: my @titleLength=split(//,$CacheData->{$sequence.':title'});
270: my $leftover=$CacheData->{$sequence.':columnWidth'}-
271: (scalar @titleLength);
272: $Str .= (' 'x$leftover);
273: $Str .= $spacePadding;
274: }
275:
276: return $Str;
277: }
278:
1.43 stredwic 279: sub CreateForm {
280: my $OpSel1='';
281: my $OpSel2='';
282: my $OpSel3='';
283: my $Status = $ENV{'form.status'};
284: if ( $Status eq 'Any' ) { $OpSel3='selected'; }
285: elsif ($Status eq 'Expired' ) { $OpSel2 = 'selected'; }
286: else { $OpSel1 = 'selected'; }
287:
1.44 stredwic 288: my $Ptr = '<form name="stat" method="post" action="/adm/chart" >'."\n";
1.43 stredwic 289: $Ptr .= '<b> Sort by: </b>'."\n";
290: $Ptr .= ' ';
1.44 stredwic 291: $Ptr .= '<input type="submit" name="sort" value="User Name" />'."\n";
1.43 stredwic 292: $Ptr .= ' ';
1.44 stredwic 293: $Ptr .= '<input type="submit" name="sort" value="Last Name" />'."\n";
1.43 stredwic 294: $Ptr .= ' ';
1.44 stredwic 295: $Ptr .= '<input type="submit" name="sort" value="Section"/>'."\n";
1.43 stredwic 296: $Ptr .= '<br><br>';
297: $Ptr .= '<b> Student Status: </b>'."\n".
298: '<select name="status">'.
299: '<option '.$OpSel1.' >Active</option>'."\n".
300: '<option '.$OpSel2.' >Expired</option>'."\n".
301: '<option '.$OpSel3.' >Any</option> </select> '."\n";
1.45 stredwic 302: $Ptr .= '<br><br>';
303: $Ptr .= '<input type="submit" name="sort" value="Recalculate Chart"/>';
304: $Ptr .= "\n";
1.43 stredwic 305: $Ptr .= ' ';
1.45 stredwic 306: $Ptr .= '<input type="submit" name="sort" value="Refresh Chart"/>';
1.44 stredwic 307: $Ptr .= "\n";
1.43 stredwic 308: $Ptr .= '</form>'."\n";
1.44 stredwic 309:
310: return $Ptr;
311: }
312:
313: sub CreateLegend {
314: my $Str = '<h1>'.$ENV{'course.'.$ENV{'request.course.id'}.'.description'}.
315: '</h1><h3>'.localtime().
316: "</h3><p><pre>1..9: correct by student in 1..9 tries\n".
317: " *: correct by student in more than 9 tries\n".
318: " +: correct by override\n".
319: " -: incorrect by override\n".
320: " .: incorrect attempted\n".
321: " #: ungraded attempted\n".
322: " : not attempted\n".
323: " x: excused</pre><p>";
324: return $Str;
325: }
326:
327: sub StartDocument {
328: my $Str = '';
329: $Str .= '<html>';
330: $Str .= '<head><title>';
331: $Str .= 'LON-CAPA Assessment Chart</title></head>';
332: $Str .= '<body bgcolor="#FFFFFF">';
333: $Str .= '<script>window.focus();</script>';
334: $Str .= '<img align=right src=/adm/lonIcons/lonlogos.gif>';
335: $Str .= '<h1>Assessment Chart</h1>';
336:
337: return $Str;
338: }
339:
340: # ----- END FORMAT PRINT DATA ------------------------------------------
341:
342: # ----- DOWNLOAD INFORMATION -------------------------------------------
343:
344: sub DownloadPrerequisiteData {
345: my ($courseID, $c)=@_;
346: my ($courseDomain,$courseNumber)=split(/\_/,$courseID);
347:
348: my %classlist=&Apache::lonnet::dump('classlist',$courseDomain,
349: $courseNumber);
350: my ($checkForError)=keys (%classlist);
351: if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
352: return \%classlist;
353: }
354:
355: foreach my $name (keys(%classlist)) {
356: if($c->aborted()) {
357: $classlist{'error'}='aborted';
358: return \%classlist;
359: }
360:
361: my ($studentName,$studentDomain) = split(/\:/,$name);
362: # Download student environment data, specifically the full name and id.
363: my %studentInformation=&Apache::lonnet::get('environment',
364: ['lastname','generation',
365: 'firstname','middlename',
366: 'id'],
367: $studentDomain,
368: $studentName);
369: $classlist{$name.':studentInformation'}=\%studentInformation;
370:
371: if($c->aborted()) {
372: $classlist{'error'}='aborted';
373: return \%classlist;
374: }
375:
376: #Section
377: my %section=&Apache::lonnet::dump('roles',$studentDomain,$studentName);
378: $classlist{$name.':section'}=\%section;
379: }
380:
381: return \%classlist;
1.1 www 382: }
383:
1.44 stredwic 384: sub DownloadStudentCourseInformation {
385: my ($name,$courseID)=@_;
386: my ($studentName,$studentDomain) = split(/\:/,$name);
387:
388: # Download student course data
389: my %courseData=&Apache::lonnet::dump($courseID,$studentDomain,
390: $studentName);
391: return \%courseData;
392: }
393:
394: # ----- END DOWNLOAD INFORMATION ---------------------------------------
395:
396: # ----- END PROCESSING FUNCTIONS ---------------------------------------
397:
398: sub ProcessTopResourceMap {
399: my ($ChartDB,$c)=@_;
400: my %hash;
401: my $fn=$ENV{'request.course.fn'};
402: if(-e "$fn.db") {
403: my $tieTries=0;
404: while($tieTries < 3) {
405: if(tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER,0640)) {
406: last;
407: }
408: $tieTries++;
409: sleep 1;
1.43 stredwic 410: }
1.44 stredwic 411: if($tieTries >= 3) {
412: return 'Coursemap undefined.';
413: }
414: } else {
415: return 'Can not open Coursemap.';
1.43 stredwic 416: }
417:
1.44 stredwic 418: my %CacheData;
419: unless(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
420: untie(%hash);
421: return 'Could not tie cache hash.';
422: }
423:
424: my (@sequences, @currentResource, @finishResource);
425: my ($currentSequence, $currentResourceID, $lastResourceID);
426:
427: $currentResourceID=$hash{'ids_/res/'.$ENV{'request.course.uri'}};
1.46 stredwic 428: push(@currentResource, $currentResourceID);
1.44 stredwic 429: $lastResourceID=-1;
430: $currentSequence=-1;
431: my $topLevelSequenceNumber = $currentSequence;
432:
433: while(1) {
434: if($c->aborted()) {
435: last;
436: }
437: # HANDLE NEW SEQUENCE!
438: #if page || sequence
439: if(defined($hash{'map_pc_'.$hash{'src_'.$currentResourceID}})) {
440: push(@sequences, $currentSequence);
441: push(@currentResource, $currentResourceID);
442: push(@finishResource, $lastResourceID);
443:
444: $currentSequence=$hash{'map_pc_'.$hash{'src_'.$currentResourceID}};
445: $lastResourceID=$hash{'map_finish_'.
446: $hash{'src_'.$currentResourceID}};
447: $currentResourceID=$hash{'map_start_'.
448: $hash{'src_'.$currentResourceID}};
449:
450: if(!($currentResourceID) || !($lastResourceID)) {
451: $currentSequence=pop(@sequences);
452: $currentResourceID=pop(@currentResource);
453: $lastResourceID=pop(@finishResource);
454: if($currentSequence eq $topLevelSequenceNumber) {
455: last;
456: }
457: }
458: }
459:
460: # Handle gradable resources: exams, problems, etc
461: $currentResourceID=~/(\d+)\.(\d+)/;
462: my $partA=$1;
463: my $partB=$2;
464: if($hash{'src_'.$currentResourceID}=~
465: /\.(problem|exam|quiz|assess|survey|form)$/ &&
466: $partA eq $currentSequence) {
467: my $Problem = &Apache::lonnet::symbclean(
468: &Apache::lonnet::declutter($hash{'map_id_'.$partA}).
469: '___'.$partB.'___'.
470: &Apache::lonnet::declutter($hash{'src_'.
471: $currentResourceID}));
472:
473: $CacheData{$currentResourceID.':problem'}=$Problem;
474: if(!defined($CacheData{$currentSequence.':problems'})) {
475: $CacheData{$currentSequence.':problems'}=$currentResourceID;
476: } else {
477: $CacheData{$currentSequence.':problems'}.=
478: ':'.$currentResourceID;
479: }
480:
481: #Get Parts for problem
482: my $meta=$hash{'src_'.$currentResourceID};
483: foreach (split(/\,/,&Apache::lonnet::metadata($meta,'keys'))) {
484: if($_=~/^stores\_(\d+)\_tries$/) {
485: my $Part=&Apache::lonnet::metadata($meta,$_.'.part');
486: if(!defined($CacheData{$currentSequence.':'.
487: $currentResourceID.':parts'})) {
488: $CacheData{$currentSequence.':'.$currentResourceID.
489: ':parts'}=$Part;
490: } else {
491: $CacheData{$currentSequence.':'.$currentResourceID.
492: ':parts'}.=':'.$Part;
493: }
494: }
495: }
496: }
497:
498: #if resource == finish resource
499: if($currentResourceID eq $lastResourceID) {
500: #pop off last resource of sequence
501: $currentResourceID=pop(@currentResource);
502: $lastResourceID=pop(@finishResource);
503:
504: if(defined($CacheData{$currentSequence.':problems'})) {
505: # Capture sequence information here
506: if(!defined($CacheData{'orderedSequences'})) {
507: $CacheData{'orderedSequences'}=$currentSequence;
508: } else {
509: $CacheData{'orderedSequences'}.=':'.$currentSequence;
510: }
511:
512: $CacheData{$currentSequence.':title'}=
513: $hash{'title_'.$currentResourceID};
514:
515: my $totalProblems=0;
1.47 stredwic 516: foreach my $currentProblem (split(/\:/,
517: $CacheData{$currentSequence.
1.44 stredwic 518: ':problems'})) {
1.47 stredwic 519: foreach (split(/\:/,$CacheData{$currentSequence.':'.
520: $currentProblem.
521: ':parts'})) {
1.44 stredwic 522: $totalProblems++;
523: }
524: }
525: my @titleLength=split(//,$CacheData{$currentSequence.
526: ':title'});
527: # $extra is 3 for problems correct and 3 for space
528: # between problems correct and problem output
529: my $extra = 6;
530: if(($totalProblems + $extra) > (scalar @titleLength)) {
531: $CacheData{$currentSequence.':columnWidth'}=
532: $totalProblems + $extra;
533: } else {
534: $CacheData{$currentSequence.':columnWidth'}=
535: (scalar @titleLength);
536: }
537: }
538:
539: $currentSequence=pop(@sequences);
540: if($currentSequence eq $topLevelSequenceNumber) {
541: last;
542: }
543: #else
544: }
1.43 stredwic 545:
1.44 stredwic 546: # MOVE!!!
547: #move to next resource
548: unless(defined($hash{'to_'.$currentResourceID})) {
549: # big problem, need to handle. Next is probably wrong
550: last;
551: }
552: my @nextResources=();
553: foreach (split(/\,/,$hash{'to_'.$currentResourceID})) {
554: push(@nextResources, $hash{'goesto_'.$_});
555: }
556: push(@currentResource, @nextResources);
1.46 stredwic 557: # Set the next resource to be processed
558: $currentResourceID=pop(@currentResource);
1.44 stredwic 559: }
1.5 minaeibi 560:
1.44 stredwic 561: unless (untie(%hash)) {
562: &Apache::lonnet::logthis("<font color=blue>WARNING: ".
563: "Could not untie coursemap $fn (browse)".
564: ".</font>");
565: }
1.1 www 566:
1.44 stredwic 567: unless (untie(%CacheData)) {
568: &Apache::lonnet::logthis("<font color=blue>WARNING: ".
569: "Could not untie Cache Hash (browse)".
570: ".</font>");
1.1 www 571: }
1.44 stredwic 572:
573: return 'OK';
1.1 www 574: }
1.33 minaeibi 575:
1.44 stredwic 576: sub ProcessSection {
577: my ($sectionData, $courseid,$ActiveFlag)=@_;
1.33 minaeibi 578: $courseid=~s/\_/\//g;
579: $courseid=~s/^(\w)/\/$1/;
1.39 stredwic 580:
1.41 albertel 581: my $cursection='-1';
582: my $oldsection='-1';
583: my $status='Expired';
1.44 stredwic 584: my $section='';
585: foreach my $key (keys (%$sectionData)) {
586: my $value = $sectionData->{$key};
1.33 minaeibi 587: if ($key=~/^$courseid(?:\/)*(\w+)*\_st$/) {
1.44 stredwic 588: $section=$1;
589: if($key eq $courseid.'_st') {
590: $section='';
591: }
1.39 stredwic 592: my ($dummy,$end,$start)=split(/\_/,$value);
1.41 albertel 593: my $now=time;
594: my $notactive=0;
1.43 stredwic 595: if ($start) {
596: if($now<$start) {
597: $notactive=1;
598: }
599: }
600: if($end) {
601: if ($now>$end) {
602: $notactive=1;
603: }
604: }
605: if($notactive == 0) {
606: $status='Active';
607: $cursection=$section;
1.44 stredwic 608: last;
1.43 stredwic 609: }
610: if($notactive == 1) {
611: $oldsection=$section;
612: }
613: }
614: }
615: if($status eq $ActiveFlag) {
616: if($cursection eq '-1') {
617: return $oldsection;
618: }
619: return $cursection;
620: }
621: if($ActiveFlag eq 'Any') {
622: if($cursection eq '-1') {
623: return $oldsection;
624: }
625: return $cursection;
1.41 albertel 626: }
1.36 minaeibi 627: return '-1';
1.33 minaeibi 628: }
629:
1.44 stredwic 630: sub ProcessStudentInformation {
631: my ($CacheData,$studentInformation,$section,$date,$name,$courseID,$c)=@_;
632: my ($studentName,$studentDomain) = split(/\:/,$name);
633:
634: $CacheData->{$name.':username'}=$studentName;
635: $CacheData->{$name.':domain'}=$studentDomain;
636: $CacheData->{$name.':date'}=$date;
637:
638: my ($checkForError)=keys(%$studentInformation);
639: if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
640: $CacheData->{$name.':error'}=
641: 'Could not download student environment data.';
642: $CacheData->{$name.':fullname'}='';
643: $CacheData->{$name.':id'}='';
644: } else {
645: $CacheData->{$name.':fullname'}=&ProcessFullName(
646: $studentInformation->{'lastname'},
647: $studentInformation->{'generation'},
648: $studentInformation->{'firstname'},
649: $studentInformation->{'middlename'});
650: $CacheData->{$name.':id'}=$studentInformation->{'id'};
651: }
652:
653: # Get student's section number
654: my $sec=&ProcessSection($section, $courseID, $ENV{'form.status'});
655: if($sec != -1) {
656: $CacheData->{$name.':section'}=$sec;
657: } else {
658: $CacheData->{$name.':section'}='';
659: }
660:
661: return 0;
662: }
663:
664: sub ProcessClassList {
665: my ($classlist,$courseID,$ChartDB,$c)=@_;
666: my @names=();
667:
668: my %CacheData;
669: if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
670: foreach my $name (keys(%$classlist)) {
1.48 ! stredwic 671: if($name =~ /\:section/ || $name =~ /\:studentInformation/ ||
! 672: $name eq '') {
1.44 stredwic 673: next;
674: }
675: if($c->aborted()) {
676: last;
677: }
678: push(@names,$name);
679: &ProcessStudentInformation(
680: \%CacheData,
681: $classlist->{$name.':studentInformation'},
682: $classlist->{$name.':section'},
683: $classlist->{$name},
684: $name,$courseID,$c);
685: }
686:
687: untie(%CacheData);
688: }
689:
690: return @names;
691: }
692:
693: # ----- END PROCESSING FUNCTIONS ---------------------------------------
694:
695: # ----- HELPER FUNCTIONS -----------------------------------------------
696:
697: sub SpaceColumns {
698: my ($students,$studentInformation,$headings,$ChartDB)=@_;
699:
700: my %CacheData;
701: if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
702: # Initialize Lengths
703: for(my $index=0; $index<(scalar @$headings); $index++) {
704: my @titleLength=split(//,$$headings[$index]);
705: $CacheData{$$studentInformation[$index].'Length'}=
706: scalar @titleLength;
707: }
708:
709: foreach my $name (@$students) {
710: foreach (@$studentInformation) {
711: my @dataLength=split(//,$CacheData{$name.':'.$_});
712: my $length=scalar @dataLength;
713: if($length > $CacheData{$_.'Length'}) {
714: $CacheData{$_.'Length'}=$length;
715: }
716: }
717: }
718: untie(%CacheData);
719: }
720:
721: return;
722: }
723:
1.43 stredwic 724: sub ProcessFullName {
1.44 stredwic 725: my ($lastname, $generation, $firstname, $middlename)=@_;
1.43 stredwic 726: my $Str = '';
727:
1.44 stredwic 728: if($lastname ne '') {
729: $Str .= $lastname.' ';
730: if($generation ne '') {
731: $Str .= $generation;
1.43 stredwic 732: } else {
733: chop($Str);
734: }
735: $Str .= ', ';
1.44 stredwic 736: if($firstname ne '') {
737: $Str .= $firstname.' ';
1.43 stredwic 738: }
1.44 stredwic 739: if($middlename ne '') {
740: $Str .= $middlename;
1.40 stredwic 741: } else {
1.43 stredwic 742: chop($Str);
1.44 stredwic 743: if($firstname eq '') {
1.43 stredwic 744: chop($Str);
1.31 minaeibi 745: }
1.30 minaeibi 746: }
1.43 stredwic 747: } else {
1.44 stredwic 748: if($firstname ne '') {
749: $Str .= $firstname.' ';
1.43 stredwic 750: }
1.44 stredwic 751: if($middlename ne '') {
752: $Str .= $middlename.' ';
1.43 stredwic 753: }
1.44 stredwic 754: if($generation ne '') {
755: $Str .= $generation;
1.43 stredwic 756: } else {
757: chop($Str);
758: }
759: }
760:
761: return $Str;
762: }
1.30 minaeibi 763:
1.44 stredwic 764: sub SortStudents {
1.48 ! stredwic 765: my ($students,$CacheData)=@_;
1.44 stredwic 766:
767: my @sorted1Students=();
1.48 ! stredwic 768: foreach (@$students) {
1.44 stredwic 769: my ($end,$start)=split(/\:/,$CacheData->{$_.':date'});
770: my $active=1;
771: my $now=time;
772: my $Status=$ENV{'form.status'};
773: $Status = ($Status) ? $Status : 'Active';
774: if((($end) && $now > $end) && (($Status eq 'Active'))) {
775: $active=0;
776: }
777: if(($Status eq 'Expired') && ($end == 0 || $now < $end)) {
778: $active=0;
779: }
780: if($active) {
781: push(@sorted1Students, $_);
782: }
1.43 stredwic 783: }
1.1 www 784:
1.43 stredwic 785: my $Pos = $ENV{'form.sort'};
786: my %sortData;
787: if($Pos eq 'Last Name') {
1.44 stredwic 788: for(my $index=0; $index<scalar @sorted1Students; $index++) {
789: $sortData{$CacheData->{$sorted1Students[$index].':fullname'}}=
790: $sorted1Students[$index];
1.43 stredwic 791: }
792: } elsif($Pos eq 'Section') {
1.44 stredwic 793: for(my $index=0; $index<scalar @sorted1Students; $index++) {
794: $sortData{$CacheData->{$sorted1Students[$index].':section'}.
795: $sorted1Students[$index]}=$sorted1Students[$index];
1.43 stredwic 796: }
797: } else {
798: # Sort by user name
1.44 stredwic 799: for(my $index=0; $index<scalar @sorted1Students; $index++) {
800: $sortData{$sorted1Students[$index]}=$sorted1Students[$index];
1.43 stredwic 801: }
802: }
803:
804: my @order = ();
1.48 ! stredwic 805: foreach my $key (sort(keys(%sortData))) {
1.43 stredwic 806: push (@order,$sortData{$key});
807: }
1.33 minaeibi 808:
1.43 stredwic 809: return @order;
1.30 minaeibi 810: }
1.1 www 811:
1.44 stredwic 812: sub TestCacheData {
813: my ($ChartDB)=@_;
814: my $isCached=-1;
815: my %testData;
816: my $tieTries=0;
1.43 stredwic 817:
1.44 stredwic 818: if ((-e "$ChartDB") && ($ENV{'form.sort'} ne 'Recalculate Chart')) {
819: $isCached = 1;
820: } else {
821: $isCached = 0;
1.43 stredwic 822: }
823:
1.44 stredwic 824: while($tieTries < 3) {
825: my $result=0;
826: if($isCached) {
827: $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_READER,0640);
828: } else {
829: $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_NEWDB,0640);
830: }
831: if($result) {
832: last;
833: }
834: $tieTries++;
835: sleep 1;
836: }
837: if($tieTries >= 3) {
838: return -1;
1.43 stredwic 839: }
840:
1.44 stredwic 841: untie(%testData);
1.30 minaeibi 842:
1.44 stredwic 843: return $isCached;
1.43 stredwic 844: }
1.30 minaeibi 845:
1.44 stredwic 846: sub ExtractStudentData {
847: my ($courseData, $name, $ChartDB)=@_;
848:
849: my %CacheData;
850: if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
851: my ($checkForError) = keys(%$courseData);
852: if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
853: $CacheData{$name.':error'}='Could not download course data.';
854: } else {
855: foreach my $key (keys (%$courseData)) {
856: $CacheData{$name.':'.$key}=$courseData->{$key};
857: }
1.48 ! stredwic 858: if(defined($CacheData{'NamesOfStudents'})) {
! 859: $CacheData{'NamesOfStudents'}.=':::'.$name;
! 860: } else {
! 861: $CacheData{'NamesOfStudents'}=$name;
! 862: }
1.44 stredwic 863: }
864: untie(%CacheData);
1.30 minaeibi 865: }
1.1 www 866:
1.44 stredwic 867: return;
868: }
869:
870: # ----- END HELPER FUNCTIONS --------------------------------------------
871:
872: sub BuildChart {
873: my ($r)=@_;
874: my $c = $r->connection;
1.1 www 875:
1.44 stredwic 876: # Start the lonchart document
877: $r->content_type('text/html');
878: $r->send_http_header;
879: $r->print(&StartDocument());
880: $r->rflush();
1.43 stredwic 881:
1.44 stredwic 882: # Test for access to the CacheData
883: my $isCached=0;
1.43 stredwic 884: my $cid=$ENV{'request.course.id'};
885: my $ChartDB = "/home/httpd/perl/tmp/$ENV{'user.name'}".
886: "_$ENV{'user.domain'}_$cid\_chart.db";
1.44 stredwic 887:
888: $isCached=&TestCacheData($ChartDB);
889: if($isCached < 0) {
890: $r->print("Unable to tie hash to db file");
891: $r->rflush();
892: return;
893: }
894:
895: # Download class list information if not using cached data
1.48 ! stredwic 896: my %CacheData;
1.44 stredwic 897: my @students=();
898: my @studentInformation=('username','domain','section','id','fullname');
899: my @headings=('User Name','Domain','Section','PID','Full Name');
900: my $spacePadding=' ';
901: if(!$isCached) {
902: my $processTopResourceMapReturn=&ProcessTopResourceMap($ChartDB,$c);
903: if($processTopResourceMapReturn ne 'OK') {
904: $r->print($processTopResourceMapReturn);
905: return;
906: }
907: if($c->aborted()) { return; }
908: my $classlist=&DownloadPrerequisiteData($cid, $c);
909: my ($checkForError)=keys(%$classlist);
910: if($checkForError =~ /^(con_lost|error|no_such_host)/i ||
911: defined($classlist->{'error'})) {
912: return;
913: }
914: if($c->aborted()) { return; }
915: @students=&ProcessClassList($classlist,$cid,$ChartDB,$c);
916: if($c->aborted()) { return; }
917: &SpaceColumns(\@students,\@studentInformation,\@headings,
918: $ChartDB);
919: if($c->aborted()) { return; }
1.48 ! stredwic 920: } else {
! 921: if(!$c->aborted() && tie(%CacheData,'GDBM_File',$ChartDB,
! 922: &GDBM_READER,0640)) {
! 923: @students=split(/:::/,$CacheData{'NamesOfStudents'});
! 924: }
1.44 stredwic 925: }
926:
927: # Sort students and print out table desciptive data
928: if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_READER,0640)) {
1.48 ! stredwic 929: if(!$c->aborted()) { @students=&SortStudents(\@students,\%CacheData); }
1.44 stredwic 930: if(!$c->aborted()) { $r->print(&CreateLegend()); }
931: if(!$c->aborted()) { $r->print(&CreateForm()); }
932: if(!$c->aborted()) { $r->print('<h3>'.(scalar @students).
933: ' students</h3>'); }
934: if(!$c->aborted()) { $r->rflush(); }
1.46 stredwic 935: # if(!$c->aborted()) { $r->print(&CreateColumnSelectors(
936: # \%CacheData,
937: # \@studentInformation,
938: # \@headings,
939: # $spacePadding)); }
1.44 stredwic 940: if(!$c->aborted()) { $r->print(&CreateTableHeadings(
941: \%CacheData,
942: \@studentInformation,
943: \@headings,
944: $spacePadding)); }
945: untie(%CacheData);
1.43 stredwic 946: } else {
1.44 stredwic 947: $r->print("Init2: Unable to tie hash to db file");
948: return;
1.43 stredwic 949: }
950:
951: my @updateStudentList = ();
1.44 stredwic 952: my $courseData;
953: foreach (@students) {
954: if($c->aborted()) {
955: if(!$isCached &&
956: tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
957: $CacheData{'NamesOfStudents'}=join(":::", @updateStudentList);
958: # $CacheData{'NamesOfStudents'}=
959: # &Apache::lonnet::arrayref2str(\@updateStudentList);
960: untie(%CacheData);
961: }
962: last;
963: }
964:
965: if(!$isCached) {
966: $courseData=&DownloadStudentCourseInformation($_, $cid);
967: if($c->aborted()) { next; }
968: push(@updateStudentList, $_);
969: &ExtractStudentData($courseData, $_, $ChartDB);
970: }
971: $r->print(&FormatStudentData($_, $cid, \@studentInformation,
972: $spacePadding, $ChartDB));
973: $r->rflush();
1.43 stredwic 974: }
975:
1.44 stredwic 976: $r->print('</body></html>');
1.30 minaeibi 977: $r->rflush();
1.1 www 978:
1.43 stredwic 979: return;
1.30 minaeibi 980: }
1.1 www 981:
1.30 minaeibi 982: # ================================================================ Main Handler
1.1 www 983:
1.30 minaeibi 984: sub handler {
1.44 stredwic 985: my $r=shift;
1.46 stredwic 986: $jr=$r;
1.44 stredwic 987: unless(&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) {
1.30 minaeibi 988: $ENV{'user.error.msg'}=
1.1 www 989: $r->uri.":vgr:0:0:Cannot view grades for complete course";
1.30 minaeibi 990: return HTTP_NOT_ACCEPTABLE;
991: }
1.44 stredwic 992:
993: # Set document type for header only
994: if ($r->header_only) {
995: if($ENV{'browser.mathml'}) {
996: $r->content_type('text/xml');
997: } else {
998: $r->content_type('text/html');
999: }
1000: &Apache::loncommon::no_cache($r);
1001: $r->send_http_header;
1002: return OK;
1003: }
1004:
1005: unless($ENV{'request.course.fn'}) {
1006: my $requrl=$r->uri;
1007: $ENV{'user.error.msg'}="$requrl:bre:0:0:Course not initialized";
1008: return HTTP_NOT_ACCEPTABLE;
1009: }
1010:
1011: &BuildChart($r);
1012:
1013: return OK;
1.1 www 1014: }
1015: 1;
1016: __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