loncom/interface/statistics/lonstathelpers.pm - view

File: [LON-CAPA] / loncom / interface / statistics / lonstathelpers.pm
Revision 1.59.12.2: download - view: text, annotated - select for diffs
Fri Nov 18 22:35:33 2011 UTC (12 years, 7 months ago) by raeburn
Branches: GCI_3
Diff to branchpoint 1.59: preferred, unified

- Customization for GCI_3.
  - DC can check "Anonymized" when generating student submissions display
    (replaces username info with hashed username to preserve anonymity, and
     randomized order of student rows).
  - Select All and UnSelect All converted from links to checkboxes to
    support requests for student submissions data from command line scripts.

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