File:  [LON-CAPA] / loncom / metadata_database / LONCAPA / lonmetadata.pm
Revision 1.9: download - view: text, annotated - select for diffs
Fri Apr 23 20:30:07 2004 UTC (20 years, 3 months ago) by matthew
Branches: MAIN
CVS tags: version_1_1_99_0, HEAD
Added degree of discrimination to metadata storage.

    1: # The LearningOnline Network with CAPA
    2: #
    3: # $Id: lonmetadata.pm,v 1.9 2004/04/23 20:30:07 matthew Exp $
    4: #
    5: # Copyright Michigan State University Board of Trustees
    6: #
    7: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    8: #
    9: # LON-CAPA is free software; you can redistribute it and/or modify
   10: # it under the terms of the GNU General Public License as published by
   11: # the Free Software Foundation; either version 2 of the License, or
   12: # (at your option) any later version.
   13: #
   14: # LON-CAPA is distributed in the hope that it will be useful,
   15: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   16: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   17: # GNU General Public License for more details.
   18: #
   19: # You should have received a copy of the GNU General Public License
   20: # along with LON-CAPA; if not, write to the Free Software
   21: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   22: #
   23: # /home/httpd/html/adm/gpl.txt
   24: #
   25: # http://www.lon-capa.org/
   26: #
   27: ######################################################################
   28: 
   29: package LONCAPA::lonmetadata;
   30: 
   31: use strict;
   32: use DBI;
   33: 
   34: ######################################################################
   35: ######################################################################
   36: 
   37: =pod 
   38: 
   39: =head1 Name
   40: 
   41: lonmetadata
   42: 
   43: =head1 Synopsis
   44: 
   45: lonmetadata holds a description of the metadata table and provides
   46: wrappers for the storage and retrieval of metadata to/from the database.
   47: 
   48: =head1 Description
   49: 
   50: =head1 Methods
   51: 
   52: =over 4
   53: 
   54: =cut
   55: 
   56: ######################################################################
   57: ######################################################################
   58: 
   59: =pod
   60: 
   61: =item Old table creation command
   62: 
   63: CREATE TABLE IF NOT EXISTS metadata 
   64: (title TEXT, 
   65: author TEXT, 
   66: subject TEXT, 
   67: url TEXT, 
   68: keywords TEXT, 
   69: version TEXT, 
   70: notes TEXT, 
   71: abstract TEXT, 
   72: mime TEXT, 
   73: language TEXT, 
   74: creationdate DATETIME, 
   75: lastrevisiondate DATETIME, 
   76: owner TEXT, 
   77: copyright TEXT, 
   78: 
   79: FULLTEXT idx_title (title), 
   80: FULLTEXT idx_author (author), 
   81: FULLTEXT idx_subject (subject), 
   82: FULLTEXT idx_url (url), 
   83: FULLTEXT idx_keywords (keywords), 
   84: FULLTEXT idx_version (version), 
   85: FULLTEXT idx_notes (notes), 
   86: FULLTEXT idx_abstract (abstract), 
   87: FULLTEXT idx_mime (mime), 
   88: FULLTEXT idx_language (language),
   89: FULLTEXT idx_owner (owner), 
   90: FULLTEXT idx_copyright (copyright)) 
   91: 
   92: TYPE=MYISAM;
   93: 
   94: =cut
   95: 
   96: ######################################################################
   97: ######################################################################
   98: my @Metadata_Table_Description = 
   99:     (
  100:      { name => 'title',     type=>'TEXT'},
  101:      { name => 'author',    type=>'TEXT'},
  102:      { name => 'subject',   type=>'TEXT'},
  103:      { name => 'url',       type=>'TEXT', restrictions => 'NOT NULL' },
  104:      { name => 'keywords',  type=>'TEXT'},
  105:      { name => 'version',   type=>'TEXT'},
  106:      { name => 'notes',     type=>'TEXT'},
  107:      { name => 'abstract',  type=>'TEXT'},
  108:      { name => 'mime',      type=>'TEXT'},
  109:      { name => 'language',  type=>'TEXT'},
  110:      { name => 'creationdate',     type=>'DATETIME'},
  111:      { name => 'lastrevisiondate', type=>'DATETIME'},
  112:      { name => 'owner',     type=>'TEXT'},
  113:      { name => 'copyright', type=>'TEXT'}, 
  114:       #--------------------------------------------------
  115:      { name => 'dependencies',   type=>'TEXT'},
  116:      { name => 'modifyinguser',  type=>'TEXT'},
  117:      { name => 'authorspace',    type=>'TEXT'},
  118:      { name => 'lowestgradelevel',  type=>'INT'},
  119:      { name => 'highestgradelevel', type=>'INT'},
  120:      { name => 'standards',      type=>'TEXT'},
  121:      { name => 'count',          type=>'INT'},
  122:      { name => 'course',         type=>'INT'},
  123:      { name => 'course_list',    type=>'TEXT'},
  124:      { name => 'goto',           type=>'INT'},
  125:      { name => 'goto_list',      type=>'TEXT'},
  126:      { name => 'comefrom',       type=>'INT'},
  127:      { name => 'comefrom_list',  type=>'TEXT'},
  128:      { name => 'sequsage',       type=>'INT'},
  129:      { name => 'sequsage_list',  type=>'TEXT'},
  130:      { name => 'stdno',          type=>'INT'},
  131:      { name => 'stdno_list',     type=>'TEXT'},
  132:      { name => 'avetries',       type=>'FLOAT'},
  133:      { name => 'avetries_list',  type=>'TEXT'},
  134:      { name => 'difficulty',     type=>'FLOAT'},
  135:      { name => 'difficulty_list',type=>'TEXT'},
  136:      { name => 'disc',           type=>'FLOAT'},
  137:      { name => 'disc_list',      type=>'TEXT'},
  138:      { name => 'clear',          type=>'FLOAT'},
  139:      { name => 'technical',      type=>'FLOAT'},
  140:      { name => 'correct',        type=>'FLOAT'},
  141:      { name => 'helpful',        type=>'FLOAT'},
  142:      { name => 'depth',          type=>'FLOAT'},
  143:      { name => 'hostname',       type=> 'TEXT'},
  144:      #--------------------------------------------------
  145:      );
  146: 
  147: my @Fulltext_indicies = qw/
  148:     title
  149:     author
  150:     subject
  151:     url
  152:     keywords
  153:     version
  154:     notes
  155:     abstract
  156:     mime
  157:     language
  158:     owner
  159:     copyright/;
  160: 
  161: ######################################################################
  162: ######################################################################
  163: 
  164: =pod
  165: 
  166: =item &describe_metadata_storage
  167: 
  168: Input: None
  169: 
  170: Returns: An array of hash references describing the columns and indicies
  171: of the metadata table(s).
  172: 
  173: =cut
  174: 
  175: ######################################################################
  176: ######################################################################
  177: sub describe_metadata_storage { 
  178:     return (\@Metadata_Table_Description,\@Fulltext_indicies);
  179: }
  180: 
  181: ######################################################################
  182: ######################################################################
  183: 
  184: =pod
  185: 
  186: =item create_metadata_storage()
  187: 
  188: Inputs: table name (optional): the name of the table.  Default is 'metadata'.
  189: 
  190: Returns: A perl string which, when executed by MySQL, will cause the
  191: metadata storage to be initialized.
  192: 
  193: =cut
  194: 
  195: ######################################################################
  196: ######################################################################
  197: sub create_metadata_storage { 
  198:     my ($tablename) = @_;
  199:     $tablename = 'metadata' if (! defined($tablename));
  200:     my $request = "CREATE TABLE IF NOT EXISTS ".$tablename." ";
  201:     #
  202:     # Process the columns  (this code is stolen from lonmysql.pm)
  203:     my @Columns;
  204:     my $col_des; # mysql column description
  205:     foreach my $coldata (@Metadata_Table_Description) {
  206:         my $column = $coldata->{'name'};
  207:         $col_des = '';
  208:         if (lc($coldata->{'type'}) =~ /(enum|set)/) { # 'enum' or 'set'
  209:             $col_des.=$column." ".$coldata->{'type'}."('".
  210:                 join("', '",@{$coldata->{'values'}})."')";
  211:         } else {
  212:             $col_des.=$column." ".$coldata->{'type'};
  213:             if (exists($coldata->{'size'})) {
  214:                 $col_des.="(".$coldata->{'size'}.")";
  215:             }
  216:         }
  217:         # Modifiers
  218:         if (exists($coldata->{'restrictions'})){
  219:             $col_des.=" ".$coldata->{'restrictions'};
  220:         }
  221:         if (exists($coldata->{'default'})) {
  222:             $col_des.=" DEFAULT '".$coldata->{'default'}."'";
  223:         }
  224:         $col_des.=' AUTO_INCREMENT' if (exists($coldata->{'auto_inc'}) &&
  225:                                         ($coldata->{'auto_inc'} eq 'yes'));
  226:         $col_des.=' PRIMARY KEY'    if (exists($coldata->{'primary_key'}) &&
  227:                                         ($coldata->{'primary_key'} eq 'yes'));
  228:     } continue {
  229:         # skip blank items.
  230:         push (@Columns,$col_des) if ($col_des ne '');
  231:     }
  232:     foreach my $colname (@Fulltext_indicies) {
  233:         my $text = 'FULLTEXT idx_'.$colname.' ('.$colname.')';
  234:         push (@Columns,$text);
  235:     }
  236:     $request .= "(".join(", ",@Columns).") TYPE=MyISAM";
  237:     return $request;
  238: }
  239: 
  240: ######################################################################
  241: ######################################################################
  242: 
  243: =pod
  244: 
  245: =item store_metadata()
  246: 
  247: Inputs: database handle ($dbh), a table name, and a hash or hash reference 
  248: containing the metadata for a single resource.
  249: 
  250: Returns: 1 on success, 0 on failure to store.
  251: 
  252: =cut
  253: 
  254: ######################################################################
  255: ######################################################################
  256: {
  257:     ##
  258:     ##  WARNING: The following cleverness may cause trouble in cases where
  259:     ##  the dbi connection is dropped and recreated - a stale statement
  260:     ##  handler may linger around and cause trouble.
  261:     ##
  262:     ##  In most scripts, this will work fine.  If the dbi is going to be
  263:     ##  dropped and (possibly) later recreated, call &clear_sth.  Yes it
  264:     ##  is annoying but $sth appearantly does not have a link back to the 
  265:     ##  $dbh, so we can't check our validity.
  266:     ##
  267:     my $sth = undef;
  268:     my $sth_table = undef;
  269: 
  270: sub create_statement_handler {
  271:     my $dbh = shift();
  272:     my $tablename = shift();
  273:     $tablename = 'metadata' if (! defined($tablename));
  274:     $sth_table = $tablename;
  275:     my $request = 'INSERT INTO '.$tablename.' VALUES(';
  276:     foreach (@Metadata_Table_Description) {
  277:         $request .= '?,';
  278:     }
  279:     chop $request;
  280:     $request.= ')';
  281:     $sth = $dbh->prepare($request);
  282:     return;
  283: }
  284: 
  285: sub clear_sth { $sth=undef; $sth_table=undef;}
  286: 
  287: sub store_metadata {
  288:     my $dbh = shift();
  289:     my $tablename = shift();
  290:     my $errors = '';
  291:     if (! defined($sth) || 
  292:         ( defined($tablename) && ($sth_table ne $tablename)) || 
  293:         (! defined($tablename) && $sth_table ne 'metadata')) {
  294:         &create_statement_handler($dbh,$tablename);
  295:     }
  296:     my $successcount = 0;
  297:     while (my $mdata = shift()) {
  298:         next if (ref($mdata) ne "HASH");
  299:         my @MData;
  300:         foreach my $field (@Metadata_Table_Description) {
  301:             if (exists($mdata->{$field->{'name'}})) {
  302:                 if ($mdata->{$field->{'name'}} eq 'nan') {
  303:                     push(@MData,'NULL');
  304:                 } else {
  305:                     push(@MData,$mdata->{$field->{'name'}});
  306:                 }
  307:             } else {
  308:                 push(@MData,undef);
  309:             }
  310:         }
  311:         $sth->execute(@MData);
  312:         if (! $sth->err) {
  313:             $successcount++;
  314:         } else {
  315:             $errors = join(',',$errors,$sth->errstr);
  316:         }
  317:     }
  318:     if (wantarray()) {
  319:         return ($successcount,$errors);
  320:     } else {
  321:         return $successcount;
  322:     }
  323: }
  324: 
  325: }
  326: 
  327: ######################################################################
  328: ######################################################################
  329: 
  330: =pod
  331: 
  332: =item lookup_metadata()
  333: 
  334: Inputs: database handle ($dbh) and a hash or hash reference containing 
  335: metadata which will be used for a search.
  336: 
  337: Returns: scalar with error string on failure, array reference on success.
  338: The array reference is the same one returned by $sth->fetchall_arrayref().
  339: 
  340: =cut
  341: 
  342: ######################################################################
  343: ######################################################################
  344: sub lookup_metadata {
  345:     my ($dbh,$condition,$fetchparameter) = @_;
  346:     my $error;
  347:     my $returnvalue=[];
  348:     my $request = 'SELECT * FROM metadata';
  349:     if (defined($condition)) {
  350:         $request .= ' WHERE '.$condition;
  351:     }
  352:     my $sth = $dbh->prepare($request);
  353:     if ($sth->err) {
  354:         $error = $sth->errstr;
  355:     }
  356:     if (! $error) {
  357:         $sth->execute();
  358:         if ($sth->err) {
  359:             $error = $sth->errstr;
  360:         } else {
  361:             $returnvalue = $sth->fetchall_arrayref($fetchparameter);
  362:             if ($sth->err) {
  363:                 $error = $sth->errstr;
  364:             }
  365:         }
  366:     }
  367:     return ($error,$returnvalue);
  368: }
  369: 
  370: ######################################################################
  371: ######################################################################
  372: 
  373: =pod
  374: 
  375: =item delete_metadata()
  376: 
  377: Not implemented yet
  378: 
  379: =cut
  380: 
  381: ######################################################################
  382: ######################################################################
  383: sub delete_metadata {}
  384: 
  385: ######################################################################
  386: ######################################################################
  387: 
  388: =pod
  389: 
  390: =item metdata_col_to_hash
  391: 
  392: Input: Array of metadata columns
  393: 
  394: Return: Hash with the metadata columns as keys and the array elements
  395: passed in as values
  396: 
  397: =cut
  398: 
  399: ######################################################################
  400: ######################################################################
  401: sub metadata_col_to_hash {
  402:     my @cols=@_;
  403:     my %hash=();
  404:     for (my $i=0; $i<=$#Metadata_Table_Description;$i++) {
  405:         $hash{$Metadata_Table_Description[$i]->{'name'}}=$cols[$i];
  406:     }
  407:     return %hash;
  408: }
  409: 
  410: ######################################################################
  411: ######################################################################
  412: 
  413: =pod
  414: 
  415: =item nohist_resevaldata.db data structure
  416: 
  417: The nohist_resevaldata.db file has the following possible keys:
  418: 
  419:  Statistics Data (values are integers, perl times, or real numbers)
  420:  ------------------------------------------
  421:  $course___$resource___avetries
  422:  $course___$resource___count
  423:  $course___$resource___difficulty
  424:  $course___$resource___stdno
  425:  $course___$resource___timestamp
  426: 
  427:  Evaluation Data (values are on a 1 to 5 scale)
  428:  ------------------------------------------
  429:  $username@$dom___$resource___clear
  430:  $username@$dom___$resource___comments
  431:  $username@$dom___$resource___depth
  432:  $username@$dom___$resource___technical
  433:  $username@$dom___$resource___helpful
  434: 
  435:  Course Context Data
  436:  ------------------------------------------
  437:  $course___$resource___course       course id
  438:  $course___$resource___comefrom     resource preceeding this resource
  439:  $course___$resource___goto         resource following this resource
  440:  $course___$resource___usage        resource containing this resource
  441: 
  442:  New statistical data storage
  443:  ------------------------------------------
  444:  $course&$sec&$numstud___$resource___stats
  445:     $sec is a string describing the sections: all, 1 2, 1 2 3,...
  446:     Value is a '&' deliminated list of key=value pairs.
  447:     Possible keys are (currently) disc,course,sections,difficulty, 
  448:     stdno, timestamp
  449: 
  450: =cut
  451: 
  452: ######################################################################
  453: ######################################################################
  454: 
  455: =pod
  456: 
  457: =item &process_reseval_data 
  458: 
  459: Process a nohist_resevaldata hash into a more complex data structure.
  460: 
  461: Input: Hash reference containing reseval data
  462: 
  463: Returns: Hash with the following structure:
  464: 
  465: $hash{$url}->{'statistics'}->{$courseid}->{'avetries'}   = $value
  466: $hash{$url}->{'statistics'}->{$courseid}->{'count'}      = $value
  467: $hash{$url}->{'statistics'}->{$courseid}->{'difficulty'} = $value
  468: $hash{$url}->{'statistics'}->{$courseid}->{'stdno'}      = $value
  469: $hash{$url}->{'statistics'}->{$courseid}->{'timestamp'}  = $value
  470: 
  471: $hash{$url}->{'evaluation'}->{$username}->{'clear'}     = $value
  472: $hash{$url}->{'evaluation'}->{$username}->{'comments'}  = $value
  473: $hash{$url}->{'evaluation'}->{$username}->{'depth'}     = $value
  474: $hash{$url}->{'evaluation'}->{$username}->{'technical'} = $value
  475: $hash{$url}->{'evaluation'}->{$username}->{'helpful'}   = $value
  476: 
  477: $hash{$url}->{'course'}    = \@Courses
  478: $hash{$url}->{'comefrom'}  = \@Resources
  479: $hash{$url}->{'goto'}      = \@Resources
  480: $hash{$url}->{'usage'}     = \@Resources
  481: 
  482: $hash{$url}->{'stats'}->{$courseid\_$section}->{$key} = $value
  483: 
  484: =cut
  485: 
  486: ######################################################################
  487: ######################################################################
  488: sub process_reseval_data {
  489:     my ($evaldata) = @_;
  490:     my %DynamicData;
  491:     #
  492:     # Process every stored element
  493:     while (my ($storedkey,$value) = each(%{$evaldata})) {
  494:         my ($source,$file,$type) = split('___',$storedkey);
  495:         $source = &unescape($source);
  496:         $file = &unescape($file);
  497:         $value = &unescape($value);
  498:          "    got ".$file."\n        ".$type." ".$source."\n";
  499:         if ($type =~ /^(avetries|count|difficulty|stdno|timestamp)$/) {
  500:             #
  501:             # Statistics: $source is course id
  502:             $DynamicData{$file}->{'statistics'}->{$source}->{$type}=$value;
  503:         } elsif ($type =~ /^(clear|comments|depth|technical|helpful)$/){
  504:             #
  505:             # Evaluation $source is username, check if they evaluated it
  506:             # more than once.  If so, pad the entry with a space.
  507:             while(exists($DynamicData{$file}->{'evaluation'}->{$type}->{$source})) {
  508:                 $source .= ' ';
  509:             }
  510:             $DynamicData{$file}->{'evaluation'}->{$type}->{$source}=$value;
  511:         } elsif ($type =~ /^(course|comefrom|goto|usage)$/) {
  512:             #
  513:             # Context $source is course id or resource
  514:             push(@{$DynamicData{$file}->{$type}},&unescape($source));
  515:         } elsif ($type eq 'stats') {
  516:             #
  517:             # Statistics storage...
  518:             # $source is $cid\_$sec\_$stdno
  519:             # $value is stat1=value&stat2=value&stat3=value,....
  520:             #
  521:             my ($cid,$sec,$stdno)=split('&',$source);
  522:             my $crssec = $cid.'&'.$sec;
  523:             my @Data = split('&',$value);
  524:             my %Statistics;
  525:             while (my ($key,$value) = split('=',pop(@Data))) {
  526:                 $Statistics{$key} = $value;
  527:             }
  528:             $sec =~ s:("$|^")::g;
  529:             $Statistics{'sections'} = $sec;
  530:             #
  531:             # Only store the data if the number of students is greater
  532:             # than the data already stored
  533:             if (! exists($DynamicData{$file}->{'stats'}->{$crssec}) ||
  534:                 $DynamicData{$file}->{'stats'}->{$crssec}->{'stdno'}<$stdno){
  535:                 $DynamicData{$file}->{'stats'}->{$crssec}=\%Statistics;
  536:             }
  537:         }
  538:     }
  539:     return %DynamicData;
  540: }
  541: 
  542: 
  543: ######################################################################
  544: ######################################################################
  545: 
  546: =pod
  547: 
  548: =item &process_dynamic_metadata
  549: 
  550: Inputs: $url: the url of the item to process
  551: $DynamicData: hash reference for the results of &process_reseval_data
  552: 
  553: Returns: Hash containing the following keys:
  554:     avetries, avetries_list, difficulty, difficulty_list, stdno, stdno_list,
  555:     course, course_list, goto, goto_list, comefrom, comefrom_list,
  556:     usage, clear, technical, correct, helpful, depth, comments
  557: 
  558:     Each of the return keys is associated with either a number or a string
  559:     The *_list items are comma-seperated strings.  'comments' is a string
  560:     containing generically marked-up comments.
  561: 
  562: =cut
  563: 
  564: ######################################################################
  565: ######################################################################
  566: sub process_dynamic_metadata {
  567:     my ($url,$DynamicData) = @_;
  568:     my %data;
  569:     my $resdata = $DynamicData->{$url};
  570:     #
  571:     # Get the statistical data - Use a weighted average
  572:     foreach my $type (qw/avetries difficulty disc/) {
  573:         my $studentcount;
  574:         my $sum;
  575:         my @Values;
  576:         my @Students;
  577:         #
  578:         # Old data
  579:         foreach my $coursedata (values(%{$resdata->{'statistics'}}),
  580:                                 values(%{$resdata->{'stats'}})) {
  581:             if (ref($coursedata) eq 'HASH' && exists($coursedata->{$type})) {
  582:                 $studentcount += $coursedata->{'stdno'};
  583:                 $sum += ($coursedata->{$type}*$coursedata->{'stdno'});
  584:                 push(@Values,$coursedata->{$type});
  585:                 push(@Students,$coursedata->{'stdno'});
  586:             }
  587:         }
  588:         if (exists($resdata->{'stats'})) {
  589:             foreach my $identifier (sort(keys(%{$resdata->{'stats'}}))) {
  590:                 my $coursedata = $resdata->{'stats'}->{$identifier};
  591:                 $studentcount += $coursedata->{'stdno'};
  592:                 $sum += $coursedata->{$type}*$coursedata->{'stdno'};
  593:                 push(@Values,$coursedata->{$type});                
  594:                 push(@Students,$coursedata->{'stdno'});
  595:             }
  596:         }
  597:         #
  598:         # New data
  599:         if (defined($studentcount) && $studentcount>0) {
  600:             $data{$type} = $sum/$studentcount;
  601:             $data{$type.'_list'} = join(',',@Values);
  602:         }
  603:     }
  604:     #
  605:     # Find out the number of students who have completed the resource...
  606:     my $stdno;
  607:     foreach my $coursedata (values(%{$resdata->{'statistics'}}),
  608:                             values(%{$resdata->{'stats'}})) {
  609:         if (ref($coursedata) eq 'HASH' && exists($coursedata->{'stdno'})) {
  610:             $stdno += $coursedata->{'stdno'};
  611:         }
  612:     }
  613:     if (exists($resdata->{'stats'})) {
  614:         #
  615:         # For the number of students, take the maximum found for the class
  616:         my $current_course;
  617:         my $coursemax=0;
  618:         foreach my $identifier (sort(keys(%{$resdata->{'stats'}}))) {
  619:             my $coursedata = $resdata->{'stats'}->{$identifier};
  620:             if (! defined($current_course)) {
  621:                 $current_course = $coursedata->{'course'};
  622:             }
  623:             if ($current_course ne $coursedata->{'course'}) {
  624:                 $stdno += $coursemax;
  625:                 $coursemax = 0;
  626:                 $current_course = $coursedata->{'course'};                
  627:             }
  628:             if ($coursemax < $coursedata->{'stdno'}) {
  629:                 $coursemax = $coursedata->{'stdno'};
  630:             }
  631:         }
  632:         $stdno += $coursemax; # pick up the final course in the list
  633:     }
  634:     $data{'stdno'}=$stdno;
  635:     #
  636:     # Get the context data
  637:     foreach my $type (qw/course goto comefrom/) {
  638:         if (defined($resdata->{$type}) && 
  639:             ref($resdata->{$type}) eq 'ARRAY') {
  640:             $data{$type} = scalar(@{$resdata->{$type}});
  641:             $data{$type.'_list'} = join(',',@{$resdata->{$type}});
  642:         }
  643:     }
  644:     if (defined($resdata->{'usage'}) && 
  645:         ref($resdata->{'usage'}) eq 'ARRAY') {
  646:         $data{'sequsage'} = scalar(@{$resdata->{'usage'}});
  647:         $data{'sequsage_list'} = join(',',@{$resdata->{'usage'}});
  648:     }
  649:     #
  650:     # Get the evaluation data
  651:     foreach my $type (qw/clear technical correct helpful depth/) {
  652:         my $count;
  653:         my $sum;
  654:         foreach my $evaluator (keys(%{$resdata->{'evaluation'}->{$type}})){
  655:             $sum += $resdata->{'evaluation'}->{$type}->{$evaluator};
  656:             $count++;
  657:         }
  658:         if ($count > 0) {
  659:             $data{$type}=$sum/$count;
  660:         }
  661:     }
  662:     #
  663:     # put together comments
  664:     my $comments = '<div class="LCevalcomments">';
  665:     foreach my $evaluator (keys(%{$resdata->{'evaluation'}->{'comments'}})){
  666:         $comments .= 
  667:             '<p>'.
  668:             '<b>'.$evaluator.'</b>:'.
  669:             $resdata->{'evaluation'}->{'comments'}->{$evaluator}.
  670:             '</p>';
  671:     }
  672:     $comments .= '</div>';
  673:     $data{'comments'} = $comments;
  674:     #
  675:     if (exists($resdata->{'stats'})) {
  676:         $data{'stats'} = $resdata->{'stats'};
  677:     }
  678:     #
  679:     return %data;
  680: }
  681: 
  682: sub dynamic_metadata_storage {
  683:     my ($data) = @_;
  684:     my %Store;
  685:     my $courseid = $data->{'course'};
  686:     my $sections = $data->{'sections'};
  687:     my $numstu = $data->{'num_students'};
  688:     my $urlres = $data->{'urlres'};
  689:     my $key = $courseid.'&'.$sections.'&'.$numstu.'___'.$urlres.'___stats';
  690:     $Store{$key} =
  691:         'course='.$courseid.'&'.
  692:         'sections='.$sections.'&'.
  693:         'timestamp='.time.'&'.
  694:         'stdno='.$data->{'num_students'}.'&'.
  695:         'avetries='.$data->{'mean_tries'}.'&'.
  696:         'difficulty='.$data->{'deg_of_diff'};
  697:     if (exists($data->{'deg_of_disc'})) {
  698:         $Store{$key} .= '&'.'disc='.$data->{'deg_of_disc'};
  699:     }
  700:     return %Store;
  701: }
  702: 
  703: ######################################################################
  704: ######################################################################
  705: ##
  706: ## The usual suspects, repeated here to reduce dependency hell
  707: ##
  708: ######################################################################
  709: ######################################################################
  710: sub unescape {
  711:     my $str=shift;
  712:     $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
  713:     return $str;
  714: }
  715: 
  716: sub escape {
  717:     my $str=shift;
  718:     $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
  719:     return $str;
  720: }
  721: 
  722: 
  723: 
  724: 
  725: 1;
  726: 
  727: __END__;
  728: 
  729: =pod
  730: 
  731: =back
  732: 
  733: =cut

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