Annotation of loncom/metadata_database/LONCAPA/lonmetadata.pm, revision 1.15

1.1       matthew     1: # The LearningOnline Network with CAPA
                      2: #
1.15    ! raeburn     3: # $Id: lonmetadata.pm,v 1.14 2006/09/26 15:15:31 raeburn 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: package LONCAPA::lonmetadata;
                     30: 
                     31: use strict;
                     32: use DBI;
1.14      raeburn    33: use vars qw($Metadata_Table_Description $Portfolio_metadata_table_description 
                     34: $Portfolio_access_table_description $Fulltext_indicies $Portfolio_metadata_indices $Portfolio_access_indices $Portfolio_addedfields_table_description $Portfolio_addedfields_indices);
1.1       matthew    35: 
                     36: ######################################################################
                     37: ######################################################################
                     38: 
                     39: =pod 
                     40: 
                     41: =head1 Name
                     42: 
                     43: lonmetadata
                     44: 
                     45: =head1 Synopsis
                     46: 
                     47: lonmetadata holds a description of the metadata table and provides
                     48: wrappers for the storage and retrieval of metadata to/from the database.
                     49: 
                     50: =head1 Description
                     51: 
                     52: =head1 Methods
                     53: 
                     54: =over 4
                     55: 
                     56: =cut
                     57: 
                     58: ######################################################################
                     59: ######################################################################
                     60: 
                     61: =pod
                     62: 
                     63: =item Old table creation command
                     64: 
                     65: CREATE TABLE IF NOT EXISTS metadata 
                     66: (title TEXT, 
                     67: author TEXT, 
                     68: subject TEXT, 
                     69: url TEXT, 
                     70: keywords TEXT, 
                     71: version TEXT, 
                     72: notes TEXT, 
                     73: abstract TEXT, 
                     74: mime TEXT, 
                     75: language TEXT, 
                     76: creationdate DATETIME, 
                     77: lastrevisiondate DATETIME, 
                     78: owner TEXT, 
                     79: copyright TEXT, 
1.12      matthew    80: domain TEXT
1.1       matthew    81: 
                     82: FULLTEXT idx_title (title), 
                     83: FULLTEXT idx_author (author), 
                     84: FULLTEXT idx_subject (subject), 
                     85: FULLTEXT idx_url (url), 
                     86: FULLTEXT idx_keywords (keywords), 
                     87: FULLTEXT idx_version (version), 
                     88: FULLTEXT idx_notes (notes), 
                     89: FULLTEXT idx_abstract (abstract), 
                     90: FULLTEXT idx_mime (mime), 
                     91: FULLTEXT idx_language (language),
                     92: FULLTEXT idx_owner (owner), 
                     93: FULLTEXT idx_copyright (copyright)) 
                     94: 
                     95: TYPE=MYISAM;
                     96: 
                     97: =cut
                     98: 
                     99: ######################################################################
                    100: ######################################################################
