Annotation of loncom/interface/statistics/lonstathelpers.pm, revision 1.5

1.1       matthew     1: # The LearningOnline Network with CAPA
                      2: #
1.5     ! matthew     3: # $Id: lonstathelpers.pm,v 1.4 2004/02/19 20:17:01 matthew Exp $
1.1       matthew     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: 
                     44: =over 4
                     45: 
                     46: =cut
                     47: 
                     48: ####################################################
                     49: ####################################################
                     50: package Apache::lonstathelpers;
                     51: 
                     52: use strict;
                     53: use Apache::lonnet();
                     54: use Apache::loncommon();
                     55: use Apache::lonhtmlcommon();
                     56: use Apache::loncoursedata();
                     57: use Apache::lonstatistics;
                     58: use Apache::lonlocal;
                     59: use HTML::Entities();
                     60: use Time::Local();
                     61: use Spreadsheet::WriteExcel();
                     62: 
                     63: ####################################################
                     64: ####################################################
                     65: 
                     66: =pod
                     67: 
                     68: =item &render_resource($resource)
                     69: 
                     70: Input: a resource generated from 
                     71: &Apache::loncoursedata::get_sequence_assessment_data().
                     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;
                     85:     ($base,undef) = ($resource->{'src'} =~ m|(.*/)[^/]*$|);
                     86:     $base = "http://".$ENV{'SERVER_NAME'}.$base;
                     87:     my $rendered_problem = 
                     88:         &Apache::lonnet::ssi_body($resource->{'src'});
                     89:     $rendered_problem =~ s/<\s*form\s*/<nop /g;
                     90:     $rendered_problem =~ s|(<\s*/form\s*>)|<\/nop>|g;
                     91:     return '<table bgcolor="ffffff"><tr><td>'.
                     92:         '<base href="'.$base.'" />'.
                     93:         $rendered_problem.
                     94:         '</td></tr></table>';
                     95: }
