loncom/interface/statistics/lonstathelpers.pm - view

File: [LON-CAPA] / loncom / interface / statistics / lonstathelpers.pm
Revision 1.50: download - view: text, annotated - select for diffs
Tue Apr 19 13:59:35 2005 UTC (19 years, 2 months ago) by matthew
Branches: MAIN
CVS tags: version_2_0_X, version_2_0_2, version_2_0_1, version_2_0_0, version_1_99_3, version_1_99_2, version_1_99_1_tmcc, version_1_99_1, version_1_99_0, HEAD

Bug 2989: Need more submit buttons on problem selection pages.  Problem
analysis and submission time analysis now have submit buttons after each
sequence/folder.

1: # The LearningOnline Network with CAPA 2: # 3: # $Id: lonstathelpers.pm,v 1.50 2005/04/19 13:59:35 matthew Exp $ 4: # 5: # Copyright Michigan State University Board of Trustees 6: # 7: # This file is part of the LearningOnline Network with CAPA (LON-CAPA). 8: # 9: # LON-CAPA is free software; you can redistribute it and/or modify 10: # it under the terms of the GNU General Public License as published by 11: # the Free Software Foundation; either version 2 of the License, or 12: # (at your option) any later version. 13: # 14: # LON-CAPA is distributed in the hope that it will be useful, 15: # but WITHOUT ANY WARRANTY; without even the implied warranty of 16: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17: # GNU General Public License for more details. 18: # 19: # You should have received a copy of the GNU General Public License 20: # along with LON-CAPA; if not, write to the Free Software 21: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 22: # 23: # /home/httpd/html/adm/gpl.txt 24: # 25: # http://www.lon-capa.org/ 26: # 27: #################################################### 28: #################################################### 29: 30: =pod 31: 32: =head1 NAME 33: 34: Apache::lonstathelpers - helper routines used by statistics 35: 36: =head1 SYNOPSIS 37: 38: This module provides a place to consolidate much of the statistics 39: routines that are needed across multiple statistics functions. 40: 41: =head1 OVERVIEW 42: 43: =over 4 44: 45: =cut 46: 47: #################################################### 48: #################################################### 49: package Apache::lonstathelpers; 50: 51: use strict; 52: use Apache::lonnet; 53: use Apache::loncommon(); 54: use Apache::lonhtmlcommon(); 55: use Apache::loncoursedata(); 56: use Apache::lonstatistics; 57: use Apache::lonlocal; 58: use HTML::Entities(); 59: use Time::Local(); 60: use Spreadsheet::WriteExcel(); 61: use GDBM_File; 62: use Storable qw(freeze thaw); 63: 64: #################################################### 65: #################################################### 66: 67: =pod 68: 69: =item &render_resource($resource) 70: 71: Input: a navmaps resource 72: 73: Retunrs: a scalar containing html for a rendering of the problem 74: within a table. 75: 76: =cut 77: 78: #################################################### 79: #################################################### 80: sub render_resource { 81: my ($resource) = @_; 82: ## 83: ## Render the problem 84: my ($base) = ($resource->src =~ m|^(.*/)[^/]*$|); 85: $base="http://".$ENV{'SERVER_NAME'}.$base; 86: my ($src,$symb)=($resource->src,&Apache::lonnet::escape($resource->symb)); 87: my $rendered_problem = &Apache::lonnet::ssi_body($src.'?symb='.$symb); 88: $rendered_problem =~ s/<\s*form\s*/<nop /g; 89: $rendered_problem =~ s|(<\s*/form\s*>)|<\/nop>|g; 90: return '<table bgcolor="ffffff"><tr><td>'. 91: '<base href="'.$base.'" />'. 92: $rendered_problem. 93: '</td></tr></table>'; 94: } 95: 96: #################################################### 97: #################################################### 98: 99: =pod 100: 101: =item &get_resources 102: 103: =cut 104: 105: #################################################### 106: #################################################### 107: sub get_resources { 108: my ($navmap,$sequence) = @_; 109: my @resources = $navmap->retrieveResources($sequence, 110: sub { shift->is_problem(); }, 111: 0,0,0); 112: return @resources; 113: } 114: 115: #################################################### 116: #################################################### 117: 118: =pod 119: 120: =item &problem_selector($AcceptedResponseTypes) 121: 122: Input: scalar containing regular expression which matches response 123: types to show. '.' will yield all, '(option|radiobutton)' will match 124: all option response and radiobutton problems. 125: 126: Returns: A string containing html for a table which lists the sequences 127: and their contents. A radiobutton is provided for each problem. 128: Skips 'survey' problems. 129: 130: =cut 131: 132: #################################################### 133: #################################################### 134: sub problem_selector { 135: my ($AcceptedResponseTypes,$sequence_addendum) = @_; 136: my $Str; 137: $Str = "\n<table>\n"; 138: my $rb_count =0; 139: my ($navmap,@sequences) = 140: &Apache::lonstatistics::selected_sequences_with_assessments('all'); 141: return $navmap if (! ref($navmap)); # error 142: foreach my $seq (@sequences) { 143: my $seq_str = ''; 144: foreach my $res (&get_resources($navmap,$seq)) { 145: foreach my $part (@{$res->parts}) { 146: my @response_ids = $res->responseIds($part); 147: my @response_types = $res->responseType($part); 148: for (my $i=0;$i<scalar(@response_types);$i++){ 149: my $respid = $response_ids[$i]; 150: my $resptype = $response_types[$i]; 151: if ($resptype =~ m/$AcceptedResponseTypes/) { 152: my $value = &make_target_id({symb=>$res->symb, 153: part=>$part, 154: respid=>$respid, 155: resptype=>$resptype}); 156: my $checked = ''; 157: if ($env{'form.problemchoice'} eq $value) { 158: $checked = 'checked '; 159: } 160: my $title = $res->compTitle; 161: if (! defined($title) || $title eq '') { 162: ($title) = ($res->src =~ m:/([^/]*)$:); 163: } 164: $seq_str .= '<tr>'. 165: qq{<td><input type="radio" id="$rb_count" name="problemchoice" value="$value" $checked /></td>}. 166: '<td><label for="'.$rb_count.'">'.$resptype.'</label></td>'. 167: '<td><label for="'.$rb_count.'">'.$title.'</label>'; 168: if (scalar(@response_ids) > 1) { 169: $seq_str .= &mt('response').' '.$respid; 170: } 171: my $link = $res->src.'?symb='. 172: &Apache::lonnet::escape($res->symb); 173: $seq_str .= (' 'x2). 174: qq{<a target="preview" href="$link">view</a>}; 175: $seq_str .= "</td></tr>\n"; 176: $rb_count++; 177: } 178: } 179: } 180: } 181: if ($seq_str ne '') { 182: $Str .= '<tr><td>&nbsp</td>'. 183: '<td colspan="2"><b>'.$seq->compTitle.'</b></td>'. 184: "</tr>\n".$seq_str; 185: if (defined($sequence_addendum)) { 186: $Str .= '<tr>'. 187: ('<td>&nbsp</td>'x2). 188: '<td align="right">'.$sequence_addendum.'</td>'. 189: "</tr>\n"; 190: } 191: } 192: } 193: $Str .= "</table>\n"; 194: return $Str; 195: } 196: 197: #################################################### 198: #################################################### 199: 200: =pod 201: 202: =item &MultipleProblemSelector($navmap,$selected,$inputname) 203: 204: Generate HTML with checkboxes for problem selection. 205: 206: Input: 207: 208: $navmap: a navmap object. If undef, navmaps will be called to create a 209: new object. 210: 211: $selected: Scalar, Array, or hash reference of currently selected items. 212: 213: $inputname: The name of the form elements to use for the checkboxs. 214: 215: Returns: A string containing html for a table which lists the sequences 216: and their contents. A checkbox is provided for each problem. 217: 218: =cut 219: 220: #################################################### 221: #################################################### 222: sub MultipleProblemSelector { 223: my ($navmap,$inputname,$formname)=@_; 224: my $cid = $env{'request.course.id'}; 225: my $Str; 226: # Massage the input as needed. 227: if (! defined($navmap)) { 228: $navmap = Apache::lonnavmaps::navmap->new(); 229: if (! defined($navmap)) { 230: $Str .= 231: '<h1>'.&mt('Error: cannot process course structure').'</h1>'; 232: return $Str; 233: } 234: } 235: my $selected = {map { ($_,1) } (&get_selected_symbs($inputname))}; 236: # Header 237: $Str .= <<"END"; 238: <script language="JavaScript" type="text/javascript"> 239: function checkall(value,seqid) { 240: for (i=0; i<document.forms.$formname.elements.length; i++) { 241: ele = document.forms.$formname.elements[i]; 242: if (ele.name == '$inputname') { 243: if (seqid != null) { 244: itemid = document.forms.$formname.elements[i].id; 245: thing = itemid.split(':'); 246: if (thing[0] == seqid) { 247: document.forms.$formname.elements[i].checked=value; 248: } 249: } else { 250: document.forms.$formname.elements[i].checked=value; 251: } 252: } 253: } 254: } 255: </script> 256: END 257: $Str .= 258: '<a href="javascript:checkall(true)">'.&mt('Select All').'</a>'. 259: (' 'x4). 260: '<a href="javascript:checkall(false)">'.&mt('Unselect All').'</a>'; 261: $Str .= $/.'<table>'.$/; 262: my $iterator = $navmap->getIterator(undef, undef, undef, 1); 263: my $sequence_string; 264: my $seq_id = 0; 265: my @Accumulator = (&new_accumulator($env{'course.'.$cid.'.description'}, 266: '', 267: '', 268: $seq_id++, 269: $inputname)); 270: my @Sequence_Data; 271: while (my $curRes = $iterator->next()) { 272: if ($curRes == $iterator->END_MAP) { 273: if (ref($Accumulator[-1]) eq 'CODE') { 274: my $old_accumulator = pop(@Accumulator); 275: push(@Sequence_Data,&{$old_accumulator}()); 276: } 277: } elsif ($curRes == $iterator->BEGIN_MAP) { 278: # Not much to do here. 279: } 280: next if (! ref($curRes)); 281: if ($curRes->is_map) { 282: push(@Accumulator,&new_accumulator($curRes->compTitle, 283: $curRes->src, 284: $curRes->symb, 285: $seq_id++, 286: $inputname)); 287: } elsif ($curRes->is_problem) { 288: if (@Accumulator && $Accumulator[-1] ne '') { 289: &{$Accumulator[-1]}($curRes, 290: exists($selected->{$curRes->symb})); 291: } 292: } 293: } 294: my $course_seq = pop(@Sequence_Data); 295: foreach my $seq ($course_seq,@Sequence_Data) { 296: #my $seq = pop(@Sequence_Data); 297: next if (! defined($seq) || ref($seq) ne 'HASH'); 298: $Str.= '<tr><td colspan="2">'. 299: '<b>'.$seq->{'title'}.'</b>'.(' 'x2). 300: '<a href="javascript:checkall(true,'.$seq->{'id'}.')">'. 301: &mt('Select').'</a>'.(' 'x2). 302: '<a href="javascript:checkall(false,'.$seq->{'id'}.')">'. 303: &mt('Unselect').'</a>'.(' 'x2). 304: '</td></tr>'.$/; 305: $Str.= $seq->{'html'}; 306: } 307: $Str .= '</table>'.$/; 308: return $Str; 309: } 310: 311: sub new_accumulator { 312: my ($title,$src,$symb,$seq_id,$inputname) = @_; 313: my $target; 314: my $item_id=0; 315: return 316: sub { 317: if (@_) { 318: my ($res,$checked) = @_; 319: $target.='<tr><td><label>'. 320: '<input type="checkbox" name="'.$inputname.'" '; 321: if ($checked) { 322: $target .= 'checked '; 323: } 324: $target .= 'id="'.$seq_id.':'.$item_id++.'" '; 325: $target.= 326: 'value="'.&Apache::lonnet::escape($res->symb).'" />'. 327: ' '.$res->compTitle.'</label>'. 328: (' 'x2).'<a target="preview" '. 329: 'href="'.$res->src.'?symb='. 330: &Apache::lonnet::escape($res->symb).'">view</a>'. 331: '</td></tr>'.$/; 332: } else { 333: if (defined($target)) { 334: return { title => $title, 335: symb => $symb, 336: src => $src, 337: id => $seq_id, 338: html => $target, }; 339: } 340: return undef; 341: } 342: }; 343: } 344: 345: sub get_selected_symbs { 346: my ($inputfield) = @_; 347: my $field = 'form.'.$inputfield; 348: my @symbs = (map { 349: &Apache::lonnet::unescape($_); 350: } &Apache::loncommon::get_env_multiple($field)); 351: return @symbs; 352: } 353: 354: #################################################### 355: #################################################### 356: 357: =pod 358: 359: =item &make_target_id($target) 360: 361: Inputs: Hash ref with the following entries: 362: $target->{'symb'}, $target->{'part'}, $target->{'respid'}, 363: $target->{'resptype'}. 364: 365: Returns: A string, suitable for a form parameter, which uniquely identifies 366: the problem, part, and response to do statistical analysis on. 367: 368: Used by Apache::lonstathelpers::ProblemSelector(). 369: 370: =cut 371: 372: #################################################### 373: #################################################### 374: sub make_target_id { 375: my ($target) = @_; 376: my $id = &Apache::lonnet::escape($target->{'symb'}).':'. 377: &Apache::lonnet::escape($target->{'part'}).':'. 378: &Apache::lonnet::escape($target->{'respid'}).':'. 379: &Apache::lonnet::escape($target->{'resptype'}); 380: return $id; 381: } 382: 383: #################################################### 384: #################################################### 385: 386: =pod 387: 388: =item &get_target_from_id($id) 389: 390: Inputs: $id, a scalar string from Apache::lonstathelpers::make_target_id(). 391: 392: Returns: A hash reference, $target, containing the following keys: 393: $target->{'symb'}, $target->{'part'}, $target->{'respid'}, 394: $target->{'resptype'}. 395: 396: =cut 397: 398: #################################################### 399: #################################################### 400: sub get_target_from_id { 401: my ($id) = @_; 402: if (! ref($id)) { 403: my ($symb,$part,$respid,$resptype) = split(':',$id); 404: return ({ symb => &Apache::lonnet::unescape($symb), 405: part => &Apache::lonnet::unescape($part), 406: respid => &Apache::lonnet::unescape($respid), 407: resptype => &Apache::lonnet::unescape($resptype)}); 408: } elsif (ref($id) eq 'ARRAY') { 409: my @Return; 410: foreach my $selected (@$id) { 411: my ($symb,$part,$respid,$resptype) = split(':',$selected); 412: push(@Return,{ symb => &Apache::lonnet::unescape($symb), 413: part => &Apache::lonnet::unescape($part), 414: respid => &Apache::lonnet::unescape($respid), 415: resptype => &Apache::lonnet::unescape($resptype)}); 416: } 417: return \@Return; 418: } 419: } 420: 421: #################################################### 422: #################################################### 423: 424: =pod 425: 426: =item &get_prev_curr_next($target,$AcceptableResponseTypes,$granularity) 427: 428: Determine the problem parts or responses preceeding and following the 429: current resource. 430: 431: Inputs: $target (see &Apache::lonstathelpers::get_target_from_id()) 432: $AcceptableResponseTypes, regular expression matching acceptable 433: response types, 434: $granularity, either 'part', 'response', or 'part_survey' 435: 436: Returns: three hash references, $prev, $curr, $next, which refer to the 437: preceeding, current, or following problem parts or responses, depending 438: on the value of $granularity. Values of undef indicate there is no 439: previous or next part/response. A value of undef for all three indicates 440: there was no match found to the current part/resource. 441: 442: The hash references contain the following keys: 443: symb, part, resource 444: 445: If $granularity eq 'response', the following ADDITIONAL keys will be present: 446: respid, resptype 447: 448: =cut 449: 450: #################################################### 451: #################################################### 452: sub get_prev_curr_next { 453: my ($target,$AcceptableResponseTypes,$granularity) = @_; 454: # 455: # Build an array with the data we need to search through 456: my @Resource; 457: my ($navmap,@sequences) = 458: &Apache::lonstatistics::selected_sequences_with_assessments('all'); 459: return $navmap if (! ref($navmap)); 460: foreach my $seq (@sequences) { 461: my @resources = &get_resources($navmap,$seq); 462: foreach my $res (@resources) { 463: foreach my $part (@{$res->parts}) { 464: if ($res->is_survey($part) && ($granularity eq 'part_survey')){ 465: push (@Resource, 466: { symb => $res->symb, 467: part => $part, 468: resource => $res, 469: } ); 470: } elsif ($granularity eq 'part') { 471: push (@Resource, 472: { symb => $res->symb, 473: part => $part, 474: resource => $res, 475: } ); 476: } elsif ($granularity eq 'response') { 477: my @response_ids = $res->responseIds($part); 478: my @response_types = $res->responseType($part); 479: for (my $i=0; 480: $i<scalar(@response_ids); 481: $i++){ 482: my $respid = $response_ids[$i]; 483: my $resptype = $response_types[$i]; 484: next if ($resptype !~ m/$AcceptableResponseTypes/); 485: push (@Resource, 486: { symb => $res->symb, 487: part => $part, 488: respid => $respid, 489: resptype => $resptype, 490: resource => $res, 491: } ); 492: } 493: } 494: } 495: } 496: } 497: # 498: # Get the index of the current situation 499: my $curr_idx; 500: for ($curr_idx=0;$curr_idx<$#Resource;$curr_idx++) { 501: my $curr_item = $Resource[$curr_idx]; 502: if ($granularity eq 'part' || $granularity eq 'part_survey') { 503: if ($curr_item->{'symb'} eq $target->{'symb'} && 504: $curr_item->{'part'} eq $target->{'part'}) { 505: last; 506: } 507: } elsif ($granularity eq 'response') { 508: if ($curr_item->{'symb'} eq $target->{'symb'} && 509: $curr_item->{'part'} eq $target->{'part'} && 510: $curr_item->{'respid'} eq $target->{'respid'} && 511: $curr_item->{'resptype'} eq $target->{'resptype'}) { 512: last; 513: } 514: } 515: } 516: my $curr_item = $Resource[$curr_idx]; 517: if ($granularity eq 'part' || $granularity eq 'part_survey') { 518: if ($curr_item->{'symb'} ne $target->{'symb'} || 519: $curr_item->{'part'} ne $target->{'part'}) { 520: # bogus symb - return nothing 521: return (undef,undef,undef); 522: } 523: } elsif ($granularity eq 'response') { 524: if ($curr_item->{'symb'} ne $target->{'symb'} || 525: $curr_item->{'part'} ne $target->{'part'} || 526: $curr_item->{'respid'} ne $target->{'respid'} || 527: $curr_item->{'resptype'} ne $target->{'resptype'}){ 528: # bogus symb - return nothing 529: return (undef,undef,undef); 530: } 531: } 532: # 533: # Now just pick up the data we need 534: my ($prev,$curr,$next); 535: if ($curr_idx == 0) { 536: $prev = undef; 537: $curr = $Resource[$curr_idx ]; 538: $next = $Resource[$curr_idx+1]; 539: } elsif ($curr_idx == $#Resource) { 540: $prev = $Resource[$curr_idx-1]; 541: $curr = $Resource[$curr_idx ]; 542: $next = undef; 543: } else { 544: $prev = $Resource[$curr_idx-1]; 545: $curr = $Resource[$curr_idx ]; 546: $next = $Resource[$curr_idx+1]; 547: } 548: return ($navmap,$prev,$curr,$next); 549: } 550: 551: 552: ##################################################### 553: ##################################################### 554: 555: =pod 556: 557: =item GetStudentAnswers($r,$problem,$Students) 558: 559: Determines the correct answer for a set of students on a given problem. 560: The students answers are stored in the student hashes pointed to by the 561: array @$Students under the key 'answer'. 562: 563: Inputs: $r 564: $problem: hash reference containing the keys 'resource', 'part', and 'respid'. 565: $Students: reference to array containing student hashes (need 'username', 566: 'domain'). 567: 568: Returns: nothing 569: 570: =cut 571: 572: ##################################################### 573: ##################################################### 574: sub GetStudentAnswers { 575: my ($r,$problem,$Students,$formname,$inputname) = @_; 576: my %answers; 577: my $status_type; 578: if (defined($formname)) { 579: $status_type = 'inline'; 580: } else { 581: $status_type = 'popup'; 582: } 583: my $c = $r->connection(); 584: my %Answers; 585: my ($resource,$partid,$respid) = ($problem->{'resource'}, 586: $problem->{'part'}, 587: $problem->{'respid'}); 588: # Read in the cache (if it exists) before we start timing things. 589: &Apache::lonstathelpers::ensure_proper_cache($resource->{'symb'}); 590: # Open progress window 591: my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin 592: ($r,'Student Answer Compilation Status', 593: 'Student Answer Compilation Progress', scalar(@$Students), 594: $status_type,undef,$formname,$inputname); 595: $r->rflush(); 596: foreach my $student (@$Students) { 597: last if ($c->aborted()); 598: my $sname = $student->{'username'}; 599: my $sdom = $student->{'domain'}; 600: my $answer = &Apache::lonstathelpers::get_student_answer 601: ($resource,$sname,$sdom,$partid,$respid); 602: &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state, 603: &mt('last student')); 604: $answers{$answer}++; 605: $student->{'answer'} = $answer; 606: } 607: &Apache::lonstathelpers::write_analysis_cache(); 608: return if ($c->aborted()); 609: $r->rflush(); 610: # close progress window 611: &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state); 612: return \%answers; 613: } 614: 615: ##################################################### 616: ##################################################### 617: 618: =pod 619: 620: =item analyze_problem_as_student 621: 622: Analyzes a homework problem for a student 623: 624: Inputs: $resource: a resource object 625: $sname, $sdom, $partid, $respid 626: 627: Returns: the problem analysis hash 628: 629: =cut 630: 631: ##################################################### 632: ##################################################### 633: sub analyze_problem_as_student { 634: my ($resource,$sname,$sdom) = @_; 635: if (ref($resource) ne 'HASH') { 636: my $res = $resource; 637: $resource = { 'src' => $res->src, 638: 'symb' => $res->symb, 639: 'parts' => $res->parts }; 640: foreach my $part (@{$resource->{'parts'}}) { 641: $resource->{'partdata'}->{$part}->{'ResponseIds'}= 642: [$res->responseIds($part)]; 643: } 644: } 645: my $url = $resource->{'src'}; 646: my $symb = $resource->{'symb'}; 647: my $analysis = &get_from_analysis_cache($sname,$sdom,$symb); 648: if (! defined($analysis)) { 649: my $courseid = $env{'request.course.id'}; 650: my $Answ=&Apache::lonnet::ssi($url,('grade_target' => 'analyze', 651: 'grade_domain' => $sdom, 652: 'grade_username' => $sname, 653: 'grade_symb' => $symb, 654: 'grade_courseid' => $courseid)); 655: (my $garbage,$analysis)=split(/_HASH_REF__/,$Answ,2); 656: &store_analysis($sname,$sdom,$symb,$analysis); 657: } 658: my %Answer=&Apache::lonnet::str2hash($analysis); 659: # 660: return \%Answer; 661: } 662: 663: ##################################################### 664: ##################################################### 665: 666: =pod 667: 668: =item get_student_answer 669: 670: Analyzes a homework problem for a particular student and returns the correct 671: answer. Attempts to put together an answer for problem types 672: that do not natively support it. 673: 674: Inputs: $resource: a resource object (from navmaps or hash from loncoursedata) 675: $sname, $sdom, $partid, $respid 676: 677: Returns: $answer 678: 679: If $partid and $respid are specified, $answer is simply a scalar containing 680: the correct answer for the response. 681: 682: If $partid or $respid are undefined, $answer will be a hash reference with 683: keys $partid.'.'.$respid.'.answer'. 684: 685: =cut 686: 687: ##################################################### 688: ##################################################### 689: sub get_student_answer { 690: my ($resource,$sname,$sdom,$partid,$respid) = @_; 691: # 692: if (ref($resource) ne 'HASH') { 693: my $res = $resource; 694: $resource = { 'src' => $res->src, 695: 'symb' => $res->symb, 696: 'parts' => $res->parts }; 697: foreach my $part (@{$resource->{'parts'}}) { 698: $resource->{'partdata'}->{$part}->{'ResponseIds'}= 699: [$res->responseIds($part)]; 700: } 701: } 702: # 703: my $analysis = 704: &analyze_problem_as_student($resource,$sname,$sdom); 705: my $answer; 706: foreach my $partid (@{$resource->{'parts'}}) { 707: my $partdata = $resource->{'partdata'}->{$partid}; 708: foreach my $respid (@{$partdata->{'ResponseIds'}}) { 709: my $prefix = $partid.'.'.$respid; 710: my $key = $prefix.'.answer'; 711: $answer->{$partid}->{$respid} = 712: &get_answer($prefix,$key,%$analysis); 713: } 714: } 715: my $returnvalue; 716: if (! defined($partid)) { 717: $returnvalue = $answer; 718: } elsif (! defined($respid)) { 719: $returnvalue = $answer->{$partid}; 720: } else { 721: $returnvalue = $answer->{$partid}->{$respid}; 722: } 723: return $returnvalue; 724: } 725: 726: sub get_answer { 727: my ($prefix,$key,%Answer) = @_; 728: my $returnvalue; 729: if (exists($Answer{$key})) { 730: my $student_answer = $Answer{$key}->[0]; 731: if (! defined($student_answer)) { 732: $student_answer = $Answer{$key}->[1]; 733: } 734: $returnvalue = $student_answer; 735: } else { 736: if (exists($Answer{$prefix.'.shown'})) { 737: # The response has foils 738: my %values; 739: while (my ($k,$v) = each(%Answer)) { 740: next if ($k !~ /^$prefix\.foil\.(value|area)\.(.*)$/); 741: my $foilname = $2; 742: $values{$foilname}=$v; 743: } 744: foreach my $foil (@{$Answer{$prefix.'.shown'}}) { 745: if (ref($values{$foil}) eq 'ARRAY') { 746: $returnvalue.=&HTML::Entities::encode($foil,'<>&"').'='. 747: join(',',map {&HTML::Entities::encode($_,'<>&"')} @{$values{$foil}}).'&'; 748: } else { 749: $returnvalue.=&HTML::Entities::encode($foil,'<>&"').'='. 750: &HTML::Entities::encode($values{$foil},'<>&"').'&'; 751: } 752: } 753: $returnvalue =~ s/ /\%20/g; 754: chop ($returnvalue); 755: } 756: } 757: return $returnvalue; 758: } 759: 760: ##################################################### 761: ##################################################### 762: 763: =pod 764: 765: =item Caching routines 766: 767: =over 4 768: 769: =item &load_analysis_cache($symb) 770: 771: Loads the cache for the given symb into memory from disk. 772: Requires the cache filename be set. 773: Only should be called by &ensure_proper_cache. 774: 775: =cut 776: 777: ##################################################### 778: ##################################################### 779: { 780: my $cache_filename = undef; 781: my $current_symb = undef; 782: my %cache; 783: 784: sub load_analysis_cache { 785: my ($symb) = @_; 786: return if (! defined($cache_filename)); 787: if (! defined($current_symb) || $current_symb ne $symb) { 788: undef(%cache); 789: my $storedstring; 790: my %cache_db; 791: if (tie(%cache_db,'GDBM_File',$cache_filename,&GDBM_READER(),0640)) { 792: $storedstring = $cache_db{&Apache::lonnet::escape($symb)}; 793: untie(%cache_db); 794: } 795: if (defined($storedstring)) { 796: %cache = %{thaw($storedstring)}; 797: } 798: } 799: return; 800: } 801: 802: ##################################################### 803: ##################################################### 804: 805: =pod 806: 807: =item &get_from_analysis_cache($sname,$sdom,$symb,$partid,$respid) 808: 809: Returns the appropriate data from the cache, or undef if no data exists. 810: 811: =cut 812: 813: ##################################################### 814: ##################################################### 815: sub get_from_analysis_cache { 816: my ($sname,$sdom,$symb) = @_; 817: &ensure_proper_cache($symb); 818: my $returnvalue; 819: if (exists($cache{$sname.':'.$sdom})) { 820: $returnvalue = $cache{$sname.':'.$sdom}; 821: } else { 822: $returnvalue = undef; 823: } 824: return $returnvalue; 825: } 826: 827: ##################################################### 828: ##################################################### 829: 830: =pod 831: 832: =item &write_analysis_cache($symb) 833: 834: Writes the in memory cache to disk so that it can be read in with 835: &load_analysis_cache($symb). 836: 837: =cut 838: 839: ##################################################### 840: ##################################################### 841: sub write_analysis_cache { 842: return if (! defined($current_symb) || ! defined($cache_filename)); 843: my %cache_db; 844: my $key = &Apache::lonnet::escape($current_symb); 845: if (tie(%cache_db,'GDBM_File',$cache_filename,&GDBM_WRCREAT(),0640)) { 846: my $storestring = freeze(\%cache); 847: $cache_db{$key}=$storestring; 848: $cache_db{$key.'.time'}=time; 849: untie(%cache_db); 850: } 851: undef(%cache); 852: undef($current_symb); 853: undef($cache_filename); 854: return; 855: } 856: 857: ##################################################### 858: ##################################################### 859: 860: =pod 861: 862: =item &ensure_proper_cache($symb) 863: 864: Called to make sure we have the proper cache set up. This is called 865: prior to every analysis lookup. 866: 867: =cut 868: 869: ##################################################### 870: ##################################################### 871: sub ensure_proper_cache { 872: my ($symb) = @_; 873: my $cid = $env{'request.course.id'}; 874: my $new_filename = '/home/httpd/perl/tmp/'. 875: 'problemanalysis_'.$cid.'_analysis_cache.db'; 876: if (! defined($cache_filename) || 877: $cache_filename ne $new_filename || 878: ! defined($current_symb) || 879: $current_symb ne $symb) { 880: $cache_filename = $new_filename; 881: # Notice: $current_symb is not set to $symb until after the cache is 882: # loaded. This is what tells &load_analysis_cache to load in a new 883: # symb cache. 884: &load_analysis_cache($symb); 885: $current_symb = $symb; 886: } 887: } 888: 889: ##################################################### 890: ##################################################### 891: 892: =pod 893: 894: =item &store_analysis($sname,$sdom,$symb,$partid,$respid,$dataset) 895: 896: Stores the analysis data in the in memory cache. 897: 898: =cut 899: 900: ##################################################### 901: ##################################################### 902: sub store_analysis { 903: my ($sname,$sdom,$symb,$dataset) = @_; 904: return if ($symb ne $current_symb); 905: $cache{$sname.':'.$sdom}=$dataset; 906: return; 907: } 908: 909: } 910: ##################################################### 911: ##################################################### 912: 913: =pod 914: 915: =back 916: 917: =cut 918: 919: ##################################################### 920: ##################################################### 921: 922: ## 923: ## The following is copied from datecalc1.pl, part of the 924: ## Spreadsheet::WriteExcel CPAN module. 925: ## 926: ## 927: ###################################################################### 928: # 929: # Demonstration of writing date/time cells to Excel spreadsheets, 930: # using UNIX/Perl time as source of date/time. 931: # 932: # Copyright 2000, Andrew Benham, adsb@bigfoot.com 933: # 934: ###################################################################### 935: # 936: # UNIX/Perl time is the time since the Epoch (00:00:00 GMT, 1 Jan 1970) 937: # measured in seconds. 938: # 939: # An Excel file can use exactly one of two different date/time systems. 940: # In these systems, a floating point number represents the number of days 941: # (and fractional parts of the day) since a start point. The floating point 942: # number is referred to as a 'serial'. 943: # The two systems ('1900' and '1904') use different starting points: 944: # '1900'; '1.00' is 1 Jan 1900 BUT 1900 is erroneously regarded as 945: # a leap year - see: 946: # http://support.microsoft.com/support/kb/articles/Q181/3/70.asp 947: # for the excuse^H^H^H^H^H^Hreason. 948: # '1904'; '1.00' is 2 Jan 1904. 949: # 950: # The '1904' system is the default for Apple Macs. Windows versions of 951: # Excel have the option to use the '1904' system. 952: # 953: # Note that Visual Basic's "DateSerial" function does NOT erroneously 954: # regard 1900 as a leap year, and thus its serials do not agree with 955: # the 1900 serials of Excel for dates before 1 Mar 1900. 956: # 957: # Note that StarOffice (at least at version 5.2) does NOT erroneously 958: # regard 1900 as a leap year, and thus its serials do not agree with 959: # the 1900 serials of Excel for dates before 1 Mar 1900. 960: # 961: ###################################################################### 962: # 963: # Calculation description 964: # ======================= 965: # 966: # 1900 system 967: # ----------- 968: # Unix time is '0' at 00:00:00 GMT 1 Jan 1970, i.e. 70 years after 1 Jan 1900. 969: # Of those 70 years, 17 (1904,08,12,16,20,24,28,32,36,40,44,48,52,56,60,64,68) 970: # were leap years with an extra day. 971: # Thus there were 17 + 70*365 days = 25567 days between 1 Jan 1900 and 972: # 1 Jan 1970. 973: # In the 1900 system, '1' is 1 Jan 1900, but as 1900 was not a leap year 974: # 1 Jan 1900 should really be '2', so 1 Jan 1970 is '25569'. 975: # 976: # 1904 system 977: # ----------- 978: # Unix time is '0' at 00:00:00 GMT 1 Jan 1970, i.e. 66 years after 1 Jan 1904. 979: # Of those 66 years, 17 (1904,08,12,16,20,24,28,32,36,40,44,48,52,56,60,64,68) 980: # were leap years with an extra day. 981: # Thus there were 17 + 66*365 days = 24107 days between 1 Jan 1904 and 982: # 1 Jan 1970. 983: # In the 1904 system, 2 Jan 1904 being '1', 1 Jan 1970 is '24107'. 984: # 985: ###################################################################### 986: # 987: # Copyright (c) 2000, Andrew Benham. 988: # This program is free software. It may be used, redistributed and/or 989: # modified under the same terms as Perl itself. 990: # 991: # Andrew Benham, adsb@bigfoot.com 992: # London, United Kingdom 993: # 11 Nov 2000 994: # 995: ###################################################################### 996: #----------------------------------------------------------- 997: # calc_serial() 998: # 999: # Called with (up to) 2 parameters. 1000: # 1. Unix timestamp. If omitted, uses current time. 1001: # 2. GMT flag. Set to '1' to return serial in GMT. 1002: # If omitted, returns serial in appropriate timezone. 1003: # 1004: # Returns date/time serial according to $DATE_SYSTEM selected 1005: #----------------------------------------------------------- 1006: sub calc_serial { 1007: # Use 1900 date system on all platforms other than Apple Mac (for which 1008: # use 1904 date system). 1009: my $DATE_SYSTEM = ($^O eq 'MacOS') ? 1 : 0; 1010: my $time = (defined $_[0]) ? $_[0] : time(); 1011: my $gmtflag = (defined $_[1]) ? $_[1] : 0; 1012: # 1013: # Divide timestamp by number of seconds in a day. 1014: # This gives a date serial with '0' on 1 Jan 1970. 1015: my $serial = $time / 86400; 1016: # 1017: # Adjust the date serial by the offset appropriate to the 1018: # currently selected system (1900/1904). 1019: if ($DATE_SYSTEM == 0) { # use 1900 system 1020: $serial += 25569; 1021: } else { # use 1904 system 1022: $serial += 24107; 1023: } 1024: # 1025: unless ($gmtflag) { 1026: # Now have a 'raw' serial with the right offset. But this 1027: # gives a serial in GMT, which is false unless the timezone 1028: # is GMT. We need to adjust the serial by the appropriate 1029: # timezone offset. 1030: # Calculate the appropriate timezone offset by seeing what 1031: # the differences between localtime and gmtime for the given 1032: # time are. 1033: # 1034: my @gmtime = gmtime($time); 1035: my @ltime = localtime($time); 1036: # 1037: # For the first 7 elements of the two arrays, adjust the 1038: # date serial where the elements differ. 1039: for (0 .. 6) { 1040: my $diff = $ltime[$_] - $gmtime[$_]; 1041: if ($diff) { 1042: $serial += _adjustment($diff,$_); 1043: } 1044: } 1045: } 1046: # 1047: # Perpetuate the error that 1900 was a leap year by decrementing 1048: # the serial if we're using the 1900 system and the date is prior to 1049: # 1 Mar 1900. This has the effect of making serial value '60' 1050: # 29 Feb 1900. 1051: # 1052: # This fix only has any effect if UNIX/Perl time on the platform 1053: # can represent 1900. Many can't. 1054: # 1055: unless ($DATE_SYSTEM) { 1056: $serial-- if ($serial < 61); # '61' is 1 Mar 1900 1057: } 1058: return $serial; 1059: } 1060: 1061: sub _adjustment { 1062: # Based on the difference in the localtime/gmtime array elements 1063: # number, return the adjustment required to the serial. 1064: # 1065: # We only look at some elements of the localtime/gmtime arrays: 1066: # seconds unlikely to be different as all known timezones 1067: # have an offset of integral multiples of 15 minutes, 1068: # but it's easy to do. 1069: # minutes will be different for timezone offsets which are 1070: # not an exact number of hours. 1071: # hours very likely to be different. 1072: # weekday will differ when localtime/gmtime difference 1073: # straddles midnight. 1074: # 1075: # Assume that difference between localtime and gmtime is less than 1076: # 5 days, then don't have to do maths for day of month, month number, 1077: # year number, etc... 1078: # 1079: my ($delta,$element) = @_; 1080: my $adjust = 0; 1081: # 1082: if ($element == 0) { # Seconds 1083: $adjust = $delta/86400; # 60 * 60 * 24 1084: } elsif ($element == 1) { # Minutes 1085: $adjust = $delta/1440; # 60 * 24 1086: } elsif ($element == 2) { # Hours 1087: $adjust = $delta/24; # 24 1088: } elsif ($element == 6) { # Day of week number 1089: # Catch difference straddling Sat/Sun in either direction 1090: $delta += 7 if ($delta < -4); 1091: $delta -= 7 if ($delta > 4); 1092: # 1093: $adjust = $delta; 1094: } 1095: return $adjust; 1096: } 1097: 1098: ########################################################### 1099: ########################################################### 1100: 1101: =pod 1102: 1103: =item get_problem_data 1104: 1105: Returns a data structure describing the problem. 1106: 1107: Inputs: $url 1108: 1109: Returns: %Partdata 1110: 1111: =cut 1112: 1113: ## note: we must force each foil and option to not begin or end with 1114: ## spaces as they are stored without such data. 1115: ## 1116: ########################################################### 1117: ########################################################### 1118: sub get_problem_data { 1119: my ($url) = @_; 1120: my $Answ=&Apache::lonnet::ssi($url,('grade_target' => 'analyze')); 1121: (my $garbage,$Answ)=split(/_HASH_REF__/,$Answ,2); 1122: my %Answer; 1123: %Answer=&Apache::lonnet::str2hash($Answ); 1124: my %Partdata; 1125: foreach my $part (@{$Answer{'parts'}}) { 1126: while (my($key,$value) = each(%Answer)) { 1127: # 1128: # Logging code: 1129: if (0) { 1130: &Apache::lonnet::logthis($part.' got key "'.$key.'"'); 1131: if (ref($value) eq 'ARRAY') { 1132: &Apache::lonnet::logthis(' @'.join(',',@$value)); 1133: } else { 1134: &Apache::lonnet::logthis(' '.$value); 1135: } 1136: } 1137: # End of logging code 1138: next if ($key !~ /^$part/); 1139: $key =~ s/^$part\.//; 1140: if (ref($value) eq 'ARRAY') { 1141: if ($key eq 'options') { 1142: $Partdata{$part}->{'_Options'}=$value; 1143: } elsif ($key eq 'concepts') { 1144: $Partdata{$part}->{'_Concepts'}=$value; 1145: } elsif ($key eq 'items') { 1146: $Partdata{$part}->{'_Items'}=$value; 1147: } elsif ($key =~ /^concept\.(.*)$/) { 1148: my $concept = $1; 1149: foreach my $foil (@$value) { 1150: $Partdata{$part}->{'_Foils'}->{$foil}->{'_Concept'}= 1151: $concept; 1152: } 1153: } elsif ($key =~ /^(unit|incorrect|answer|ans_low|ans_high|str_type)$/) { 1154: $Partdata{$part}->{$key}=$value; 1155: } 1156: } else { 1157: if ($key=~ /^foil\.text\.(.*)$/) { 1158: my $foil = $1; 1159: $Partdata{$part}->{'_Foils'}->{$foil}->{'name'}=$foil; 1160: $value =~ s/(\s*$|^\s*)//g; 1161: $Partdata{$part}->{'_Foils'}->{$foil}->{'text'}=$value; 1162: } elsif ($key =~ /^foil\.value\.(.*)$/) { 1163: my $foil = $1; 1164: $Partdata{$part}->{'_Foils'}->{$foil}->{'value'}=$value; 1165: } elsif ($key eq 'answercomputed') { 1166: $Partdata{$part}->{'answercomputed'} = $value; 1167: } 1168: } 1169: } 1170: } 1171: # Further debugging code 1172: if (0) { 1173: &Apache::lonnet::logthis('lonstathelpers::get_problem_data'); 1174: &log_hash_ref(\%Partdata); 1175: } 1176: return %Partdata; 1177: } 1178: 1179: sub log_array_ref { 1180: my ($arrayref,$prefix) = @_; 1181: return if (ref($arrayref) ne 'ARRAY'); 1182: if (! defined($prefix)) { $prefix = ''; }; 1183: foreach my $v (@$arrayref) { 1184: if (ref($v) eq 'ARRAY') { 1185: &log_array_ref($v,$prefix.' '); 1186: } elsif (ref($v) eq 'HASH') { 1187: &log_hash_ref($v,$prefix.' '); 1188: } else { 1189: &Apache::lonnet::logthis($prefix.'"'.$v.'"'); 1190: } 1191: } 1192: } 1193: 1194: sub log_hash_ref { 1195: my ($hashref,$prefix) = @_; 1196: return if (ref($hashref) ne 'HASH'); 1197: if (! defined($prefix)) { $prefix = ''; }; 1198: while (my ($k,$v) = each(%$hashref)) { 1199: if (ref($v) eq 'ARRAY') { 1200: &Apache::lonnet::logthis($prefix.'"'.$k.'" = array'); 1201: &log_array_ref($v,$prefix.' '); 1202: } elsif (ref($v) eq 'HASH') { 1203: &Apache::lonnet::logthis($prefix.'"'.$k.'" = hash'); 1204: &log_hash_ref($v,$prefix.' '); 1205: } else { 1206: &Apache::lonnet::logthis($prefix.'"'.$k.'" => "'.$v.'"'); 1207: } 1208: } 1209: } 1210: #################################################### 1211: #################################################### 1212: 1213: =pod 1214: 1215: =item &limit_by_time() 1216: 1217: =cut 1218: 1219: #################################################### 1220: #################################################### 1221: sub limit_by_time_form { 1222: my $Starttime_form = ''; 1223: my $starttime = &Apache::lonhtmlcommon::get_date_from_form 1224: ('limitby_startdate'); 1225: my $endtime = &Apache::lonhtmlcommon::get_date_from_form 1226: ('limitby_enddate'); 1227: if (! defined($endtime)) { 1228: $endtime = time; 1229: } 1230: if (! defined($starttime)) { 1231: $starttime = $endtime - 60*60*24*7; 1232: } 1233: my $state; 1234: if (&limit_by_time()) { 1235: $state = ''; 1236: } else { 1237: $state = 'disabled'; 1238: } 1239: my $startdateform = &Apache::lonhtmlcommon::date_setter 1240: ('Statistics','limitby_startdate',$starttime,undef,undef,$state); 1241: my $enddateform = &Apache::lonhtmlcommon::date_setter 1242: ('Statistics','limitby_enddate',$endtime,undef,undef,$state); 1243: my $Str; 1244: $Str .= '<script language="Javascript" >'; 1245: $Str .= 'function toggle_limitby_activity(state) {'; 1246: $Str .= ' if (state) {'; 1247: $Str .= ' limitby_startdate_enable();'; 1248: $Str .= ' limitby_enddate_enable();'; 1249: $Str .= ' } else {'; 1250: $Str .= ' limitby_startdate_disable();'; 1251: $Str .= ' limitby_enddate_disable();'; 1252: $Str .= ' }'; 1253: $Str .= '}'; 1254: $Str .= '</script>'; 1255: $Str .= '<fieldset>'; 1256: my $timecheckbox = '<input type="checkbox" name="limit_by_time" '; 1257: if (&limit_by_time()) { 1258: $timecheckbox .= ' checked '; 1259: } 1260: $timecheckbox .= 'OnChange="javascript:toggle_limitby_activity(this.checked);" '; 1261: $timecheckbox .= ' />'; 1262: $Str .= '<legend><label>'.&mt('[_1] Limit by time',$timecheckbox).'</label></legend>'; 1263: $Str .= &mt('Start Time: [_1]',$startdateform).'<br />'; 1264: $Str .= &mt(' End Time: [_1]',$enddateform).'<br />'; 1265: $Str .= '</fieldset>'; 1266: return $Str; 1267: } 1268: 1269: sub limit_by_time { 1270: if (exists($env{'form.limit_by_time'}) && 1271: $env{'form.limit_by_time'} ne '' ) { 1272: return 1; 1273: } else { 1274: return 0; 1275: } 1276: } 1277: 1278: sub get_time_limits { 1279: my $starttime = &Apache::lonhtmlcommon::get_date_from_form 1280: ('limitby_startdate'); 1281: my $endtime = &Apache::lonhtmlcommon::get_date_from_form 1282: ('limitby_enddate'); 1283: return ($starttime,$endtime); 1284: } 1285: 1286: #################################################### 1287: #################################################### 1288: 1289: =pod 1290: 1291: =item &manage_caches 1292: 1293: Inputs: $r, apache request object 1294: 1295: Returns: An array of scalars containing html for buttons. 1296: 1297: =cut 1298: 1299: #################################################### 1300: #################################################### 1301: sub manage_caches { 1302: my ($r,$formname,$inputname,$update_message) = @_; 1303: &Apache::loncoursedata::clear_internal_caches(); 1304: my $sectionkey = 1305: join(',', 1306: map { 1307: &Apache::lonnet::escape($_); 1308: } sort(&Apache::lonstatistics::get_selected_sections()) 1309: ); 1310: my $statuskey = $Apache::lonstatistics::enrollment_status; 1311: if (exists($env{'form.ClearCache'}) || 1312: exists($env{'form.updatecaches'}) || 1313: (exists($env{'form.firstrun'}) && $env{'form.firstrun'} ne 'no') || 1314: (exists($env{'form.prevsection'}) && 1315: $env{'form.prevsection'} ne $sectionkey) || 1316: (exists($env{'form.prevenrollstatus'}) && 1317: $env{'form.prevenrollstatus'} ne $statuskey) 1318: ) { 1319: if (defined($update_message)) { 1320: $r->print($update_message); 1321: } 1322: if (0) { 1323: &Apache::lonnet::logthis('Updating mysql student data caches'); 1324: } 1325: &gather_full_student_data($r,$formname,$inputname); 1326: } 1327: # 1328: my @Buttons = 1329: ('<input type="submit" name="ClearCache" '. 1330: 'value="'.&mt('Clear Caches').'" />', 1331: '<input type="submit" name="updatecaches" '. 1332: 'value="'.&mt('Update Caches').'" />'. 1333: &Apache::loncommon::help_open_topic('Statistics_Cache'), 1334: '<input type="hidden" name="prevsection" value="'.$sectionkey.'" />', 1335: '<input type="hidden" name="prevenrollstatus" value="'.$statuskey.'" />' 1336: ); 1337: # 1338: if (! exists($env{'form.firstrun'})) { 1339: $r->print('<input type="hidden" name="firstrun" value="yes" />'); 1340: } else { 1341: $r->print('<input type="hidden" name="firstrun" value="no" />'); 1342: } 1343: # 1344: return @Buttons; 1345: } 1346: 1347: sub gather_full_student_data { 1348: my ($r,$formname,$inputname) = @_; 1349: my $status_type; 1350: if (defined($formname)) { 1351: $status_type = 'inline'; 1352: } else { 1353: $status_type = 'popup'; 1354: } 1355: my $c = $r->connection(); 1356: # 1357: &Apache::loncoursedata::clear_internal_caches(); 1358: # 1359: my @Students = @Apache::lonstatistics::Students; 1360: # 1361: # Open the progress window 1362: my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin 1363: ($r,&mt('Student Data Compilation Status'), 1364: &mt('Student Data Compilation Progress'), scalar(@Students), 1365: $status_type,undef,$formname,$inputname); 1366: # 1367: while (my $student = shift @Students) { 1368: return if ($c->aborted()); 1369: my $status = &Apache::loncoursedata::ensure_current_full_data 1370: ($student->{'username'},$student->{'domain'}, 1371: $env{'request.course.id'}); 1372: &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state, 1373: &mt('last student')); 1374: } 1375: &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state); 1376: $r->rflush(); 1377: return; 1378: } 1379: 1380: #################################################### 1381: #################################################### 1382: 1383: =pod 1384: 1385: =item &submission_report_form 1386: 1387: Input: The originating reportSelected value for the current stats page. 1388: 1389: Output: Scalar containing HTML with needed form elements and a link to 1390: the student submission reports page. 1391: 1392: =cut 1393: 1394: #################################################### 1395: #################################################### 1396: sub submission_report_form { 1397: my ($original_report) = @_; 1398: # Note: In the link below we change the reportSelected value. If 1399: # the user hits the 'back' button on the browser after getting their 1400: # student submissions report, this value may still be around. So we 1401: # output a script block to set it properly. If the $original_report 1402: # value is unset, you are just asking for trouble. 1403: if (! defined($original_report)) { 1404: &Apache::lonnet::logthis 1405: ('someone called lonstathelpers::submission_report_form without '. 1406: ' enough input.'); 1407: } 1408: my $html = $/. 1409: '<script type="Text/JavaScript">'. 1410: "document.Statistics.reportSelected.value='$original_report';". 1411: '</script>'. 1412: '<input type="hidden" name="correctans" value="true" />'. 1413: '<input type="hidden" name="prob_status" value="true" />'. 1414: '<input type="hidden" name="all_sub" value="true" />'; 1415: my $output_selector = $/.'<select name="output">'.$/; 1416: foreach ('HTML','Excel','CSV') { 1417: $output_selector .= ' <option value="'.lc($_).'"'; 1418: if ($env{'form.output'} eq lc($_)) { 1419: $output_selector .= ' selected '; 1420: } 1421: $output_selector .='>'.&mt($_).'</option>'.$/; 1422: } 1423: $output_selector .= '</select>'.$/; 1424: my $link = '<a href="javascript:'. 1425: q{document.Statistics.reportSelected.value='student_submission_reports';}. 1426: 'document.Statistics.submit();">'; 1427: $html.= &mt('View data as [_1] [_2]go[_3]',$output_selector, 1428: $link,'</a>').$/; 1429: return $html 1430: } 1431: 1432: #################################################### 1433: #################################################### 1434: 1435: =pod 1436: 1437: =back 1438: 1439: =cut 1440: 1441: #################################################### 1442: #################################################### 1443: 1444: 1; 1445: 1446: __END__