1.14      raeburn   101: $Metadata_Table_Description = 
                    102:     [
1.1       matthew   103:      { name => 'title',     type=>'TEXT'},
                    104:      { name => 'author',    type=>'TEXT'},
                    105:      { name => 'subject',   type=>'TEXT'},
                    106:      { name => 'url',       type=>'TEXT', restrictions => 'NOT NULL' },
                    107:      { name => 'keywords',  type=>'TEXT'},
                    108:      { name => 'version',   type=>'TEXT'},
                    109:      { name => 'notes',     type=>'TEXT'},
                    110:      { name => 'abstract',  type=>'TEXT'},
                    111:      { name => 'mime',      type=>'TEXT'},
                    112:      { name => 'language',  type=>'TEXT'},
                    113:      { name => 'creationdate',     type=>'DATETIME'},
                    114:      { name => 'lastrevisiondate', type=>'DATETIME'},
                    115:      { name => 'owner',     type=>'TEXT'},
                    116:      { name => 'copyright', type=>'TEXT'}, 
1.12      matthew   117:      { name => 'domain',    type=>'TEXT'},
1.1       matthew   118:       #--------------------------------------------------
                    119:      { name => 'dependencies',   type=>'TEXT'},
                    120:      { name => 'modifyinguser',  type=>'TEXT'},
                    121:      { name => 'authorspace',    type=>'TEXT'},
                    122:      { name => 'lowestgradelevel',  type=>'INT'},
                    123:      { name => 'highestgradelevel', type=>'INT'},
                    124:      { name => 'standards',      type=>'TEXT'},
                    125:      { name => 'count',          type=>'INT'},
                    126:      { name => 'course',         type=>'INT'},
                    127:      { name => 'course_list',    type=>'TEXT'},
                    128:      { name => 'goto',           type=>'INT'},
                    129:      { name => 'goto_list',      type=>'TEXT'},
                    130:      { name => 'comefrom',       type=>'INT'},
                    131:      { name => 'comefrom_list',  type=>'TEXT'},
                    132:      { name => 'sequsage',       type=>'INT'},
                    133:      { name => 'sequsage_list',  type=>'TEXT'},
                    134:      { name => 'stdno',          type=>'INT'},
                    135:      { name => 'stdno_list',     type=>'TEXT'},
                    136:      { name => 'avetries',       type=>'FLOAT'},
                    137:      { name => 'avetries_list',  type=>'TEXT'},
                    138:      { name => 'difficulty',     type=>'FLOAT'},
                    139:      { name => 'difficulty_list',type=>'TEXT'},
1.9       matthew   140:      { name => 'disc',           type=>'FLOAT'},
                    141:      { name => 'disc_list',      type=>'TEXT'},
1.1       matthew   142:      { name => 'clear',          type=>'FLOAT'},
                    143:      { name => 'technical',      type=>'FLOAT'},
                    144:      { name => 'correct',        type=>'FLOAT'},
                    145:      { name => 'helpful',        type=>'FLOAT'},
                    146:      { name => 'depth',          type=>'FLOAT'},
                    147:      { name => 'hostname',       type=> 'TEXT'},
                    148:      #--------------------------------------------------
1.14      raeburn   149:     ];
1.1       matthew   150: 
1.14      raeburn   151: $Fulltext_indicies = [ qw/ 
1.1       matthew   152:     title
                    153:     author
                    154:     subject
                    155:     url
                    156:     keywords
                    157:     version
                    158:     notes
                    159:     abstract
                    160:     mime
                    161:     language
                    162:     owner
1.14      raeburn   163:     copyright/ ];
                    164: 
                    165: ######################################################################
                    166: ######################################################################
                    167: $Portfolio_metadata_table_description =
                    168:     [
                    169:      { name => 'title',     type=>'TEXT'},
                    170:      { name => 'author',    type=>'TEXT'},
                    171:      { name => 'subject',   type=>'TEXT'},
                    172:      { name => 'url',       type=>'TEXT', restrictions => 'NOT NULL' },
                    173:      { name => 'keywords',  type=>'TEXT'},
                    174:      { name => 'version',   type=>'TEXT'},
                    175:      { name => 'notes',     type=>'TEXT'},
                    176:      { name => 'abstract',  type=>'TEXT'},
                    177:      { name => 'mime',      type=>'TEXT'},
                    178:      { name => 'language',  type=>'TEXT'},
                    179:      { name => 'creationdate',     type=>'DATETIME'},
                    180:      { name => 'lastrevisiondate', type=>'DATETIME'},
                    181:      { name => 'owner',     type=>'TEXT'},
                    182:      { name => 'copyright',     type=>'TEXT'},
                    183:      { name => 'domain',    type=>'TEXT'},
                    184:      { name => 'groupname',     type=>'TEXT'},
                    185:      { name => 'courserestricted', type=>'TEXT'},
                    186:      { name => 'addedfieldnames',  type=>'TEXT'},
                    187:      { name => 'addedfieldvalues', type=>'TEXT'},
                    188:       #--------------------------------------------------
                    189:      { name => 'dependencies',   type=>'TEXT'},
                    190:      { name => 'modifyinguser',  type=>'TEXT'},
                    191:      { name => 'authorspace',    type=>'TEXT'},
                    192:      { name => 'lowestgradelevel',  type=>'INT'},
                    193:      { name => 'highestgradelevel', type=>'INT'},
                    194:      { name => 'standards',      type=>'TEXT'},
                    195:      { name => 'hostname',       type=> 'TEXT'},
                    196:      #--------------------------------------------------
                    197:    ];
                    198: 
                    199: $Portfolio_metadata_indices = [qw/
                    200:     title
                    201:     author
                    202:     subject
                    203:     url
                    204:     keywords
                    205:     version
                    206:     notes
                    207:     abstract
                    208:     mime
                    209:     language
                    210:     owner/];
                    211: 
                    212: ######################################################################
                    213: ######################################################################
                    214: 
                    215: $Portfolio_access_table_description =
                    216:     [
                    217:      { name => 'url',   type=>'TEXT', restrictions => 'NOT NULL' },
                    218:      { name => 'keynum', type=>'TEXT', restrictions => 'NOT NULL' },
                    219:      { name => 'scope', type=>'TEXT'},
                    220:      { name => 'start', type=>'DATETIME'},
                    221:      { name => 'end',   type=>'DATETIME'},
                    222:    ];
                    223: 
                    224: $Portfolio_access_indices = [qw/
                    225:     url
                    226:     keynum
                    227:     scope
                    228:     start
                    229:     end/];
1.1       matthew   230: 
                    231: ######################################################################
                    232: ######################################################################
                    233: 
1.14      raeburn   234: $Portfolio_addedfields_table_description =
                    235:     [
                    236:      { name => 'url',   type=>'TEXT', restrictions => 'NOT NULL' },
                    237:      { name => 'field', type=>'TEXT', restrictions => 'NOT NULL' },
                    238:      { name => 'courserestricted', type=>'TEXT', restrictions => 'NOT NULL' },
                    239:      { name => 'value', type=>'TEXT'},
                    240:    ];
                    241: 
                    242: $Portfolio_addedfields_indices = [qw/
                    243:     url
                    244:     field
                    245:     value
                    246:     courserestricted/];
                    247: 
                    248: ######################################################################
                    249: ######################################################################
                    250: 
                    251: 
1.1       matthew   252: =pod
                    253: 
                    254: =item &describe_metadata_storage
                    255: 
                    256: Input: None
                    257: 
1.2       matthew   258: Returns: An array of hash references describing the columns and indicies
                    259: of the metadata table(s).
1.1       matthew   260: 
                    261: =cut
                    262: 
                    263: ######################################################################
                    264: ######################################################################
