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

1.1       matthew     1: # The LearningOnline Network with CAPA
                      2: #
1.4     ! matthew     3: # $Id: lonstathelpers.pm,v 1.3 2004/02/13 18:34:40 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> ';
                    148:                         if ($partdata->{'option'} > 1) {
                    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.2       matthew   654: }
                    655: 
                    656: ####################################################
                    657: ####################################################
                    658: 
                    659: =pod
                    660: 
                    661: =back
                    662: 
                    663: =cut
                    664: 
                    665: ####################################################
                    666: ####################################################
1.1       matthew   667: 
                    668: 1;
                    669: 
                    670: __END__

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