1.2       matthew    96: 
                     97: ####################################################
                     98: ####################################################
                     99: 
                    100: =pod
                    101: 
                    102: =item &ProblemSelector($AcceptedResponseTypes)
                    103: 
                    104: Input: scalar containing regular expression which matches response
                    105: types to show.  '.' will yield all, '(option|radiobutton)' will match
                    106: all option response and radiobutton problems.
                    107: 
                    108: Returns: A string containing html for a table which lists the sequences
                    109: and their contents.  A radiobutton is provided for each problem.
                    110: 
                    111: =cut
                    112: 
                    113: ####################################################
                    114: ####################################################
                    115: sub ProblemSelector {
                    116:     my ($AcceptedResponseTypes) = @_;
                    117:     my $Str;
                    118:     $Str = "\n<table>\n";
                    119:     foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) {
                    120:         next if ($seq->{'num_assess'}<1);
                    121:         my $seq_str = '';
                    122:         foreach my $res (@{$seq->{'contents'}}) {
                    123:             next if ($res->{'type'} ne 'assessment');
                    124:             foreach my $part (@{$res->{'parts'}}) {
                    125:                 my $partdata = $res->{'partdata'}->{$part};
                    126:                 for (my $i=0;$i<scalar(@{$partdata->{'ResponseTypes'}});$i++){
                    127:                     my $respid = $partdata->{'ResponseIds'}->[$i];
                    128:                     my $resptype = $partdata->{'ResponseTypes'}->[$i];
                    129:                     if ($resptype =~ m/$AcceptedResponseTypes/) {
                    130:                         my $value = &make_target_id({symb=>$res->{'symb'},
                    131:                                                      part=>$part,
                    132:                                                      respid=>$respid,
                    133:                                                      resptype=>$resptype});
                    134:                         my $checked = '';
                    135:                         if ($ENV{'form.problemchoice'} eq $value) {
                    136:                             $checked = 'checked ';
                    137:                         }
                    138:                         my $title = $res->{'title'};
                    139:                         if (! defined($title) || $title eq '') {
                    140:                             ($title) = ($res->{'src'} =~ m:/([^/]*)$:);
                    141:                         }
                    142:                         $seq_str .= '<tr><td>'.
                    143:   '<input type="radio" name="problemchoice" value="'.$value.'" '.$checked.'/>'.
                    144:   '</td><td>'.          
                    145:   $resptype.'</td><td>'.
                    146:   '<a href="'.$res->{'src'}.'">'.$title.'</a> ';
                    147: #  '<a href="'.$res->{'src'}.'">'.$resptype.' '.$res->{'title'}.'</a> ';
1.5     ! matthew   148:                         if (scalar(@{$partdata->{'ResponseIds'}}) > 1) {
1.2       matthew   149:                             $seq_str .= &mt('response').' '.$respid;
                    150:                         }
                    151:                         $seq_str .= "</td></tr>\n";
                    152:                     }
                    153:                 }
                    154:             }
                    155:         }
                    156:         if ($seq_str ne '') {
                    157:             $Str .= '<tr><td>&nbsp</td><td colspan="2"><b>'.$seq->{'title'}.'</b></td>'.
                    158:                 "</tr>\n".$seq_str;
                    159:         }
                    160:     }
                    161:     $Str .= "</table>\n";
                    162:     return $Str;
                    163: }
                    164: 
                    165: ####################################################
                    166: ####################################################
                    167: 
                    168: =pod
                    169: 
                    170: =item &make_target_id($target)
                    171: 
                    172: Inputs: Hash ref with the following entries:
                    173:     $target->{'symb'}, $target->{'part'}, $target->{'respid'}, 
                    174:     $target->{'resptype'}.
                    175: 
                    176: Returns: A string, suitable for a form parameter, which uniquely identifies
                    177: the problem, part, and response to do statistical analysis on.
                    178: 
                    179: Used by Apache::lonstathelpers::ProblemSelector().
                    180: 
                    181: =cut
                    182: 
                    183: ####################################################
                    184: ####################################################
                    185: sub make_target_id {
                    186:     my ($target) = @_;
                    187:     my $id = &Apache::lonnet::escape($target->{'symb'}).':'.
                    188:              &Apache::lonnet::escape($target->{'part'}).':'.
                    189:              &Apache::lonnet::escape($target->{'respid'}).':'.
                    190:              &Apache::lonnet::escape($target->{'resptype'});
                    191:     return $id;
                    192: }
                    193: 
                    194: ####################################################
                    195: ####################################################
                    196: 
                    197: =pod
                    198: 
                    199: =item &get_target_from_id($id)
                    200: 
                    201: Inputs: $id, a scalar string from Apache::lonstathelpers::make_target_id().
                    202: 
                    203: Returns: A hash reference, $target, containing the following keys:
                    204:     $target->{'symb'}, $target->{'part'}, $target->{'respid'}, 
                    205:     $target->{'resptype'}.
                    206: 
                    207: =cut
                    208: 
                    209: ####################################################
                    210: ####################################################
                    211: sub get_target_from_id {
                    212:     my ($id) = @_;
                    213:     my ($symb,$part,$respid,$resptype) = split(':',$id);
                    214:     return ({ symb    =>&Apache::lonnet::unescape($symb),
                    215:              part     =>&Apache::lonnet::unescape($part),
                    216:              respid   =>&Apache::lonnet::unescape($respid),
                    217:              resptype =>&Apache::lonnet::unescape($resptype)});
                    218: }
                    219: 
                    220: ####################################################
                    221: ####################################################
                    222: 
                    223: =pod
                    224: 
                    225: =item &get_prev_curr_next($target)
                    226: 
                    227: Determine the problem parts or responses preceeding and following the
                    228: current resource.
                    229: 
                    230: Inputs: $target (see &Apache::lonstathelpers::get_target_from_id())
                    231:   $AcceptableResponseTypes, regular expression matching acceptable
                    232:                             response types,
                    233:   $granularity, either 'part' or 'response'
                    234: 
                    235: Returns: three hash references, $prev, $curr, $next, which refer to the
                    236: preceeding, current, or following problem parts or responses, depending
                    237: on the value of $granularity.  Values of undef indicate there is no
                    238: previous or next part/response.  A value of undef for all three indicates
                    239: there was no match found to the current part/resource.
                    240: 
                    241: The hash references contain the following keys:
                    242:     symb, part, resource
                    243: 
                    244: If $granularity eq 'response', the following ADDITIONAL keys will be present:
                    245:     respid, resptype
                    246: 
                    247: =cut
                    248: 
                    249: ####################################################
                    250: ####################################################
                    251: sub get_prev_curr_next {
                    252:     my ($target,$AcceptableResponseTypes,$granularity) = @_;
                    253:     #
                    254:     # Build an array with the data we need to search through
                    255:     my @Resource;
                    256:     foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) {
                    257:         foreach my $res (@{$seq->{'contents'}}) {
                    258:             next if ($res->{'type'} ne 'assessment');
                    259:             foreach my $part (@{$res->{'parts'}}) {
                    260:                 my $partdata = $res->{'partdata'}->{$part};
                    261:                 if ($granularity eq 'part') {
                    262:                     push (@Resource,
                    263:                           { symb     => $res->{symb},
                    264:                             part     => $part,
                    265:                             resource => $res,
                    266:                         } );
                    267:                 } elsif ($granularity eq 'response') {
                    268:                     for (my $i=0;
                    269:                          $i<scalar(@{$partdata->{'ResponseTypes'}});
                    270:                          $i++){
                    271:                         my $respid = $partdata->{'ResponseIds'}->[$i];
                    272:                         my $resptype = $partdata->{'ResponseTypes'}->[$i];
                    273:                         next if ($resptype !~ m/$AcceptableResponseTypes/);
                    274:                         push (@Resource,
                    275:                               { symb     => $res->{symb},
                    276:                                 part     => $part,
                    277:                                 respid   => $partdata->{'ResponseIds'}->[$i],
                    278:                                 resource => $res,
                    279:                                 resptype => $resptype
                    280:                                 } );
                    281:                     }
                    282:                 }
                    283:             }
                    284:         }
                    285:     }
                    286:     #
                    287:     # Get the index of the current situation
                    288:     my $curr_idx;
                    289:     for ($curr_idx=0;$curr_idx<$#Resource;$curr_idx++) {
                    290:         my $curr_item = $Resource[$curr_idx];
                    291:         if ($granularity eq 'part') {
                    292:             if ($curr_item->{'symb'} eq $target->{'symb'} &&
                    293:                 $curr_item->{'part'} eq $target->{'part'}) {
                    294:                 last;
                    295:             }
                    296:         } elsif ($granularity eq 'response') {
                    297:             if ($curr_item->{'symb'} eq $target->{'symb'} &&
                    298:                 $curr_item->{'part'} eq $target->{'part'} &&
                    299:                 $curr_item->{'respid'} eq $target->{'respid'} &&
                    300:                 $curr_item->{'resptype'} eq $target->{'resptype'}) {
                    301:                 last;
                    302:             }
                    303:         }
                    304:     }
                    305:     my $curr_item = $Resource[$curr_idx];
                    306:     if ($granularity eq 'part') {
                    307:         if ($curr_item->{'symb'}     ne $target->{'symb'} ||
                    308:             $curr_item->{'part'}     ne $target->{'part'}) {
                    309:             # bogus symb - return nothing
                    310:             return (undef,undef,undef);
                    311:         }
                    312:     } elsif ($granularity eq 'response') {
                    313:         if ($curr_item->{'symb'}     ne $target->{'symb'} ||
                    314:             $curr_item->{'part'}     ne $target->{'part'} ||
                    315:             $curr_item->{'respid'}   ne $target->{'respid'} ||
                    316:             $curr_item->{'resptype'} ne $target->{'resptype'}){
                    317:             # bogus symb - return nothing
                    318:             return (undef,undef,undef);
                    319:         }
                    320:     }
                    321:     #
                    322:     # Now just pick up the data we need
                    323:     my ($prev,$curr,$next);
                    324:     if ($curr_idx == 0) {
                    325:         $prev = undef;
                    326:         $curr = $Resource[$curr_idx  ];
                    327:         $next = $Resource[$curr_idx+1];
                    328:     } elsif ($curr_idx == $#Resource) {
                    329:         $prev = $Resource[$curr_idx-1];
                    330:         $curr = $Resource[$curr_idx  ];
                    331:         $next = undef;
                    332:     } else {
                    333:         $prev = $Resource[$curr_idx-1];
                    334:         $curr = $Resource[$curr_idx  ];
                    335:         $next = $Resource[$curr_idx+1];
                    336:     }
                    337:     return ($prev,$curr,$next);