1.14      raeburn   265: sub describe_metadata_storage {
                    266:     my ($tabletype) = @_;
                    267:     my %table_description = (
                    268:         metadata              => $Metadata_Table_Description,
                    269:         portfolio_metadata    => $Portfolio_metadata_table_description,
                    270:         portfolio_access      => $Portfolio_access_table_description,
                    271:         portfolio_addedfields => $Portfolio_addedfields_table_description, 
                    272:     );
                    273:     my %index_description = (
                    274:         metadata              => $Fulltext_indicies,
                    275:         portfolio_metadata    => $Portfolio_metadata_indices,
                    276:         portfolio_access      => $Portfolio_access_indices,
                    277:         portfolio_addedfields => $Portfolio_addedfields_indices,
                    278:     );
                    279:     if ($tabletype eq 'portfolio_search') {
                    280:         my @portfolio_search_table = @{$table_description{portfolio_metadata}};
                    281:         foreach my $item (@{$table_description{portfolio_access}}) {
                    282:             if (ref($item) eq 'HASH') {
                    283:                 if ($item->{'name'} eq 'url') {
                    284:                     next;
                    285:                 }
                    286:             }
                    287:             push(@portfolio_search_table,$item);
                    288:         }
                    289:         my @portfolio_search_indices = @{$index_description{portfolio_metadata}};
                    290:         push(@portfolio_search_indices,('scope','keynum'));
                    291:         return (\@portfolio_search_table,\@portfolio_search_indices);
                    292:     } else {
                    293:         return ($table_description{$tabletype},$index_description{$tabletype});
                    294:     }
1.1       matthew   295: }
                    296: 
                    297: ######################################################################
                    298: ######################################################################
                    299: 
                    300: =pod
                    301: 
                    302: =item create_metadata_storage()
                    303: 
1.3       matthew   304: Inputs: table name (optional): the name of the table.  Default is 'metadata'.
1.1       matthew   305: 
                    306: Returns: A perl string which, when executed by MySQL, will cause the
                    307: metadata storage to be initialized.
                    308: 
                    309: =cut
                    310: 
                    311: ######################################################################
                    312: ######################################################################
                    313: sub create_metadata_storage { 
1.14      raeburn   314:     my ($tablename,$tabletype) = @_;
1.3       matthew   315:     $tablename = 'metadata' if (! defined($tablename));
1.14      raeburn   316:     $tabletype = 'metadata' if (! defined($tabletype));
1.1       matthew   317:     my $request = "CREATE TABLE IF NOT EXISTS ".$tablename." ";
                    318:     #
                    319:     # Process the columns  (this code is stolen from lonmysql.pm)
                    320:     my @Columns;
                    321:     my $col_des; # mysql column description
1.14      raeburn   322:     my ($table_columns,$table_indices) = 
                    323:                           &describe_metadata_storage($tabletype);
                    324:     my %coltype;
                    325:     foreach my $coldata (@{$table_columns}) {
1.1       matthew   326:         my $column = $coldata->{'name'};
1.14      raeburn   327:         $coltype{$column} = $coldata->{'type'};
1.1       matthew   328:         $col_des = '';
                    329:         if (lc($coldata->{'type'}) =~ /(enum|set)/) { # 'enum' or 'set'
                    330:             $col_des.=$column." ".$coldata->{'type'}."('".
                    331:                 join("', '",@{$coldata->{'values'}})."')";
                    332:         } else {
                    333:             $col_des.=$column." ".$coldata->{'type'};
                    334:             if (exists($coldata->{'size'})) {
                    335:                 $col_des.="(".$coldata->{'size'}.")";
                    336:             }
                    337:         }
                    338:         # Modifiers
                    339:         if (exists($coldata->{'restrictions'})){
                    340:             $col_des.=" ".$coldata->{'restrictions'};
                    341:         }
                    342:         if (exists($coldata->{'default'})) {
                    343:             $col_des.=" DEFAULT '".$coldata->{'default'}."'";
                    344:         }
                    345:         $col_des.=' AUTO_INCREMENT' if (exists($coldata->{'auto_inc'}) &&
                    346:                                         ($coldata->{'auto_inc'} eq 'yes'));
                    347:         $col_des.=' PRIMARY KEY'    if (exists($coldata->{'primary_key'}) &&
                    348:                                         ($coldata->{'primary_key'} eq 'yes'));
                    349:     } continue {
                    350:         # skip blank items.
                    351:         push (@Columns,$col_des) if ($col_des ne '');
                    352:     }
1.14      raeburn   353:     foreach my $colname (@{$table_indices}) {
                    354:         my $text;
                    355:         if ($coltype{$colname} eq 'TEXT') {
                    356:             $text = 'FULLTEXT ';
                    357:         } else {
                    358:             $text = 'INDEX ';
                    359:         }
                    360:         $text .= 'idx_'.$colname.' ('.$colname.')';
1.1       matthew   361:         push (@Columns,$text);
                    362:     }
1.3       matthew   363:     $request .= "(".join(", ",@Columns).") TYPE=MyISAM";
1.1       matthew   364:     return $request;
                    365: }
                    366: 
                    367: ######################################################################
                    368: ######################################################################
                    369: 
                    370: =pod
                    371: 
                    372: =item store_metadata()
                    373: 
1.14      raeburn   374: Inputs: database handle ($dbh), a table name, table type and a hash or hash 
                    375: reference containing the metadata for a single resource.
1.1       matthew   376: 
                    377: Returns: 1 on success, 0 on failure to store.
                    378: 
                    379: =cut
                    380: 
                    381: ######################################################################
                    382: ######################################################################
1.2       matthew   383: {
                    384:     ##
                    385:     ##  WARNING: The following cleverness may cause trouble in cases where
                    386:     ##  the dbi connection is dropped and recreated - a stale statement
                    387:     ##  handler may linger around and cause trouble.
                    388:     ##
                    389:     ##  In most scripts, this will work fine.  If the dbi is going to be
                    390:     ##  dropped and (possibly) later recreated, call &clear_sth.  Yes it
1.14      raeburn   391:     ##  is annoying but $sth apparently does not have a link back to the 
1.2       matthew   392:     ##  $dbh, so we can't check our validity.
                    393:     ##
                    394:     my $sth = undef;
1.4       matthew   395:     my $sth_table = undef;
1.2       matthew   396: 
                    397: sub create_statement_handler {
1.14      raeburn   398:     my ($dbh,$tablename,$tabletype) = @_;
1.4       matthew   399:     $tablename = 'metadata' if (! defined($tablename));
1.14      raeburn   400:     $tabletype = 'metadata' if (! defined($tabletype));
                    401:     my ($table_columns,$table_indices) = 
                    402:           &describe_metadata_storage($tabletype);
1.4       matthew   403:     $sth_table = $tablename;
                    404:     my $request = 'INSERT INTO '.$tablename.' VALUES(';
1.14      raeburn   405:     foreach (@{$table_columns}) {
1.2       matthew   406:         $request .= '?,';
                    407:     }
                    408:     chop $request;
                    409:     $request.= ')';
                    410:     $sth = $dbh->prepare($request);
                    411:     return;
                    412: }
                    413: 
1.4       matthew   414: sub clear_sth { $sth=undef; $sth_table=undef;}
1.2       matthew   415: 
1.1       matthew   416: sub store_metadata {
1.14      raeburn   417:     my ($dbh,$tablename,$tabletype,@Metadata)=@_;
1.2       matthew   418:     my $errors = '';
1.4       matthew   419:     if (! defined($sth) || 
                    420:         ( defined($tablename) && ($sth_table ne $tablename)) || 
                    421:         (! defined($tablename) && $sth_table ne 'metadata')) {
1.14      raeburn   422:         &create_statement_handler($dbh,$tablename,$tabletype);
1.2       matthew   423:     }
                    424:     my $successcount = 0;
1.14      raeburn   425:     if (! defined($tabletype)) {
                    426:         $tabletype = 'metadata';
                    427:     }
                    428:     my ($table_columns,$table_indices) = 
                    429:                         &describe_metadata_storage($tabletype);
1.10      matthew   430:     foreach my $mdata (@Metadata) {
1.2       matthew   431:         next if (ref($mdata) ne "HASH");
                    432:         my @MData;
1.14      raeburn   433:         foreach my $field (@{$table_columns}) {
1.10      matthew   434:             my $fname = $field->{'name'};
                    435:             if (exists($mdata->{$fname}) && 
                    436:                 defined($mdata->{$fname}) &&
                    437:                 $mdata->{$fname} ne '') {
                    438:                 if ($mdata->{$fname} eq 'nan' ||
                    439:                     $mdata->{$fname} eq '') {
1.5       matthew   440:                     push(@MData,'NULL');
                    441:                 } else {
1.10      matthew   442:                     push(@MData,$mdata->{$fname});
1.5       matthew   443:                 }
1.2       matthew   444:             } else {
                    445:                 push(@MData,undef);
                    446:             }
                    447:         }
                    448:         $sth->execute(@MData);
                    449:         if (! $sth->err) {
                    450:             $successcount++;
                    451:         } else {
                    452:             $errors = join(',',$errors,$sth->errstr);
                    453:         }
1.10      matthew   454:         $errors =~ s/^,//;
1.2       matthew   455:     }
                    456:     if (wantarray()) {
                    457:         return ($successcount,$errors);
                    458:     } else {
                    459:         return $successcount;
                    460:     }
                    461: }
1.1       matthew   462: 
                    463: }
                    464: 
                    465: ######################################################################
                    466: ######################################################################
                    467: 
                    468: =pod
                    469: 
                    470: =item lookup_metadata()
                    471: 
                    472: Inputs: database handle ($dbh) and a hash or hash reference containing 
                    473: metadata which will be used for a search.
                    474: 
1.2       matthew   475: Returns: scalar with error string on failure, array reference on success.
                    476: The array reference is the same one returned by $sth->fetchall_arrayref().
1.1       matthew   477: 
                    478: =cut
                    479: 
                    480: ######################################################################
                    481: ######################################################################
1.2       matthew   482: sub lookup_metadata {
1.10      matthew   483:     my ($dbh,$condition,$fetchparameter,$tablename) = @_;
                    484:     $tablename = 'metadata' if (! defined($tablename));
1.2       matthew   485:     my $error;
                    486:     my $returnvalue=[];
1.10      matthew   487:     my $request = 'SELECT * FROM '.$tablename;
1.2       matthew   488:     if (defined($condition)) {
                    489:         $request .= ' WHERE '.$condition;
                    490:     }
                    491:     my $sth = $dbh->prepare($request);
                    492:     if ($sth->err) {
                    493:         $error = $sth->errstr;
                    494:     }
                    495:     if (! $error) {
                    496:         $sth->execute();
                    497:         if ($sth->err) {
                    498:             $error = $sth->errstr;
                    499:         } else {
                    500:             $returnvalue = $sth->fetchall_arrayref($fetchparameter);
                    501:             if ($sth->err) {
                    502:                 $error = $sth->errstr;
                    503:             }
                    504:         }
                    505:     }
                    506:     return ($error,$returnvalue);
                    507: }
1.1       matthew   508: 
                    509: ######################################################################
                    510: ######################################################################
                    511: 
                    512: =pod
                    513: 
                    514: =item delete_metadata()
                    515: 