1.4       matthew   338: }
                    339: 
                    340: 
                    341: #####################################################
                    342: #####################################################
                    343: 
                    344: =pod
                    345: 
                    346: =item analyze_problem_as_student
                    347: 
                    348: Analyzes a homework problem for a student and returns the correct answer
                    349: for the student.  Attempts to put together an answer for problem types 
                    350: that do not natively support it.
                    351: 
                    352: Inputs: $resource: a resource object
                    353:         $sname, $sdom, $partid, $respid
                    354: 
                    355: Returns: $answer
                    356: 
                    357: =cut
                    358: 
                    359: #####################################################
                    360: #####################################################
                    361: sub analyze_problem_as_student {
                    362:     my ($resource,$sname,$sdom,$partid,$respid) = @_;
                    363:     my $returnvalue;
                    364:     my $url = $resource->{'src'};
                    365:     my $symb = $resource->{'symb'};
                    366:     my $courseid = $ENV{'request.course.id'};
                    367:     my $Answ=&Apache::lonnet::ssi($url,('grade_target' => 'analyze',
                    368:                                         'grade_domain' => $sdom,
                    369:                                         'grade_username' => $sname,
                    370:                                         'grade_symb' => $symb,
                    371:                                         'grade_courseid' => $courseid));
                    372:     (my $garbage,$Answ)=split(/_HASH_REF__/,$Answ,2);
                    373:     my %Answer=&Apache::lonnet::str2hash($Answ);
                    374:     my $prefix = $partid.'.'.$respid;
                    375:     my $key = $prefix.'.answer';
                    376:     if (exists($Answer{$key})) {
                    377:         my $student_answer = $Answer{$key}->[0];
                    378:         if (! defined($student_answer)) {
                    379:             $student_answer = $Answer{$key}->[1];
                    380:         }
                    381:         $returnvalue = $student_answer;
                    382:     } else {
                    383:         if (exists($Answer{$prefix.'.shown'})) {
                    384:             # The response has foils
                    385:             my %values;
                    386:             while (my ($k,$v) = each(%Answer)) {
                    387:                 next if ($k !~ /^$prefix\.foil\.(value|area)\.(.*)$/);
                    388:                 my $foilname = $2;
                    389:                 $values{$foilname}=$v;
                    390:             }
                    391:             foreach my $foil (@{$Answer{$prefix.'.shown'}}) {
                    392:                 if (ref($values{$foil}) eq 'ARRAY') {
                    393:                     $returnvalue.=&HTML::Entities::encode($foil).'='.
                    394:                         join(',',map {&HTML::Entities::encode($_)} @{$values{$foil}}).'&';
                    395:                 } else {
                    396:                     $returnvalue.=&HTML::Entities::encode($foil).'='.
                    397:                         &HTML::Entities::encode($values{$foil}).'&';
                    398:                 }
                    399:             }
                    400:             $returnvalue =~ s/ /\%20/g;
                    401:             chop ($returnvalue);
                    402:         }
                    403:     }
                    404:     return $returnvalue;
                    405: }
                    406: 
                    407: 
                    408: ##
                    409: ## The following is copied from datecalc1.pl, part of the 
                    410: ## Spreadsheet::WriteExcel CPAN module.
                    411: ##
                    412: ##
                    413: ######################################################################
                    414: #
                    415: # Demonstration of writing date/time cells to Excel spreadsheets,
                    416: # using UNIX/Perl time as source of date/time.
                    417: #
                    418: # Copyright 2000, Andrew Benham, adsb@bigfoot.com
                    419: #
                    420: ######################################################################
                    421: #
                    422: # UNIX/Perl time is the time since the Epoch (00:00:00 GMT, 1 Jan 1970)
                    423: # measured in seconds.
                    424: #
                    425: # An Excel file can use exactly one of two different date/time systems.
                    426: # In these systems, a floating point number represents the number of days
                    427: # (and fractional parts of the day) since a start point. The floating point
                    428: # number is referred to as a 'serial'.
                    429: # The two systems ('1900' and '1904') use different starting points:
                    430: #  '1900'; '1.00' is 1 Jan 1900 BUT 1900 is erroneously regarded as
                    431: #          a leap year - see:
                    432: #            http://support.microsoft.com/support/kb/articles/Q181/3/70.asp
                    433: #          for the excuse^H^H^H^H^H^Hreason.
                    434: #  '1904'; '1.00' is 2 Jan 1904.
                    435: #
                    436: # The '1904' system is the default for Apple Macs. Windows versions of
                    437: # Excel have the option to use the '1904' system.
                    438: #
                    439: # Note that Visual Basic's "DateSerial" function does NOT erroneously
                    440: # regard 1900 as a leap year, and thus its serials do not agree with
                    441: # the 1900 serials of Excel for dates before 1 Mar 1900.
                    442: #
                    443: # Note that StarOffice (at least at version 5.2) does NOT erroneously
                    444: # regard 1900 as a leap year, and thus its serials do not agree with
                    445: # the 1900 serials of Excel for dates before 1 Mar 1900.
                    446: #
                    447: ######################################################################
                    448: #
                    449: # Calculation description
                    450: # =======================
                    451: #
                    452: # 1900 system
                    453: # -----------
                    454: # Unix time is '0' at 00:00:00 GMT 1 Jan 1970, i.e. 70 years after 1 Jan 1900.
                    455: # Of those 70 years, 17 (1904,08,12,16,20,24,28,32,36,40,44,48,52,56,60,64,68)
                    456: # were leap years with an extra day.
                    457: # Thus there were 17 + 70*365 days = 25567 days between 1 Jan 1900 and
                    458: # 1 Jan 1970.
                    459: # In the 1900 system, '1' is 1 Jan 1900, but as 1900 was not a leap year
                    460: # 1 Jan 1900 should really be '2', so 1 Jan 1970 is '25569'.
                    461: #
                    462: # 1904 system
                    463: # -----------
                    464: # Unix time is '0' at 00:00:00 GMT 1 Jan 1970, i.e. 66 years after 1 Jan 1904.
                    465: # Of those 66 years, 17 (1904,08,12,16,20,24,28,32,36,40,44,48,52,56,60,64,68)
                    466: # were leap years with an extra day.
                    467: # Thus there were 17 + 66*365 days = 24107 days between 1 Jan 1904 and
                    468: # 1 Jan 1970.
                    469: # In the 1904 system, 2 Jan 1904 being '1', 1 Jan 1970 is '24107'.
                    470: #
                    471: ######################################################################
                    472: #
                    473: # Copyright (c) 2000, Andrew Benham.
                    474: # This program is free software. It may be used, redistributed and/or
                    475: # modified under the same terms as Perl itself.
                    476: #
                    477: # Andrew Benham, adsb@bigfoot.com
                    478: # London, United Kingdom
                    479: # 11 Nov 2000
                    480: #
                    481: ######################################################################
                    482: #-----------------------------------------------------------
                    483: # calc_serial()
                    484: #
                    485: # Called with (up to) 2 parameters.
                    486: #   1.  Unix timestamp.  If omitted, uses current time.
                    487: #   2.  GMT flag. Set to '1' to return serial in GMT.
                    488: #       If omitted, returns serial in appropriate timezone.
                    489: #
                    490: # Returns date/time serial according to $DATE_SYSTEM selected
                    491: #-----------------------------------------------------------
                    492: sub calc_serial {
                    493:     # Use 1900 date system on all platforms other than Apple Mac (for which
                    494:     # use 1904 date system).
                    495:     my $DATE_SYSTEM = ($^O eq 'MacOS') ? 1 : 0;
                    496:     my $time = (defined $_[0]) ? $_[0] : time();
                    497:     my $gmtflag = (defined $_[1]) ? $_[1] : 0;
                    498:     #
                    499:     # Divide timestamp by number of seconds in a day.
                    500:     # This gives a date serial with '0' on 1 Jan 1970.
                    501:     my $serial = $time / 86400;
                    502:     #
                    503:     # Adjust the date serial by the offset appropriate to the
                    504:     # currently selected system (1900/1904).
                    505:     if ($DATE_SYSTEM == 0) {        # use 1900 system
                    506:         $serial += 25569;
                    507:     } else {                        # use 1904 system
                    508:         $serial += 24107;
                    509:     }
                    510:     #
                    511:     unless ($gmtflag) {
                    512:         # Now have a 'raw' serial with the right offset. But this
                    513:         # gives a serial in GMT, which is false unless the timezone
                    514:         # is GMT. We need to adjust the serial by the appropriate
                    515:         # timezone offset.
                    516:         # Calculate the appropriate timezone offset by seeing what
                    517:         # the differences between localtime and gmtime for the given
                    518:         # time are.
                    519:         #    
                    520:         my @gmtime = gmtime($time);
                    521:         my @ltime  = localtime($time);
                    522:         #
                    523:         # For the first 7 elements of the two arrays, adjust the
                    524:         # date serial where the elements differ.
                    525:         for (0 .. 6) {
                    526:             my $diff = $ltime[$_] - $gmtime[$_];
                    527:             if ($diff) {
                    528:                 $serial += _adjustment($diff,$_);
                    529:             }
                    530:         }
                    531:     }
                    532:     #
                    533:     # Perpetuate the error that 1900 was a leap year by decrementing
                    534:     # the serial if we're using the 1900 system and the date is prior to
                    535:     # 1 Mar 1900. This has the effect of making serial value '60'
                    536:     # 29 Feb 1900.
                    537:     #
                    538:     # This fix only has any effect if UNIX/Perl time on the platform
                    539:     # can represent 1900. Many can't.
                    540:     #
                    541:     unless ($DATE_SYSTEM) {
                    542:         $serial-- if ($serial < 61);    # '61' is 1 Mar 1900
                    543:     }
                    544:     return $serial;
                    545: }
                    546: 
                    547: sub _adjustment {
                    548:     # Based on the difference in the localtime/gmtime array elements
                    549:     # number, return the adjustment required to the serial.
                    550:     #
                    551:     # We only look at some elements of the localtime/gmtime arrays:
                    552:     #    seconds    unlikely to be different as all known timezones
                    553:     #               have an offset of integral multiples of 15 minutes,
                    554:     #               but it's easy to do.
                    555:     #    minutes    will be different for timezone offsets which are
                    556:     #               not an exact number of hours.
                    557:     #    hours      very likely to be different.
                    558:     #    weekday    will differ when localtime/gmtime difference
                    559:     #               straddles midnight.
                    560:     #
                    561:     # Assume that difference between localtime and gmtime is less than
                    562:     # 5 days, then don't have to do maths for day of month, month number,
                    563:     # year number, etc...
                    564:     #
                    565:     my ($delta,$element) = @_;
                    566:     my $adjust = 0;
                    567:     #
                    568:     if ($element == 0) {            # Seconds
                    569:         $adjust = $delta/86400;         # 60 * 60 * 24
                    570:     } elsif ($element == 1) {       # Minutes
                    571:         $adjust = $delta/1440;          # 60 * 24
                    572:     } elsif ($element == 2) {       # Hours
                    573:         $adjust = $delta/24;            # 24
                    574:     } elsif ($element == 6) {       # Day of week number
                    575:         # Catch difference straddling Sat/Sun in either direction
                    576:         $delta += 7 if ($delta < -4);
                    577:         $delta -= 7 if ($delta > 4);
                    578:         #    
                    579:         $adjust = $delta;
                    580:     }
                    581:     return $adjust;
                    582: }
                    583: 
                    584: ###########################################################
                    585: ###########################################################
                    586: 
                    587: =pod
                    588: 
                    589: =item get_problem_data
                    590: 
                    591: Returns a data structure describing the problem.
                    592: 
                    593: Inputs: $url
                    594: 
                    595: Returns: %Partdata
                    596: 
                    597: =cut
                    598: 
                    599: ## note: we must force each foil and option to not begin or end with
                    600: ##       spaces as they are stored without such data.
                    601: ##
                    602: ###########################################################
                    603: ###########################################################
                    604: sub get_problem_data {
                    605:     my ($url) = @_;
                    606:     my $Answ=&Apache::lonnet::ssi($url,('grade_target' => 'analyze'));
                    607:     (my $garbage,$Answ)=split(/_HASH_REF__/,$Answ,2);
                    608:     my %Answer;
                    609:     %Answer=&Apache::lonnet::str2hash($Answ);
                    610:     my %Partdata;
                    611:     foreach my $part (@{$Answer{'parts'}}) {
                    612:         while (my($key,$value) = each(%Answer)) {
                    613:             #
                    614:             # Logging code:
                    615:             if (1) {
                    616:                 &Apache::lonnet::logthis($part.' got key "'.$key.'"');
                    617:                 if (ref($value) eq 'ARRAY') {
                    618:                     &Apache::lonnet::logthis('    @'.join(',',@$value));
                    619:                 } else {
                    620:                     &Apache::lonnet::logthis('    '.$value);
                    621:                 }
                    622:             }
                    623:             # End of logging code
                    624:             next if ($key !~ /^$part/);
                    625:             $key =~ s/^$part\.//;
                    626:             if (ref($value) eq 'ARRAY') {
                    627:                 if ($key eq 'options') {
                    628:                     $Partdata{$part}->{'_Options'}=$value;
                    629:                 } elsif ($key eq 'concepts') {
                    630:                     $Partdata{$part}->{'_Concepts'}=$value;
                    631:                 } elsif ($key =~ /^concept\.(.*)$/) {
                    632:                     my $concept = $1;
                    633:                     foreach my $foil (@$value) {
                    634:                         $Partdata{$part}->{'_Foils'}->{$foil}->{'_Concept'}=
                    635:                                                                       $concept;
                    636:                     }
                    637:                 } elsif ($key =~ /^(incorrect|answer|ans_low|ans_high)$/) {
                    638:                     $Partdata{$part}->{$key}=$value;
                    639:                 }
                    640:             } else {
                    641:                 if ($key=~ /^foil\.text\.(.*)$/) {
                    642:                     my $foil = $1;
                    643:                     $Partdata{$part}->{'_Foils'}->{$foil}->{'name'}=$foil;
                    644:                     $value =~ s/(\s*$|^\s*)//g;
                    645:                     $Partdata{$part}->{'_Foils'}->{$foil}->{'text'}=$value;
                    646:                 } elsif ($key =~ /^foil\.value\.(.*)$/) {
                    647:                     my $foil = $1;
                    648:                     $Partdata{$part}->{'_Foils'}->{$foil}->{'value'}=$value;
                    649:                 }
                    650:             }
                    651:         }
                    652:     }
                    653:     return %Partdata;
1.5     ! matthew   654: }
        !           655: 
        !           656: ####################################################
        !           657: ####################################################
        !           658: 
        !           659: =pod
        !           660: 
        !           661: =item &limit_by_time()
        !           662: 
        !           663: =cut
        !           664: 
        !           665: ####################################################
        !           666: ####################################################
        !           667: sub limit_by_time_form {
        !           668:     my $Starttime_form = '';
        !           669:     my $starttime = &Apache::lonhtmlcommon::get_date_from_form
        !           670:         ('limitby_startdate');
        !           671:     my $endtime = &Apache::lonhtmlcommon::get_date_from_form
        !           672:         ('limitby_enddate');
        !           673:     if (! defined($endtime)) {
        !           674:         $endtime = time;
        !           675:     }
        !           676:     if (! defined($starttime)) {
        !           677:         $starttime = $endtime - 60*60*24*7;
        !           678:     }
        !           679:     my $state;
        !           680:     if (&limit_by_time()) {
        !           681:         $state = '';
        !           682:     } else {
        !           683:         $state = 'disabled';
        !           684:     }
        !           685:     my $startdateform = &Apache::lonhtmlcommon::date_setter
        !           686:         ('Statistics','limitby_startdate',$starttime,undef,undef,$state);
        !           687:     my $enddateform = &Apache::lonhtmlcommon::date_setter
        !           688:         ('Statistics','limitby_enddate',$endtime,undef,undef,$state);
        !           689:     my $Str;
        !           690:     $Str .= '<script language="Javascript" >';
        !           691:     $Str .= 'function toggle_limitby_activity(state) {';
        !           692:     $Str .= '    if (state) {';
        !           693:     $Str .= '        limitby_startdate_enable();';
        !           694:     $Str .= '        limitby_enddate_enable();';
        !           695:     $Str .= '    } else {';
        !           696:     $Str .= '        limitby_startdate_disable();';
        !           697:     $Str .= '        limitby_enddate_disable();';
        !           698:     $Str .= '    }';    
        !           699:     $Str .= '}';
        !           700:     $Str .= '</script>';
        !           701:     $Str .= '<fieldset>';
        !           702:     my $timecheckbox = '<input type="checkbox" name="limit_by_time" ';
        !           703:     if (&limit_by_time()) {
        !           704:         $timecheckbox .= ' checked ';
        !           705:     } 
        !           706:     $timecheckbox .= 'OnChange="javascript:toggle_limitby_activity(this.checked);" ';
        !           707:     $timecheckbox .= ' />';
        !           708:     $Str .= '<legend>'.&mt('[_1] Limit by time',$timecheckbox).'</legend>';
        !           709:     $Str .= &mt('Start Time: [_1]',$startdateform).'<br />';
        !           710:     $Str .= &mt('&nbsp;End Time: [_1]',$enddateform).'<br />';
        !           711:     $Str .= '</fieldset>';
        !           712:     return $Str;
        !           713: }
        !           714: 
        !           715: sub limit_by_time {
        !           716:     if (exists($ENV{'form.limit_by_time'}) &&
        !           717:         $ENV{'form.limit_by_time'} ne '' ) {
        !           718:         return 1;
        !           719:     } else {
        !           720:         return 0;
        !           721:     }
        !           722: }
        !           723: 
        !           724: sub get_time_limits {
        !           725:     my $starttime = &Apache::lonhtmlcommon::get_date_from_form
        !           726:         ('limitby_startdate');
        !           727:     my $endtime = &Apache::lonhtmlcommon::get_date_from_form
        !           728:         ('limitby_enddate');
        !           729:     return ($starttime,$endtime);
1.2       matthew   730: }
                    731: 
                    732: ####################################################
                    733: ####################################################
                    734: 
                    735: =pod
                    736: 
                    737: =back
                    738: 
                    739: =cut
                    740: 
                    741: ####################################################
                    742: ####################################################
1.1       matthew   743: 
                    744: 1;
                    745: 
                    746: __END__

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>