1.10      matthew   516: Removes a single metadata record, based on its url.
                    517: 
                    518: Inputs: $dbh, the database handler.
                    519: $tablename, the name of the metadata table to remove from. default: 'metadata'
                    520: $url, the url of the resource to remove from the metadata database.
                    521: 
                    522: Returns: undef on success, dbh errorstr on failure.
                    523: 
                    524: =cut
                    525: 
                    526: ######################################################################
                    527: ######################################################################
                    528: sub delete_metadata {
                    529:     my ($dbh,$tablename,$url) = @_;
                    530:     $tablename = 'metadata' if (! defined($tablename));
                    531:     my $error;
                    532:     my $delete_command = 'DELETE FROM '.$tablename.' WHERE url='.
                    533:         $dbh->quote($url);
                    534:     $dbh->do($delete_command);
                    535:     if ($dbh->err) {
                    536:         $error = $dbh->errstr();
                    537:     }
                    538:     return $error;
                    539: }
                    540: 
                    541: ######################################################################
                    542: ######################################################################
                    543: 
                    544: =pod
                    545: 
                    546: =item update_metadata
                    547: 
                    548: Updates metadata record in mysql database.  It does not matter if the record
                    549: currently exists.  Fields not present in the new metadata will be taken
                    550: from the current record, if it exists.  To delete an entry for a key, set 
                    551: it to "" or undef.
                    552: 
                    553: Inputs: 
                    554: $dbh, database handle
                    555: $newmetadata, hash reference containing the new metadata
                    556: $tablename, metadata table name.  Defaults to 'metadata'.
1.14      raeburn   557: $tabletype, type of table (metadata, portfolio_metadata, portfolio_access)  
1.10      matthew   558: 
                    559: Returns:
                    560: $error on failure.  undef on success.
1.1       matthew   561: 
                    562: =cut
                    563: 
                    564: ######################################################################
                    565: ######################################################################
1.10      matthew   566: sub update_metadata {
1.14      raeburn   567:     my ($dbh,$tablename,$tabletype,$newmetadata)=@_;
1.10      matthew   568:     my $error;
                    569:     $tablename = 'metadata' if (! defined($tablename));
1.14      raeburn   570:     $tabletype = 'metadata' if (! defined($tabletype));
1.10      matthew   571:     if (! exists($newmetadata->{'url'})) {
                    572:         $error = 'Unable to update: no url specified';
                    573:     }
                    574:     return $error if (defined($error));
                    575:     # 
                    576:     # Retrieve current values
                    577:     my $row;
                    578:     ($error,$row) = &lookup_metadata($dbh,
                    579:                                    ' url='.$dbh->quote($newmetadata->{'url'}),
                    580:                                      undef,$tablename);
                    581:     return $error if ($error);
1.14      raeburn   582:     my %metadata = &LONCAPA::lonmetadata::metadata_col_to_hash($tabletype,@{$row->[0]});
1.10      matthew   583:     #
                    584:     # Update metadata values
                    585:     while (my ($key,$value) = each(%$newmetadata)) {
                    586:         $metadata{$key} = $value;
                    587:     }
                    588:     #
                    589:     # Delete old data (deleting a nonexistant record does not produce an error.
                    590:     $error = &delete_metadata($dbh,$tablename,$newmetadata->{'url'});
                    591:     return $error if (defined($error));
                    592:     #
                    593:     # Store updated metadata
                    594:     my $success;
1.14      raeburn   595:     ($success,$error) = &store_metadata($dbh,$tablename,$tabletype,\%metadata);
1.10      matthew   596:     return $error;
                    597: }
1.1       matthew   598: 
                    599: ######################################################################
                    600: ######################################################################
1.5       matthew   601: 
1.6       matthew   602: =pod
                    603: 
                    604: =item metdata_col_to_hash
                    605: 
                    606: Input: Array of metadata columns
                    607: 
                    608: Return: Hash with the metadata columns as keys and the array elements
                    609: passed in as values
                    610: 
                    611: =cut
                    612: 
                    613: ######################################################################
                    614: ######################################################################
                    615: sub metadata_col_to_hash {
1.14      raeburn   616:     my ($tabletype,@cols)=@_;
1.6       matthew   617:     my %hash=();
1.14      raeburn   618:     my ($columns,$indices) = &describe_metadata_storage($tabletype);
                    619:     for (my $i=0; $i<@{$columns};$i++) {
                    620:         $hash{$columns->[$i]->{'name'}}=$cols[$i];
                    621: 	unless ($hash{$columns->[$i]->{'name'}}) {
                    622: 	    if ($columns->[$i]->{'type'} eq 'TEXT') {
                    623: 		$hash{$columns->[$i]->{'name'}}='';
                    624: 	    } elsif ($columns->[$i]->{'type'} eq 'DATETIME') {
                    625: 		$hash{$columns->[$i]->{'name'}}='0000-00-00 00:00:00';
1.13      www       626: 	    } else {
1.14      raeburn   627: 		$hash{$columns->[$i]->{'name'}}=0;
1.13      www       628: 	    }
                    629: 	}
1.6       matthew   630:     }
                    631:     return %hash;
                    632: }
1.5       matthew   633: 
                    634: ######################################################################
                    635: ######################################################################
                    636: 
                    637: =pod
                    638: 
1.8       matthew   639: =item nohist_resevaldata.db data structure
                    640: 
                    641: The nohist_resevaldata.db file has the following possible keys:
                    642: 
                    643:  Statistics Data (values are integers, perl times, or real numbers)
                    644:  ------------------------------------------
                    645:  $course___$resource___avetries
                    646:  $course___$resource___count
                    647:  $course___$resource___difficulty
                    648:  $course___$resource___stdno
                    649:  $course___$resource___timestamp
                    650: 
                    651:  Evaluation Data (values are on a 1 to 5 scale)
                    652:  ------------------------------------------
                    653:  $username@$dom___$resource___clear
                    654:  $username@$dom___$resource___comments
                    655:  $username@$dom___$resource___depth
                    656:  $username@$dom___$resource___technical
                    657:  $username@$dom___$resource___helpful
1.11      www       658:  $username@$dom___$resource___correct
1.8       matthew   659: 
                    660:  Course Context Data
                    661:  ------------------------------------------
                    662:  $course___$resource___course       course id
                    663:  $course___$resource___comefrom     resource preceeding this resource
                    664:  $course___$resource___goto         resource following this resource
                    665:  $course___$resource___usage        resource containing this resource
                    666: 
                    667:  New statistical data storage
                    668:  ------------------------------------------
                    669:  $course&$sec&$numstud___$resource___stats
                    670:     $sec is a string describing the sections: all, 1 2, 1 2 3,...
                    671:     Value is a '&' deliminated list of key=value pairs.
                    672:     Possible keys are (currently) disc,course,sections,difficulty, 
                    673:     stdno, timestamp
                    674: 
                    675: =cut
                    676: 
                    677: ######################################################################
                    678: ######################################################################
                    679: 
                    680: =pod
                    681: 
1.5       matthew   682: =item &process_reseval_data 
                    683: 
                    684: Process a nohist_resevaldata hash into a more complex data structure.
                    685: 
                    686: Input: Hash reference containing reseval data
                    687: 
                    688: Returns: Hash with the following structure:
                    689: 
                    690: $hash{$url}->{'statistics'}->{$courseid}->{'avetries'}   = $value
                    691: $hash{$url}->{'statistics'}->{$courseid}->{'count'}      = $value
                    692: $hash{$url}->{'statistics'}->{$courseid}->{'difficulty'} = $value
                    693: $hash{$url}->{'statistics'}->{$courseid}->{'stdno'}      = $value
                    694: $hash{$url}->{'statistics'}->{$courseid}->{'timestamp'}  = $value
                    695: 
                    696: $hash{$url}->{'evaluation'}->{$username}->{'clear'}     = $value
                    697: $hash{$url}->{'evaluation'}->{$username}->{'comments'}  = $value
                    698: $hash{$url}->{'evaluation'}->{$username}->{'depth'}     = $value
                    699: $hash{$url}->{'evaluation'}->{$username}->{'technical'} = $value
                    700: $hash{$url}->{'evaluation'}->{$username}->{'helpful'}   = $value
                    701: 
                    702: $hash{$url}->{'course'}    = \@Courses
                    703: $hash{$url}->{'comefrom'}  = \@Resources
                    704: $hash{$url}->{'goto'}      = \@Resources
                    705: $hash{$url}->{'usage'}     = \@Resources
                    706: 
                    707: $hash{$url}->{'stats'}->{$courseid\_$section}->{$key} = $value
                    708: 
                    709: =cut
                    710: 
                    711: ######################################################################
                    712: ######################################################################
                    713: sub process_reseval_data {
                    714:     my ($evaldata) = @_;
                    715:     my %DynamicData;
                    716:     #
                    717:     # Process every stored element
                    718:     while (my ($storedkey,$value) = each(%{$evaldata})) {
                    719:         my ($source,$file,$type) = split('___',$storedkey);
                    720:         $source = &unescape($source);
                    721:         $file = &unescape($file);
                    722:         $value = &unescape($value);
                    723:          "    got ".$file."\n        ".$type." ".$source."\n";
                    724:         if ($type =~ /^(avetries|count|difficulty|stdno|timestamp)$/) {
                    725:             #
                    726:             # Statistics: $source is course id
                    727:             $DynamicData{$file}->{'statistics'}->{$source}->{$type}=$value;
1.11      www       728:         } elsif ($type =~ /^(clear|comments|depth|technical|helpful|correct)$/){
1.5       matthew   729:             #
                    730:             # Evaluation $source is username, check if they evaluated it
                    731:             # more than once.  If so, pad the entry with a space.
                    732:             while(exists($DynamicData{$file}->{'evaluation'}->{$type}->{$source})) {
                    733:                 $source .= ' ';
                    734:             }
                    735:             $DynamicData{$file}->{'evaluation'}->{$type}->{$source}=$value;
                    736:         } elsif ($type =~ /^(course|comefrom|goto|usage)$/) {
                    737:             #
                    738:             # Context $source is course id or resource
                    739:             push(@{$DynamicData{$file}->{$type}},&unescape($source));
                    740:         } elsif ($type eq 'stats') {
                    741:             #
                    742:             # Statistics storage...
                    743:             # $source is $cid\_$sec\_$stdno
                    744:             # $value is stat1=value&stat2=value&stat3=value,....
                    745:             #
1.8       matthew   746:             my ($cid,$sec,$stdno)=split('&',$source);
                    747:             my $crssec = $cid.'&'.$sec;
1.5       matthew   748:             my @Data = split('&',$value);
                    749:             my %Statistics;
                    750:             while (my ($key,$value) = split('=',pop(@Data))) {
                    751:                 $Statistics{$key} = $value;
                    752:             }
1.8       matthew   753:             $sec =~ s:("$|^")::g;
                    754:             $Statistics{'sections'} = $sec;
1.5       matthew   755:             #
                    756:             # Only store the data if the number of students is greater
                    757:             # than the data already stored
                    758:             if (! exists($DynamicData{$file}->{'stats'}->{$crssec}) ||
                    759:                 $DynamicData{$file}->{'stats'}->{$crssec}->{'stdno'}<$stdno){
                    760:                 $DynamicData{$file}->{'stats'}->{$crssec}=\%Statistics;
                    761:             }
                    762:         }
                    763:     }
                    764:     return %DynamicData;
                    765: }
                    766: 
                    767: 
                    768: ######################################################################
                    769: ######################################################################
                    770: 
                    771: =pod
                    772: 
                    773: =item &process_dynamic_metadata
                    774: 
                    775: Inputs: $url: the url of the item to process
                    776: $DynamicData: hash reference for the results of &process_reseval_data
                    777: 
                    778: Returns: Hash containing the following keys:
                    779:     avetries, avetries_list, difficulty, difficulty_list, stdno, stdno_list,
                    780:     course, course_list, goto, goto_list, comefrom, comefrom_list,
                    781:     usage, clear, technical, correct, helpful, depth, comments
                    782: 
                    783:     Each of the return keys is associated with either a number or a string
                    784:     The *_list items are comma-seperated strings.  'comments' is a string
                    785:     containing generically marked-up comments.
                    786: 
                    787: =cut
                    788: 
                    789: ######################################################################
                    790: ######################################################################
                    791: sub process_dynamic_metadata {
                    792:     my ($url,$DynamicData) = @_;
                    793:     my %data;
                    794:     my $resdata = $DynamicData->{$url};
                    795:     #
1.8       matthew   796:     # Get the statistical data - Use a weighted average
                    797:     foreach my $type (qw/avetries difficulty disc/) {
                    798:         my $studentcount;
1.5       matthew   799:         my $sum;
                    800:         my @Values;
1.8       matthew   801:         my @Students;
1.5       matthew   802:         #
1.8       matthew   803:         # Old data
1.5       matthew   804:         foreach my $coursedata (values(%{$resdata->{'statistics'}}),
                    805:                                 values(%{$resdata->{'stats'}})) {
                    806:             if (ref($coursedata) eq 'HASH' && exists($coursedata->{$type})) {
1.8       matthew   807:                 $studentcount += $coursedata->{'stdno'};
                    808:                 $sum += ($coursedata->{$type}*$coursedata->{'stdno'});
1.5       matthew   809:                 push(@Values,$coursedata->{$type});
1.8       matthew   810:                 push(@Students,$coursedata->{'stdno'});
1.5       matthew   811:             }
                    812:         }
1.8       matthew   813:         if (exists($resdata->{'stats'})) {
                    814:             foreach my $identifier (sort(keys(%{$resdata->{'stats'}}))) {
                    815:                 my $coursedata = $resdata->{'stats'}->{$identifier};
                    816:                 $studentcount += $coursedata->{'stdno'};
                    817:                 $sum += $coursedata->{$type}*$coursedata->{'stdno'};
                    818:                 push(@Values,$coursedata->{$type});                
                    819:                 push(@Students,$coursedata->{'stdno'});
                    820:             }
                    821:         }
                    822:         #
                    823:         # New data
                    824:         if (defined($studentcount) && $studentcount>0) {
                    825:             $data{$type} = $sum/$studentcount;
1.5       matthew   826:             $data{$type.'_list'} = join(',',@Values);
                    827:         }
                    828:     }
                    829:     #
1.8       matthew   830:     # Find out the number of students who have completed the resource...
                    831:     my $stdno;
                    832:     foreach my $coursedata (values(%{$resdata->{'statistics'}}),
                    833:                             values(%{$resdata->{'stats'}})) {
                    834:         if (ref($coursedata) eq 'HASH' && exists($coursedata->{'stdno'})) {
                    835:             $stdno += $coursedata->{'stdno'};
                    836:         }
                    837:     }
                    838:     if (exists($resdata->{'stats'})) {
                    839:         #
                    840:         # For the number of students, take the maximum found for the class
                    841:         my $current_course;
                    842:         my $coursemax=0;
                    843:         foreach my $identifier (sort(keys(%{$resdata->{'stats'}}))) {
                    844:             my $coursedata = $resdata->{'stats'}->{$identifier};
                    845:             if (! defined($current_course)) {
                    846:                 $current_course = $coursedata->{'course'};
                    847:             }
                    848:             if ($current_course ne $coursedata->{'course'}) {
                    849:                 $stdno += $coursemax;
                    850:                 $coursemax = 0;
                    851:                 $current_course = $coursedata->{'course'};                
                    852:             }
                    853:             if ($coursemax < $coursedata->{'stdno'}) {
                    854:                 $coursemax = $coursedata->{'stdno'};
                    855:             }
                    856:         }
                    857:         $stdno += $coursemax; # pick up the final course in the list
                    858:     }
                    859:     $data{'stdno'}=$stdno;
                    860:     #
1.5       matthew   861:     # Get the context data
                    862:     foreach my $type (qw/course goto comefrom/) {
                    863:         if (defined($resdata->{$type}) && 
                    864:             ref($resdata->{$type}) eq 'ARRAY') {
                    865:             $data{$type} = scalar(@{$resdata->{$type}});
                    866:             $data{$type.'_list'} = join(',',@{$resdata->{$type}});
                    867:         }
                    868:     }
                    869:     if (defined($resdata->{'usage'}) && 
                    870:         ref($resdata->{'usage'}) eq 'ARRAY') {
                    871:         $data{'sequsage'} = scalar(@{$resdata->{'usage'}});
                    872:         $data{'sequsage_list'} = join(',',@{$resdata->{'usage'}});
                    873:     }
                    874:     #
                    875:     # Get the evaluation data
                    876:     foreach my $type (qw/clear technical correct helpful depth/) {
                    877:         my $count;
                    878:         my $sum;
                    879:         foreach my $evaluator (keys(%{$resdata->{'evaluation'}->{$type}})){
                    880:             $sum += $resdata->{'evaluation'}->{$type}->{$evaluator};
                    881:             $count++;
                    882:         }
                    883:         if ($count > 0) {
                    884:             $data{$type}=$sum/$count;
                    885:         }
                    886:     }
                    887:     #
                    888:     # put together comments
                    889:     my $comments = '<div class="LCevalcomments">';
                    890:     foreach my $evaluator (keys(%{$resdata->{'evaluation'}->{'comments'}})){
1.7       matthew   891:         $comments .= 
                    892:             '<p>'.
                    893:             '<b>'.$evaluator.'</b>:'.
                    894:             $resdata->{'evaluation'}->{'comments'}->{$evaluator}.
                    895:             '</p>';
1.5       matthew   896:     }
                    897:     $comments .= '</div>';
1.7       matthew   898:     $data{'comments'} = $comments;
1.5       matthew   899:     #
1.8       matthew   900:     if (exists($resdata->{'stats'})) {
                    901:         $data{'stats'} = $resdata->{'stats'};
                    902:     }
1.12      matthew   903:     if (exists($DynamicData->{'domain'})) {
                    904:         $data{'domain'} = $DynamicData->{'domain'};
                    905:     }
1.8       matthew   906:     #
1.5       matthew   907:     return %data;
                    908: }
                    909: 
1.8       matthew   910: sub dynamic_metadata_storage {
                    911:     my ($data) = @_;
                    912:     my %Store;
                    913:     my $courseid = $data->{'course'};
                    914:     my $sections = $data->{'sections'};
                    915:     my $numstu = $data->{'num_students'};
                    916:     my $urlres = $data->{'urlres'};
                    917:     my $key = $courseid.'&'.$sections.'&'.$numstu.'___'.$urlres.'___stats';
                    918:     $Store{$key} =
                    919:         'course='.$courseid.'&'.
                    920:         'sections='.$sections.'&'.
                    921:         'timestamp='.time.'&'.
                    922:         'stdno='.$data->{'num_students'}.'&'.
                    923:         'avetries='.$data->{'mean_tries'}.'&'.
                    924:         'difficulty='.$data->{'deg_of_diff'};
                    925:     if (exists($data->{'deg_of_disc'})) {
                    926:         $Store{$key} .= '&'.'disc='.$data->{'deg_of_disc'};
                    927:     }
                    928:     return %Store;
                    929: }
1.6       matthew   930: 
1.5       matthew   931: ######################################################################
                    932: ######################################################################
1.14      raeburn   933: 
1.15    ! raeburn   934: ## Utility originally in searchcat.pl.  Moved to be more widely available. 
        !           935: ##
        !           936: ## &sqltime($timestamp)
        !           937: ##
        !           938: ## Convert perl $timestamp to MySQL time.  MySQL expects YYYY-MM-DD HH:MM:SS
        !           939: ##
        !           940: sub sqltime {
        !           941:     my ($time) = @_;
        !           942:     my $mysqltime;
        !           943:     if ($time =~
        !           944:         /(\d+)-(\d+)-(\d+) # YYYY-MM-DD
        !           945:         \s                 # a space
        !           946:         (\d+):(\d+):(\d+)  # HH:MM::SS
        !           947:         /x ) {
        !           948:         # Some of the .meta files have the time in mysql
        !           949:         # format already, so just make sure they are 0 padded and
        !           950:         # pass them back.
        !           951:         $mysqltime = sprintf('%04d-%02d-%02d %02d:%02d:%02d',
        !           952:                              $1,$2,$3,$4,$5,$6);
        !           953:     } elsif ($time =~ /^\d+$/) {
        !           954:         my @TimeData = gmtime($time);
        !           955:         # Alter the month to be 1-12 instead of 0-11
        !           956:         $TimeData[4]++;
        !           957:         # Alter the year to be from 0 instead of from 1900
        !           958:         $TimeData[5]+=1900;
        !           959:         $mysqltime = sprintf('%04d-%02d-%02d %02d:%02d:%02d',
        !           960:                              @TimeData[5,4,3,2,1,0]);
        !           961:     } elsif (! defined($time) || $time == 0) {
        !           962:         $mysqltime = 0;
        !           963:     } else {
        !           964:         &log(0,"    sqltime:Unable to decode time ".$time);
        !           965:         $mysqltime = 0;
        !           966:     }
        !           967:     return $mysqltime;
        !           968: }
1.14      raeburn   969: 
                    970: ######################################################################
                    971: ######################################################################
1.5       matthew   972: ##
                    973: ## The usual suspects, repeated here to reduce dependency hell
                    974: ##
                    975: ######################################################################
                    976: ######################################################################
                    977: sub unescape {
                    978:     my $str=shift;
                    979:     $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
                    980:     return $str;
                    981: }
                    982: 
                    983: sub escape {
                    984:     my $str=shift;
                    985:     $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
                    986:     return $str;
                    987: }
1.6       matthew   988: 
1.1       matthew   989: 1;
                    990: 
                    991: __END__;
                    992: 
                    993: =pod
                    994: 
                    995: =back
                    996: 
                    997: =cut

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