File:  [LON-CAPA] / loncom / metadata_database / LONCAPA / lonmetadata.pm
Revision 1.36: download - view: text, annotated - select for diffs
Thu Mar 15 20:53:27 2012 UTC (12 years, 3 months ago) by www
Branches: MAIN
CVS tags: HEAD
Part of Bug #6576: store part and instance info for statistics

    1: # The LearningOnline Network with CAPA
    2: #
    3: # $Id: lonmetadata.pm,v 1.36 2012/03/15 20:53:27 www 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: use HTML::TokeParser;
   34: use vars qw($Metadata_Table_Description $Portfolio_metadata_table_description 
   35: $Portfolio_access_table_description $Fulltext_indicies $Portfolio_metadata_indices $Portfolio_access_indices $Portfolio_addedfields_table_description $Portfolio_addedfields_indices $Allusers_table_description $Allusers_indices);
   36: 
   37: ######################################################################
   38: ######################################################################
   39: 
   40: =pod 
   41: 
   42: =head1 Name
   43: 
   44: lonmetadata
   45: 
   46: =head1 Synopsis
   47: 
   48: lonmetadata holds a description of the metadata table and provides
   49: wrappers for the storage and retrieval of metadata to/from the database.
   50: 
   51: =head1 Description
   52: 
   53: =head1 Methods
   54: 
   55: =over 4
   56: 
   57: =cut
   58: 
   59: ######################################################################
   60: ######################################################################
   61: 
   62: =pod
   63: 
   64: =item Old table creation command
   65: 
   66: CREATE TABLE IF NOT EXISTS metadata 
   67: (title TEXT, 
   68: author TEXT, 
   69: subject TEXT, 
   70: url TEXT, 
   71: keywords TEXT, 
   72: version TEXT, 
   73: notes TEXT, 
   74: abstract TEXT, 
   75: mime TEXT, 
   76: language TEXT, 
   77: creationdate DATETIME, 
   78: lastrevisiondate DATETIME, 
   79: owner TEXT, 
   80: copyright TEXT, 
   81: domain TEXT
   82: 
   83: FULLTEXT idx_title (title), 
   84: FULLTEXT idx_author (author), 
   85: FULLTEXT idx_subject (subject), 
   86: FULLTEXT idx_url (url), 
   87: FULLTEXT idx_keywords (keywords), 
   88: FULLTEXT idx_version (version), 
   89: FULLTEXT idx_notes (notes), 
   90: FULLTEXT idx_abstract (abstract), 
   91: FULLTEXT idx_mime (mime), 
   92: FULLTEXT idx_language (language),
   93: FULLTEXT idx_owner (owner), 
   94: FULLTEXT idx_copyright (copyright)) 
   95: 
   96: ENGINE=MYISAM;
   97: 
   98: =cut
   99: 
  100: ######################################################################
  101: ######################################################################
  102: $Metadata_Table_Description = 
  103:     [
  104:      { name => 'title',     type=>'TEXT'},
  105:      { name => 'author',    type=>'TEXT'},
  106:      { name => 'subject',   type=>'TEXT'},
  107:      { name => 'url',       type=>'TEXT', restrictions => 'NOT NULL' },
  108:      { name => 'keywords',  type=>'TEXT'},
  109:      { name => 'version',   type=>'TEXT'},
  110:      { name => 'notes',     type=>'TEXT'},
  111:      { name => 'abstract',  type=>'TEXT'},
  112:      { name => 'mime',      type=>'TEXT'},
  113:      { name => 'language',  type=>'TEXT'},
  114:      { name => 'creationdate',     type=>'DATETIME'},
  115:      { name => 'lastrevisiondate', type=>'DATETIME'},
  116:      { name => 'owner',     type=>'TEXT'},
  117:      { name => 'copyright', type=>'TEXT'}, 
  118:      { name => 'domain',    type=>'TEXT'},
  119:       #--------------------------------------------------
  120:      { name => 'dependencies',   type=>'TEXT'},
  121:      { name => 'modifyinguser',  type=>'TEXT'},
  122:      { name => 'authorspace',    type=>'TEXT'},
  123:      { name => 'lowestgradelevel',  type=>'INT'},
  124:      { name => 'highestgradelevel', type=>'INT'},
  125:      { name => 'standards',      type=>'TEXT'},
  126:      { name => 'count',          type=>'INT'},
  127:      { name => 'course',         type=>'INT'},
  128:      { name => 'course_list',    type=>'TEXT'},
  129:      { name => 'goto',           type=>'INT'},
  130:      { name => 'goto_list',      type=>'TEXT'},
  131:      { name => 'comefrom',       type=>'INT'},
  132:      { name => 'comefrom_list',  type=>'TEXT'},
  133:      { name => 'sequsage',       type=>'INT'},
  134:      { name => 'sequsage_list',  type=>'TEXT'},
  135:      { name => 'stdno',          type=>'INT'},
  136:      { name => 'stdno_list',     type=>'TEXT'},
  137:      { name => 'avetries',       type=>'FLOAT'},
  138:      { name => 'avetries_list',  type=>'TEXT'},
  139:      { name => 'difficulty',     type=>'FLOAT'},
  140:      { name => 'difficulty_list',type=>'TEXT'},
  141:      { name => 'disc',           type=>'FLOAT'},
  142:      { name => 'disc_list',      type=>'TEXT'},
  143:      { name => 'clear',          type=>'FLOAT'},
  144:      { name => 'technical',      type=>'FLOAT'},
  145:      { name => 'correct',        type=>'FLOAT'},
  146:      { name => 'helpful',        type=>'FLOAT'},
  147:      { name => 'depth',          type=>'FLOAT'},
  148:      { name => 'hostname',       type=> 'TEXT'},
  149:      #--------------------------------------------------
  150:     ];
  151: 
  152: $Fulltext_indicies = [ qw/ 
  153:     title
  154:     author
  155:     subject
  156:     url
  157:     keywords
  158:     version
  159:     notes
  160:     abstract
  161:     mime
  162:     language
  163:     owner
  164:     copyright/ ];
  165: 
  166: ######################################################################
  167: ######################################################################
  168: $Portfolio_metadata_table_description =
  169:     [
  170:      { name => 'title',     type=>'TEXT'},
  171:      { name => 'author',    type=>'TEXT'},
  172:      { name => 'subject',   type=>'TEXT'},
  173:      { name => 'url',       type=>'TEXT', restrictions => 'NOT NULL' },
  174:      { name => 'keywords',  type=>'TEXT'},
  175:      { name => 'version',   type=>'TEXT'},
  176:      { name => 'notes',     type=>'TEXT'},
  177:      { name => 'abstract',  type=>'TEXT'},
  178:      { name => 'mime',      type=>'TEXT'},
  179:      { name => 'language',  type=>'TEXT'},
  180:      { name => 'creationdate',     type=>'DATETIME'},
  181:      { name => 'lastrevisiondate', type=>'DATETIME'},
  182:      { name => 'owner',     type=>'TEXT'},
  183:      { name => 'copyright',     type=>'TEXT'},
  184:      { name => 'domain',    type=>'TEXT'},
  185:      { name => 'groupname',     type=>'TEXT'},
  186:      { name => 'courserestricted', type=>'TEXT'},
  187:       #--------------------------------------------------
  188:      { name => 'dependencies',   type=>'TEXT'},
  189:      { name => 'modifyinguser',  type=>'TEXT'},
  190:      { name => 'authorspace',    type=>'TEXT'},
  191:      { name => 'lowestgradelevel',  type=>'INT'},
  192:      { name => 'highestgradelevel', type=>'INT'},
  193:      { name => 'standards',      type=>'TEXT'},
  194:      { name => 'hostname',       type=> 'TEXT'},
  195:      #--------------------------------------------------
  196:    ];
  197: 
  198: $Portfolio_metadata_indices = [qw/
  199:     title
  200:     author
  201:     subject
  202:     url
  203:     keywords
  204:     version
  205:     notes
  206:     abstract
  207:     mime
  208:     language
  209:     owner/];
  210: 
  211: ######################################################################
  212: ######################################################################
  213: 
  214: $Portfolio_access_table_description =
  215:     [
  216:      { name => 'url',   type=>'TEXT', restrictions => 'NOT NULL' },
  217:      { name => 'keynum', type=>'TEXT', restrictions => 'NOT NULL' },
  218:      { name => 'scope', type=>'TEXT'},
  219:      { name => 'start', type=>'DATETIME'},
  220:      { name => 'end',   type=>'DATETIME'},
  221:    ];
  222: 
  223: $Portfolio_access_indices = [qw/
  224:     url
  225:     keynum
  226:     scope
  227:     start
  228:     end/];
  229: 
  230: ######################################################################
  231: ######################################################################
  232: 
  233: $Portfolio_addedfields_table_description =
  234:     [
  235:      { name => 'url',   type=>'TEXT', restrictions => 'NOT NULL' },
  236:      { name => 'field', type=>'TEXT', restrictions => 'NOT NULL' },
  237:      { name => 'courserestricted', type=>'TEXT', restrictions => 'NOT NULL' },
  238:      { name => 'value', type=>'TEXT'},
  239:    ];
  240: 
  241: $Portfolio_addedfields_indices = [qw/
  242:     url
  243:     field
  244:     value
  245:     courserestricted/];
  246: 
  247: ######################################################################
  248: ######################################################################
  249: 
  250: $Allusers_table_description =
  251:     [
  252:      { name => 'username',   type=>'TEXT', restrictions => 'NOT NULL' },
  253:      { name => 'domain', type=>'TEXT', restrictions => 'NOT NULL' },
  254:      { name => 'lastname', type=>'TEXT',},
  255:      { name => 'firstname', type=>'TEXT'},
  256:      { name => 'middlename', type=>'TEXT'},
  257:      { name => 'generation', type=>'TEXT'},
  258:      { name => 'permanentemail', type=>'TEXT'},
  259:      { name => 'id', type=>'TEXT'},
  260:    ];
  261: 
  262: $Allusers_indices = [qw/
  263:     username
  264:     domain
  265:     lastname
  266:     firstname/];
  267: 
  268: ######################################################################
  269: ######################################################################
  270: 
  271: =pod
  272: 
  273: =item &describe_metadata_storage
  274: 
  275: Input: None
  276: 
  277: Returns: An array of hash references describing the columns and indicies
  278: of the metadata table(s).
  279: 
  280: =cut
  281: 
  282: ######################################################################
  283: ######################################################################
  284: sub describe_metadata_storage {
  285:     my ($tabletype) = @_;
  286:     my %table_description = (
  287:         metadata              => $Metadata_Table_Description,
  288:         portfolio_metadata    => $Portfolio_metadata_table_description,
  289:         portfolio_access      => $Portfolio_access_table_description,
  290:         portfolio_addedfields => $Portfolio_addedfields_table_description, 
  291:         allusers              => $Allusers_table_description,
  292:     );
  293:     my %index_description = (
  294:         metadata              => $Fulltext_indicies,
  295:         portfolio_metadata    => $Portfolio_metadata_indices,
  296:         portfolio_access      => $Portfolio_access_indices,
  297:         portfolio_addedfields => $Portfolio_addedfields_indices,
  298:         allusers              => $Allusers_indices,
  299:     );
  300:     if ($tabletype eq 'portfolio_search') {
  301:         my @portfolio_search_table = @{$table_description{portfolio_metadata}};
  302:         foreach my $item (@{$table_description{portfolio_access}}) {
  303:             if (ref($item) eq 'HASH') {
  304:                 if ($item->{'name'} eq 'url') {
  305:                     next;
  306:                 }
  307:             }
  308:             push(@portfolio_search_table,$item);
  309:         }
  310:         my @portfolio_search_indices = @{$index_description{portfolio_metadata}};
  311:         push(@portfolio_search_indices,('scope','keynum'));
  312:         return (\@portfolio_search_table,\@portfolio_search_indices);
  313:     } else {
  314:         return ($table_description{$tabletype},$index_description{$tabletype});
  315:     }
  316: }
  317: 
  318: ######################################################################
  319: ######################################################################
  320: 
  321: =pod
  322: 
  323: =item create_metadata_storage()
  324: 
  325: Inputs: table name (optional): the name of the table.  Default is 'metadata'.
  326: 
  327: Returns: A perl string which, when executed by MySQL, will cause the
  328: metadata storage to be initialized.
  329: 
  330: =cut
  331: 
  332: ######################################################################
  333: ######################################################################
  334: sub create_metadata_storage { 
  335:     my ($tablename,$tabletype) = @_;
  336:     $tablename = 'metadata' if (! defined($tablename));
  337:     $tabletype = 'metadata' if (! defined($tabletype));
  338:     my $request = "CREATE TABLE IF NOT EXISTS ".$tablename." ";
  339:     #
  340:     # Process the columns  (this code is stolen from lonmysql.pm)
  341:     my @Columns;
  342:     my $col_des; # mysql column description
  343:     my ($table_columns,$table_indices) = 
  344:                           &describe_metadata_storage($tabletype);
  345:     my %coltype;
  346:     foreach my $coldata (@{$table_columns}) {
  347:         my $column = $coldata->{'name'};
  348:         $coltype{$column} = $coldata->{'type'};
  349:         $col_des = '';
  350:         if (lc($coldata->{'type'}) =~ /(enum|set)/) { # 'enum' or 'set'
  351:             $col_des.=$column." ".$coldata->{'type'}."('".
  352:                 join("', '",@{$coldata->{'values'}})."')";
  353:         } else {
  354:             $col_des.=$column." ".$coldata->{'type'};
  355:             if (exists($coldata->{'size'})) {
  356:                 $col_des.="(".$coldata->{'size'}.")";
  357:             }
  358:         }
  359:         if (($tablename =~ /allusers/) && ($column eq 'username')) {  
  360:             $col_des .= ' CHARACTER SET latin1 COLLATE latin1_general_cs';
  361:         }
  362:         # Modifiers
  363:         if (exists($coldata->{'restrictions'})){
  364:             $col_des.=" ".$coldata->{'restrictions'};
  365:         }
  366:         if (exists($coldata->{'default'})) {
  367:             $col_des.=" DEFAULT '".$coldata->{'default'}."'";
  368:         }
  369:         $col_des.=' AUTO_INCREMENT' if (exists($coldata->{'auto_inc'}) &&
  370:                                         ($coldata->{'auto_inc'} eq 'yes'));
  371:         $col_des.=' PRIMARY KEY'    if (exists($coldata->{'primary_key'}) &&
  372:                                         ($coldata->{'primary_key'} eq 'yes'));
  373:     } continue {
  374:         # skip blank items.
  375:         push (@Columns,$col_des) if ($col_des ne '');
  376:     }
  377:     foreach my $colname (@{$table_indices}) {
  378:         my $text;
  379:         if ($coltype{$colname} eq 'TEXT') {
  380:             $text = 'FULLTEXT ';
  381:         } else {
  382:             $text = 'INDEX ';
  383:         }
  384:         $text .= 'idx_'.$colname.' ('.$colname.')';
  385:         push (@Columns,$text);
  386:     }
  387:     $request .= "(".join(", ",@Columns).") ENGINE=MyISAM";
  388:     return $request;
  389: }
  390: 
  391: ######################################################################
  392: ######################################################################
  393: 
  394: =pod
  395: 
  396: =item store_metadata()
  397: 
  398: Inputs: database handle ($dbh), a table name, table type and a hash or hash 
  399: reference containing the metadata for a single resource.
  400: 
  401: Returns: 1 on success, 0 on failure to store.
  402: 
  403: =cut
  404: 
  405: ######################################################################
  406: ######################################################################
  407: {
  408:     ##
  409:     ##  WARNING: The following cleverness may cause trouble in cases where
  410:     ##  the dbi connection is dropped and recreated - a stale statement
  411:     ##  handler may linger around and cause trouble.
  412:     ##
  413:     ##  In most scripts, this will work fine.  If the dbi is going to be
  414:     ##  dropped and (possibly) later recreated, call &clear_sth.  Yes it
  415:     ##  is annoying but $sth apparently does not have a link back to the 
  416:     ##  $dbh, so we can't check our validity.
  417:     ##
  418:     my $sth = undef;
  419:     my $sth_table = undef;
  420: 
  421: sub create_statement_handler {
  422:     my ($dbh,$tablename,$tabletype) = @_;
  423:     $tablename = 'metadata' if (! defined($tablename));
  424:     $tabletype = 'metadata' if (! defined($tabletype));
  425:     my ($table_columns,$table_indices) = 
  426:           &describe_metadata_storage($tabletype);
  427:     $sth_table = $tablename;
  428:     my $request = 'INSERT INTO '.$tablename.' VALUES(';
  429:     foreach (@{$table_columns}) {
  430:         $request .= '?,';
  431:     }
  432:     chop $request;
  433:     $request.= ')';
  434:     $sth = $dbh->prepare($request);
  435:     return;
  436: }
  437: 
  438: sub clear_sth { $sth=undef; $sth_table=undef;}
  439: 
  440: sub store_metadata {
  441:     my ($dbh,$tablename,$tabletype,@Metadata)=@_;
  442:     my $errors = '';
  443:     if (! defined($sth) || 
  444:         ( defined($tablename) && ($sth_table ne $tablename)) || 
  445:         (! defined($tablename) && $sth_table ne 'metadata')) {
  446:         &create_statement_handler($dbh,$tablename,$tabletype);
  447:     }
  448:     my $successcount = 0;
  449:     if (! defined($tabletype)) {
  450:         $tabletype = 'metadata';
  451:     }
  452:     my ($table_columns,$table_indices) = 
  453:                         &describe_metadata_storage($tabletype);
  454:     foreach my $mdata (@Metadata) {
  455:         next if (ref($mdata) ne "HASH");
  456:         my @MData;
  457:         foreach my $field (@{$table_columns}) {
  458:             my $fname = $field->{'name'};
  459:             if (exists($mdata->{$fname}) && 
  460:                 defined($mdata->{$fname}) &&
  461:                 $mdata->{$fname} ne '') {
  462:                 if ($mdata->{$fname} eq 'nan' ||
  463:                     $mdata->{$fname} eq '') {
  464:                     push(@MData,'NULL');
  465:                 } else {
  466:                     push(@MData, $field->{type} eq 'DATETIME' ? 
  467:                         sqltime($mdata->{$fname}) : $mdata->{$fname});
  468:                 }
  469:             } else {
  470:                 push(@MData,undef);
  471:             }
  472:         }
  473:         $sth->execute(@MData);
  474:         if (! $sth->err) {
  475:             $successcount++;
  476:         } else {
  477:             $errors = join(',',$errors,$sth->errstr);
  478:         }
  479:         $errors =~ s/^,//;
  480:     }
  481:     if (wantarray()) {
  482:         return ($successcount,$errors);
  483:     } else {
  484:         return $successcount;
  485:     }
  486: }
  487: 
  488: }
  489: 
  490: ######################################################################
  491: ######################################################################
  492: 
  493: =pod
  494: 
  495: =item lookup_metadata()
  496: 
  497: Inputs: database handle ($dbh) and a hash or hash reference containing 
  498: metadata which will be used for a search.
  499: 
  500: Returns: scalar with error string on failure, array reference on success.
  501: The array reference is the same one returned by $sth->fetchall_arrayref().
  502: 
  503: =cut
  504: 
  505: ######################################################################
  506: ######################################################################
  507: sub lookup_metadata {
  508:     my ($dbh,$condition,$fetchparameter,$tablename) = @_;
  509:     $tablename = 'metadata' if (! defined($tablename));
  510:     my $error;
  511:     my $returnvalue=[];
  512:     my $request = 'SELECT * FROM '.$tablename;
  513:     if (defined($condition)) {
  514:         $request .= ' WHERE '.$condition;
  515:     }
  516:     my $sth = $dbh->prepare($request);
  517:     if ($sth->err) {
  518:         $error = $sth->errstr;
  519:     }
  520:     if (! $error) {
  521:         $sth->execute();
  522:         if ($sth->err) {
  523:             $error = $sth->errstr;
  524:         } else {
  525:             $returnvalue = $sth->fetchall_arrayref($fetchparameter);
  526:             if ($sth->err) {
  527:                 $error = $sth->errstr;
  528:             }
  529:         }
  530:     } 
  531:     return ($error,$returnvalue);
  532: }
  533: 
  534: ######################################################################
  535: ######################################################################
  536: 
  537: =pod
  538: 
  539: =item delete_metadata()
  540: 
  541: Removes a single metadata record, based on its url.
  542: 
  543: Inputs: $dbh, the database handler.
  544: $tablename, the name of the metadata table to remove from. default: 'metadata'
  545: $delitem, the resource to remove from the metadata database, in the form: 
  546:           url = quoted url 
  547: 
  548: Returns: undef on success, dbh errorstr on failure.
  549: 
  550: =cut
  551: 
  552: ######################################################################
  553: ######################################################################
  554: sub delete_metadata {
  555:     my ($dbh,$tablename,$delitem) = @_;
  556:     $tablename = 'metadata' if (! defined($tablename));
  557:     my ($error,$delete_command);
  558:     if ($delitem eq '') {
  559:         $error = 'deletion aborted - no resource specified';    
  560:     } else {
  561:         $delete_command = 'DELETE FROM '.$tablename.' WHERE '.$delitem;
  562:         $dbh->do($delete_command);
  563:         if ($dbh->err) {
  564:             $error = $dbh->errstr();
  565:         }
  566:     }
  567:     return $error;
  568: }
  569: 
  570: ######################################################################
  571: ######################################################################
  572: 
  573: =pod
  574: 
  575: =item update_metadata
  576: 
  577: Updates metadata record in mysql database.  It does not matter if the record
  578: currently exists.  Fields not present in the new metadata will be taken
  579: from the current record, if it exists.  To delete an entry for a key, set 
  580: it to "" or undef.
  581: 
  582: Inputs: 
  583: $dbh, database handle
  584: $newmetadata, hash reference containing the new metadata
  585: $tablename, metadata table name.  Defaults to 'metadata'.
  586: $tabletype, type of table (metadata, portfolio_metadata, portfolio_access, 
  587:                            allusers)
  588: $conditions, optional hash of conditions to use in SQL queries; 
  589:              default used if none provided.
  590: 
  591: Returns:
  592: $error on failure.  undef on success.
  593: 
  594: =cut
  595: 
  596: ######################################################################
  597: ######################################################################
  598: sub update_metadata {
  599:     my ($dbh,$tablename,$tabletype,$newmetadata,$conditions)=@_;
  600:     my ($error,$condition);
  601:     $tablename = 'metadata' if (! defined($tablename));
  602:     $tabletype = 'metadata' if (! defined($tabletype));
  603:     if (ref($conditions) eq 'HASH') {
  604:         my @items;
  605:         foreach my $key (keys(%{$conditions})) {
  606:             if (! exists($newmetadata->{$key})) {
  607:                 $error .= "Unable to update: no $key specified";
  608:             } else {
  609:                 push(@items,"$key = ".$dbh->quote($newmetadata->{$key}));
  610:             }
  611:         }
  612:         $condition = join(' AND ',@items); 
  613:     } else {
  614:         if (! exists($newmetadata->{'url'})) {
  615:             $error = 'Unable to update: no url specified';
  616:         } else {
  617:             $condition = 'url = '.$dbh->quote($newmetadata->{'url'});
  618:         }
  619:     }
  620:     return $error if (defined($error));
  621:     # 
  622:     # Retrieve current values
  623:     my $row;
  624:     ($error,$row) = &lookup_metadata($dbh,$condition,undef,$tablename);
  625:     return $error if ($error);
  626:     my %metadata = &LONCAPA::lonmetadata::metadata_col_to_hash($tabletype,@{$row->[0]});
  627:     #
  628:     # Update metadata values
  629:     while (my ($key,$value) = each(%$newmetadata)) {
  630:         $metadata{$key} = $value;
  631:     }
  632:     #
  633:     # Delete old data (deleting a nonexistant record does not produce an error.
  634:     $error = &delete_metadata($dbh,$tablename,$condition);
  635:     return $error if (defined($error));
  636:     #
  637:     # Store updated metadata
  638:     my $success;
  639:     ($success,$error) = &store_metadata($dbh,$tablename,$tabletype,\%metadata);
  640:     return $error;
  641: }
  642: 
  643: ######################################################################
  644: ######################################################################
  645: 
  646: =pod
  647: 
  648: =item metdata_col_to_hash
  649: 
  650: Input: Array of metadata columns
  651: 
  652: Return: Hash with the metadata columns as keys and the array elements
  653: passed in as values
  654: 
  655: =cut
  656: 
  657: ######################################################################
  658: ######################################################################
  659: sub metadata_col_to_hash {
  660:     my ($tabletype,@cols)=@_;
  661:     my %hash=();
  662:     my ($columns,$indices) = &describe_metadata_storage($tabletype);
  663:     for (my $i=0; $i<@{$columns};$i++) {
  664:         $hash{$columns->[$i]->{'name'}}=$cols[$i];
  665: 	unless ($hash{$columns->[$i]->{'name'}}) {
  666: 	    if ($columns->[$i]->{'type'} eq 'TEXT') {
  667: 		$hash{$columns->[$i]->{'name'}}='';
  668: 	    } elsif ($columns->[$i]->{'type'} eq 'DATETIME') {
  669: 		$hash{$columns->[$i]->{'name'}}='0000-00-00 00:00:00';
  670: 	    } else {
  671: 		$hash{$columns->[$i]->{'name'}}=0;
  672: 	    }
  673: 	}
  674:     }
  675:     return %hash;
  676: }
  677: 
  678: ######################################################################
  679: ######################################################################
  680: 
  681: =pod
  682: 
  683: =item nohist_resevaldata.db data structure
  684: 
  685: The nohist_resevaldata.db file has the following possible keys:
  686: 
  687:  Statistics Data (values are integers, perl times, or real numbers)
  688:  ------------------------------------------
  689:  $course___$resource___avetries
  690:  $course___$resource___count
  691:  $course___$resource___difficulty
  692:  $course___$resource___stdno
  693:  $course___$resource___timestamp
  694: 
  695:  Evaluation Data (values are on a 1 to 5 scale)
  696:  ------------------------------------------
  697:  $username@$dom___$resource___clear
  698:  $username@$dom___$resource___comments
  699:  $username@$dom___$resource___depth
  700:  $username@$dom___$resource___technical
  701:  $username@$dom___$resource___helpful
  702:  $username@$dom___$resource___correct
  703: 
  704:  Course Context Data
  705:  ------------------------------------------
  706:  $course___$resource___course       course id
  707:  $course___$resource___comefrom     resource preceeding this resource
  708:  $course___$resource___goto         resource following this resource
  709:  $course___$resource___usage        resource containing this resource
  710: 
  711:  New statistical data storage
  712:  ------------------------------------------
  713:  $course&$sec&$numstud___$resource___stats
  714:     $sec is a string describing the sections: all, 1 2, 1 2 3,...
  715:     Value is a '&' deliminated list of key=value pairs.
  716:     Possible keys are (currently) disc,course,sections,difficulty, 
  717:     stdno, timestamp
  718: 
  719: =cut
  720: 
  721: ######################################################################
  722: ######################################################################
  723: 
  724: =pod
  725: 
  726: =item &process_reseval_data 
  727: 
  728: Process a nohist_resevaldata hash into a more complex data structure.
  729: 
  730: Input: Hash reference containing reseval data
  731: 
  732: Returns: Hash with the following structure:
  733: 
  734: $hash{$url}->{'statistics'}->{$courseid}->{'avetries'}   = $value
  735: $hash{$url}->{'statistics'}->{$courseid}->{'count'}      = $value
  736: $hash{$url}->{'statistics'}->{$courseid}->{'difficulty'} = $value
  737: $hash{$url}->{'statistics'}->{$courseid}->{'stdno'}      = $value
  738: $hash{$url}->{'statistics'}->{$courseid}->{'timestamp'}  = $value
  739: 
  740: $hash{$url}->{'evaluation'}->{$username}->{'clear'}     = $value
  741: $hash{$url}->{'evaluation'}->{$username}->{'comments'}  = $value
  742: $hash{$url}->{'evaluation'}->{$username}->{'depth'}     = $value
  743: $hash{$url}->{'evaluation'}->{$username}->{'technical'} = $value
  744: $hash{$url}->{'evaluation'}->{$username}->{'helpful'}   = $value
  745: 
  746: $hash{$url}->{'course'}    = \@Courses
  747: $hash{$url}->{'comefrom'}  = \@Resources
  748: $hash{$url}->{'goto'}      = \@Resources
  749: $hash{$url}->{'usage'}     = \@Resources
  750: 
  751: $hash{$url}->{'stats'}->{$courseid\_$section}->{$key} = $value
  752: 
  753: =cut
  754: 
  755: ######################################################################
  756: ######################################################################
  757: sub process_reseval_data {
  758:     my ($evaldata) = @_;
  759:     my %DynamicData;
  760:     #
  761:     # Process every stored element
  762:     while (my ($storedkey,$value) = each(%{$evaldata})) {
  763:         my ($source,$file,$type) = split('___',$storedkey);
  764:         $source = &unescape($source);
  765:         $file = &unescape($file);
  766:         $value = &unescape($value);
  767:          "    got ".$file."\n        ".$type." ".$source."\n";
  768:         if ($type =~ /^(avetries|count|difficulty|stdno|timestamp)$/) {
  769:             #
  770:             # Statistics: $source is course id
  771:             $DynamicData{$file}->{'statistics'}->{$source}->{$type}=$value;
  772:         } elsif ($type =~ /^(clear|comments|depth|technical|helpful|correct)$/){
  773:             #
  774:             # Evaluation $source is username, check if they evaluated it
  775:             # more than once.  If so, pad the entry with a space.
  776:             while(exists($DynamicData{$file}->{'evaluation'}->{$type}->{$source})) {
  777:                 $source .= ' ';
  778:             }
  779:             $DynamicData{$file}->{'evaluation'}->{$type}->{$source}=$value;
  780:         } elsif ($type =~ /^(course|comefrom|goto|usage)$/) {
  781:             #
  782:             # Context $source is course id or resource
  783:             push(@{$DynamicData{$file}->{$type}},&unescape($source));
  784:         } elsif ($type eq 'stats') {
  785:             #
  786:             # Statistics storage...
  787:             # $source is $cid\_$sec\_$stdno
  788:             # $value is stat1=value&stat2=value&stat3=value,....
  789:             #
  790:             my ($cid,$sec,$stdno)=split('&',$source);
  791:             my $crssec = $cid.'&'.$sec;
  792:             my @Data = split('&',$value);
  793:             my %Statistics;
  794:             while (my ($key,$value) = split('=',pop(@Data))) {
  795:                 $Statistics{$key} = $value;
  796:             }
  797:             $sec =~ s:("$|^")::g;
  798:             $Statistics{'sections'} = $sec;
  799:             #
  800:             # Only store the data if the number of students is greater
  801:             # than the data already stored
  802:             if (! exists($DynamicData{$file}->{'stats'}->{$crssec}) ||
  803:                 $DynamicData{$file}->{'stats'}->{$crssec}->{'stdno'}<$stdno){
  804:                 $DynamicData{$file}->{'stats'}->{$crssec}=\%Statistics;
  805:             }
  806:         }
  807:     }
  808:     return %DynamicData;
  809: }
  810: 
  811: 
  812: ######################################################################
  813: ######################################################################
  814: 
  815: =pod
  816: 
  817: =item &process_dynamic_metadata
  818: 
  819: Inputs: $url: the url of the item to process
  820: $DynamicData: hash reference for the results of &process_reseval_data
  821: 
  822: Returns: Hash containing the following keys:
  823:     avetries, avetries_list, difficulty, difficulty_list, stdno, stdno_list,
  824:     course, course_list, goto, goto_list, comefrom, comefrom_list,
  825:     usage, clear, technical, correct, helpful, depth, comments
  826: 
  827:     Each of the return keys is associated with either a number or a string
  828:     The *_list items are comma-seperated strings.  'comments' is a string
  829:     containing generically marked-up comments.
  830: 
  831: =cut
  832: 
  833: ######################################################################
  834: ######################################################################
  835: sub process_dynamic_metadata {
  836:     my ($url,$DynamicData) = @_;
  837:     my %data;
  838:     my $resdata = $DynamicData->{$url};
  839:     #
  840:     # Get the statistical data - Use a weighted average
  841:     foreach my $type (qw/avetries difficulty disc/) {
  842:         my $studentcount;
  843: 	my %course_counted;
  844:         my $sum;
  845:         my @Values;
  846:         my @Students;
  847:         #
  848:         # New data
  849:         if (exists($resdata->{'stats'})) {
  850:             foreach my $identifier (sort(keys(%{$resdata->{'stats'}}))) {
  851:                 my $coursedata = $resdata->{'stats'}->{$identifier};
  852: 		next if (lc($coursedata->{$type}) eq 'nan');
  853: 		$course_counted{$coursedata->{'course'}}++;
  854:                 $studentcount += $coursedata->{'stdno'};
  855:                 $sum += $coursedata->{$type}*$coursedata->{'stdno'};
  856:                 push(@Values,$coursedata->{$type});                
  857:                 push(@Students,$coursedata->{'stdno'});
  858:             }
  859:         }
  860:         #
  861:         # Old data
  862: 	foreach my $course (keys(%{$resdata->{'statistics'}})) {
  863: 	    next if (exists($course_counted{$course}));
  864: 	    my $coursedata = $resdata->{'statistics'}{$course};
  865:             if (ref($coursedata) eq 'HASH' && exists($coursedata->{$type})) {
  866: 		next if (lc($coursedata->{$type}) eq 'nan');
  867:                 $studentcount += $coursedata->{'stdno'};
  868:                 $sum += ($coursedata->{$type}*$coursedata->{'stdno'});
  869:                 push(@Values,$coursedata->{$type});
  870:                 push(@Students,$coursedata->{'stdno'});
  871:             }
  872:         }
  873:         if (defined($studentcount) && $studentcount>0) {
  874:             $data{$type} = $sum/$studentcount;
  875:             $data{$type.'_list'} = join(',',@Values);
  876:         }
  877:     }
  878:     #
  879:     # Find out the number of students who have completed the resource...
  880:     my $stdno;
  881:     my %course_counted;
  882:     if (exists($resdata->{'stats'})) {
  883:         #
  884:         # For the number of students, take the maximum found for the class
  885:         my $current_course;
  886:         my $coursemax=0;
  887:         foreach my $identifier (sort(keys(%{$resdata->{'stats'}}))) {
  888:             my $coursedata = $resdata->{'stats'}->{$identifier};
  889:             if (! defined($current_course)) {
  890:                 $current_course = $coursedata->{'course'};
  891:             }
  892:             if ($current_course ne $coursedata->{'course'}) {
  893:                 $stdno += $coursemax;
  894: 		$course_counted{$coursedata->{'course'}}++;
  895:                 $coursemax = 0;
  896:                 $current_course = $coursedata->{'course'};                
  897:             }
  898:             if ($coursemax < $coursedata->{'stdno'}) {
  899:                 $coursemax = $coursedata->{'stdno'};
  900:             }
  901:         }
  902:         $stdno += $coursemax; # pick up the final course in the list
  903:     }
  904:     # check for old data that has not been run since the format was changed
  905:     foreach my $course (keys(%{$resdata->{'statistics'}})) {
  906: 	next if (exists($course_counted{$course}));
  907: 	my $coursedata = $resdata->{'statistics'}{$course};
  908:         if (ref($coursedata) eq 'HASH' && exists($coursedata->{'stdno'})) {
  909: 	    $stdno += $coursedata->{'stdno'};
  910:         }
  911:     }
  912:     $data{'stdno'}=$stdno;
  913:     #
  914:     # Get the context data
  915:     foreach my $type (qw/course goto comefrom/) {
  916:         if (defined($resdata->{$type}) && 
  917:             ref($resdata->{$type}) eq 'ARRAY') {
  918:             $data{$type} = scalar(@{$resdata->{$type}});
  919:             $data{$type.'_list'} = join(',',@{$resdata->{$type}});
  920:         }
  921:     }
  922: #
  923: # NOTE: usage is named sequsage elsewhere in LON-CAPA
  924: # The translation happens here
  925: #
  926:     if (defined($resdata->{'usage'}) && 
  927:         ref($resdata->{'usage'}) eq 'ARRAY') {
  928:         $data{'sequsage'} = scalar(@{$resdata->{'usage'}});
  929:         $data{'sequsage_list'} = join(',',@{$resdata->{'usage'}});
  930:     }
  931:     #
  932:     # Get the evaluation data
  933:     foreach my $type (qw/clear technical correct helpful depth/) {
  934:         my $count;
  935:         my $sum;
  936:         foreach my $evaluator (keys(%{$resdata->{'evaluation'}->{$type}})){
  937:             $sum += $resdata->{'evaluation'}->{$type}->{$evaluator};
  938:             $count++;
  939:         }
  940:         if ($count > 0) {
  941:             $data{$type}=$sum/$count;
  942:         }
  943:     }
  944:     #
  945:     # put together comments
  946:     my $comments = '';
  947:     foreach my $evaluator (keys(%{$resdata->{'evaluation'}->{'comments'}})){
  948:         $comments .= 
  949:             '<p>'.
  950:             '<b>'.$evaluator.'</b>: '.
  951:             $resdata->{'evaluation'}->{'comments'}->{$evaluator}.
  952:             '</p>';
  953:     }
  954:     if ($comments) {
  955:         $comments = '<div class="LCevalcomments">'
  956:                    .$comments
  957:                    .'</div>';
  958:         $data{'comments'} = $comments;
  959:     }
  960:     #
  961:     if (exists($resdata->{'stats'})) {
  962:         $data{'stats'} = $resdata->{'stats'};
  963:     }
  964:     if (exists($DynamicData->{'domain'})) {
  965:         $data{'domain'} = $DynamicData->{'domain'};
  966:     }
  967:     #
  968:     return %data;
  969: }
  970: 
  971: sub dynamic_metadata_storage {
  972:     my ($data) = @_;
  973:     my %Store;
  974:     my $courseid = $data->{'course'};
  975:     my $sections = $data->{'sections'};
  976:     my $numstu = $data->{'num_students'};
  977:     my $part = $data->{'part'};
  978:     my $symb = $data->{'symb'};
  979:     my $key = $courseid.'&'.$sections.'&'.$numstu.'&'.$part.'___'.$symb.'___stats';
  980:     $Store{$key} =
  981:         'course='.$courseid.'&'.
  982:         'sections='.$sections.'&'.
  983:         'timestamp='.time.'&'.
  984:         'part='.$part.'&'.
  985:         'stdno='.$numstu.'&'.
  986:         'avetries='.$data->{'mean_tries'}.'&'.
  987:         'difficulty='.$data->{'deg_of_diff'}.'&'.
  988:         'disc='.$data->{'deg_of_disc'};
  989:     return %Store;
  990: }
  991: 
  992: ###############################################################
  993: ###############################################################
  994: ###                                                         ###
  995: ###  &portfolio_metadata($filepath,$dom,$uname,$group)      ###
  996: ###   Retrieve metadata for the given file                  ###
  997: ###   Returns array -                                       ###
  998: ###      contains reference to metadatahash and             ###
  999: ###         optional reference to addedfields hash          ###
 1000: ###                                                         ###
 1001: ###############################################################
 1002: ###############################################################
 1003: 
 1004: sub portfolio_metadata {
 1005:     my ($fullpath,$dom,$uname,$group)=@_;
 1006:     my ($mime) = ( $fullpath=~/\.(\w+)$/ );
 1007:     my %metacache=();
 1008:     if ($fullpath !~ /\.meta$/) {
 1009:         $fullpath .= '.meta';
 1010:     }
 1011:     my (@standard_fields,%addedfields);
 1012:     my $colsref = $Portfolio_metadata_table_description;
 1013:     if (ref($colsref) eq 'ARRAY') {
 1014:         my @columns = @{$colsref};
 1015:         foreach my $coldata (@columns) {
 1016:             push(@standard_fields,$coldata->{'name'});
 1017:         }
 1018:     }
 1019:     my $metastring=&getfile($fullpath);
 1020:     if (! defined($metastring)) {
 1021:         $metacache{'keys'}= 'owner,domain,mime';
 1022:         $metacache{'owner'} = $uname.':'.$dom;
 1023:         $metacache{'domain'} = $dom;
 1024:         $metacache{'mime'} = $mime;
 1025:         if ($group ne '') {
 1026:             $metacache{'keys'} .= ',courserestricted';
 1027:             $metacache{'courserestricted'} = 'course.'.$dom.'_'.$uname;
 1028:         }
 1029:     } else {
 1030:         my $parser=HTML::TokeParser->new(\$metastring);
 1031:         my $token;
 1032:         while ($token=$parser->get_token) {
 1033:             if ($token->[0] eq 'S') {
 1034:                 my $entry=$token->[1];
 1035:                 if ($metacache{'keys'}) {
 1036:                     $metacache{'keys'}.=','.$entry;
 1037:                 } else {
 1038:                     $metacache{'keys'}=$entry;
 1039:                 }
 1040:                 my $value = $parser->get_text('/'.$entry);
 1041:                 if (!grep(/^\Q$entry\E$/,@standard_fields)) {
 1042:                     my $clean_value = lc($value);
 1043:                     $clean_value =~ s/\s/_/g;
 1044:                     if ($clean_value ne $entry) {
 1045:                         if (defined($addedfields{$entry})) {
 1046:                             $addedfields{$entry} .=','.$value;
 1047:                         } else {
 1048:                             $addedfields{$entry} = $value;
 1049:                         }
 1050:                     }
 1051:                 } else {
 1052:                     $metacache{$entry} = $value;
 1053:                 }
 1054:             }
 1055:         } # End of ($token->[0] eq 'S')
 1056: 
 1057: 	if (!exists($metacache{'domain'})) {
 1058: 	    $metacache{'domain'} = $dom;
 1059: 	}
 1060:     }
 1061:     return (\%metacache,$metacache{'courserestricted'},\%addedfields);
 1062: }
 1063: 
 1064: sub process_portfolio_access_data {
 1065:     my ($dbh,$simulate,$newnames,$url,$fullpath,$access_hash,$caller) = @_;
 1066:     my %loghash;
 1067:     if ($caller eq 'update') {
 1068:         # Delete old data (no error if deleting non-existent record).
 1069:         my $error;
 1070:         if ($url eq '') {
 1071:             $error = 'No url specified'; 
 1072:         } else {
 1073:             my $delitem = 'url = '.$dbh->quote($url);
 1074:             $error=&delete_metadata($dbh,$newnames->{'access'},$delitem);
 1075:         }
 1076:         if (defined($error)) {
 1077:             $loghash{'access'}{'err'} = "MySQL Error Delete: ".$error;
 1078:             return %loghash;
 1079:         }
 1080:     }
 1081:     # Check the file exists
 1082:     if (-e $fullpath) {
 1083:         foreach my $key (keys(%{$access_hash})) {
 1084:             my $acc_data;
 1085:             $acc_data->{url} = $url;
 1086:             $acc_data->{keynum} = $key;
 1087:             my ($num,$scope,$end,$start) =
 1088:                             ($key =~ /^([^:]+):([a-z]+)_(\d*)_?(\d*)$/);
 1089:             next if (($scope ne 'public') && ($scope ne 'guest'));
 1090:             $acc_data->{scope} = $scope;
 1091:             my $sqltime_error;
 1092:             if ($end != 0) {
 1093:                 $acc_data->{end} = &sqltime($end,\$sqltime_error);
 1094:             }
 1095:             $acc_data->{start} = &sqltime($start,\$sqltime_error);
 1096:             if ($sqltime_error) {
 1097:                 $loghash{$key}{'err'} = $sqltime_error;
 1098:             }
 1099:             if (! $simulate) {
 1100:                 my ($count,$err) =
 1101:                      &store_metadata($dbh,$newnames->{'access'},
 1102:                                      'portfolio_access',$acc_data);
 1103:                 if ($err) {
 1104:                     $loghash{$key}{'err'} = "MySQL Error Insert: ".$err;
 1105:                 }
 1106:                 if ($count < 1) {
 1107:                     $loghash{$key}{'count'} = 
 1108:                         "Unable to insert record into MySQL database for $url";
 1109:                 }
 1110:             }
 1111:         }
 1112:     }
 1113:     return %loghash;
 1114: }
 1115: 
 1116: sub process_portfolio_metadata {
 1117:     my ($dbh,$simulate,$newnames,$url,$fullpath,$is_course,$dom,$uname,$group,$caller) = @_;
 1118:     my %loghash;
 1119:     if ($caller eq 'update') {
 1120:         # Delete old data (no error if deleting non-existent record).
 1121:         my ($error,$delitem);
 1122:         if ($url eq '') {
 1123:             $error = 'No url specified';
 1124:         } else {
 1125:             $delitem = 'url = '.$dbh->quote($url);
 1126:             $error=&delete_metadata($dbh,$newnames->{'portfolio'},$delitem);
 1127:         }
 1128:         if (defined($error)) {
 1129:             $loghash{'metadata'}{'err'} = "MySQL Error delete metadata: ".
 1130:                                                $error;
 1131:             return %loghash;
 1132:         }
 1133:         $error=&delete_metadata($dbh,$newnames->{'addedfields'},$delitem);
 1134:         if (defined($error)) {
 1135:             $loghash{'addedfields'}{'err'}="MySQL Error delete addedfields: ".$error;
 1136:         }
 1137:     }
 1138:     # Check the file exists.
 1139:     if (-e $fullpath) {
 1140:         my ($ref,$crs,$addedfields) = &portfolio_metadata($fullpath,$dom,$uname,
 1141:                                                           $group);
 1142:         my $sqltime_error;
 1143:         &getfiledates($ref,$fullpath,\$sqltime_error);
 1144:         if ($is_course) {
 1145:             $ref->{'groupname'} = $group;
 1146:         }
 1147:         my %Data;
 1148:         if (ref($ref) eq 'HASH') {
 1149:             %Data = %{$ref};
 1150:         }
 1151:         %Data = (
 1152:                  %Data,
 1153:                  'url'=>$url,
 1154:                  'version'=>'current',
 1155:         );
 1156:         my %loghash;
 1157:         if (! $simulate) {
 1158:             if ($sqltime_error) {
 1159:                 $loghash{'metadata'."\0"}{'err'} = $sqltime_error;
 1160:             }
 1161:             my ($count,$err) =
 1162:             &store_metadata($dbh,$newnames->{'portfolio'},'portfolio_metadata',
 1163:                             \%Data);
 1164:             if ($err) {
 1165:                 $loghash{'metadata'."\0"}{'err'} = "MySQL Error Insert: ".$err;
 1166:             }
 1167:             if ($count < 1) {
 1168:                 $loghash{'metadata'."\0"}{'count'} = "Unable to insert record into MySQL portfolio_metadata database table for $url";
 1169:             }
 1170:             if (ref($addedfields) eq 'HASH') {
 1171:                 if (keys(%{$addedfields}) > 0) {
 1172:                     foreach my $key (keys(%{$addedfields})) {
 1173:                         my $added_data = {
 1174:                                     'url'   => $url,
 1175:                                     'field' => $key,
 1176:                                     'value' => $addedfields->{$key},
 1177:                                     'courserestricted' => $crs,
 1178:                         };
 1179:                         my ($count,$err) = 
 1180:                             &store_metadata($dbh,$newnames->{'addedfields'},
 1181:                                    'portfolio_addedfields',$added_data);
 1182:                         if ($err) {
 1183:                             $loghash{$key}{'err'} = 
 1184:                                 "MySQL Error Insert: ".$err;
 1185:                         }
 1186:                         if ($count < 1) {
 1187:                             $loghash{$key}{'count'} = "Unable to insert record into MySQL portfolio_addedfields database table for url = $url and field = $key";
 1188:                         }
 1189:                     }
 1190:                 }
 1191:             }
 1192:         }
 1193:     }
 1194:     return %loghash;
 1195: }
 1196: 
 1197: sub process_allusers_data {
 1198:     my ($dbh,$simulate,$newnames,$uname,$udom,$userdata,$caller) = @_;
 1199:     my %loghash;
 1200:     if ($caller eq 'update') {
 1201:         # Delete old data (no error if deleting non-existent record).
 1202:         my ($error,$delitem);
 1203:         if ($udom eq '' || $uname eq '' ) {
 1204:             $error = 'No domain and/or username specified';
 1205:         } else {
 1206:             $delitem = 'domain = '.$dbh->quote($udom).' AND username '.
 1207:                        'COLLATE latin1_general_cs = '.$dbh->quote($uname);
 1208:             $error=&delete_metadata($dbh,$newnames->{'allusers'},$delitem);
 1209:         }
 1210:         if (defined($error)) {
 1211:             $loghash{'err'} = 'MySQL Error in allusers delete: '.$error;
 1212:             return %loghash;
 1213:         }
 1214:     }
 1215:     if (!$simulate) {
 1216:         if ($udom ne '' && $uname ne '') {
 1217:             my ($count,$err) = &store_metadata($dbh,$newnames->{'allusers'},
 1218:                                                'allusers',$userdata);
 1219:             if ($err) {
 1220:                 $loghash{'err'} = 'MySQL Error in allusers insert: '.$err;
 1221:             }
 1222:             if ($count < 1) {
 1223:                 $loghash{'count'} = 
 1224:                     'Unable to insert record into MySQL allusers database for '.
 1225:                     $uname.' in '.$udom;
 1226:             }
 1227:         } else {
 1228:             $loghash{'err'} = 
 1229:                 'MySQL Error allusrs insert: missing username and/or domain';
 1230:         }
 1231:     }
 1232:     return %loghash;
 1233: }
 1234: 
 1235: ######################################################################
 1236: ######################################################################
 1237: 
 1238: sub getfile {
 1239:     my $file = shift();
 1240:     if (! -e $file ) { 
 1241:         return undef; 
 1242:     }
 1243:     open(my $fh,"<$file");
 1244:     my $contents = '';
 1245:     while (<$fh>) { 
 1246:         $contents .= $_;
 1247:     }
 1248:     return $contents;
 1249: }
 1250: 
 1251: ##
 1252: ## &getfiledates($ref,$target,$sqltime_error)
 1253: ## Converts creationdate and modifieddates to SQL format
 1254: ## Applies stat() to file to retrieve dates if missing
 1255: sub getfiledates {
 1256:     my ($ref,$target,$sqltime_error) = @_;
 1257:     if (! defined($ref->{'creationdate'}) ||
 1258:         $ref->{'creationdate'} =~ /^\s*$/) {
 1259:         $ref->{'creationdate'} = (stat($target))[9];
 1260:     }
 1261:     if (! defined($ref->{'lastrevisiondate'}) ||
 1262:         $ref->{'lastrevisiondate'} =~ /^\s*$/) {
 1263:         $ref->{'lastrevisiondate'} = (stat($target))[9];
 1264:     }
 1265:     $ref->{'creationdate'}     = &sqltime($ref->{'creationdate'},$sqltime_error);
 1266:     $ref->{'lastrevisiondate'} = &sqltime($ref->{'lastrevisiondate'},$sqltime_error);
 1267: }
 1268:  
 1269: ##
 1270: ## &sqltime($timestamp,$sqltime_error)
 1271: ##
 1272: ## Convert perl $timestamp to MySQL time.  MySQL expects YYYY-MM-DD HH:MM:SS
 1273: ##
 1274: sub sqltime {
 1275:     my ($time,$sqltime_error) = @_;
 1276:     my $mysqltime;
 1277:     if ($time =~
 1278:         /(\d+)-(\d+)-(\d+) # YYYY-MM-DD
 1279:         \s                 # a space
 1280:         (\d+):(\d+):(\d+)  # HH:MM::SS
 1281:         /x ) {
 1282:         # Some of the .meta files have the time in mysql
 1283:         # format already, so just make sure they are 0 padded and
 1284:         # pass them back.
 1285:         $mysqltime = sprintf('%04d-%02d-%02d %02d:%02d:%02d',
 1286:                              $1,$2,$3,$4,$5,$6);
 1287:     } elsif ($time =~ /^\d+$/) {
 1288:         my @TimeData = gmtime($time);
 1289:         # Alter the month to be 1-12 instead of 0-11
 1290:         $TimeData[4]++;
 1291:         # Alter the year to be from 0 instead of from 1900
 1292:         $TimeData[5]+=1900;
 1293:         $mysqltime = sprintf('%04d-%02d-%02d %02d:%02d:%02d',
 1294:                              @TimeData[5,4,3,2,1,0]);
 1295:     } elsif (! defined($time) || $time == 0) {
 1296:         $mysqltime = 0;
 1297:     } else {
 1298:         if (ref($sqltime_error) eq 'SCALAR') {
 1299:             $$sqltime_error = "sqltime:Unable to decode time ".$time;
 1300:         }
 1301:         $mysqltime = 0;
 1302:     }
 1303:     return $mysqltime;
 1304: }
 1305: 
 1306: ######################################################################
 1307: ######################################################################
 1308: ##
 1309: ## The usual suspects, repeated here to reduce dependency hell
 1310: ##
 1311: ######################################################################
 1312: ######################################################################
 1313: sub unescape {
 1314:     my $str=shift;
 1315:     $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
 1316:     return $str;
 1317: }
 1318: 
 1319: sub escape {
 1320:     my $str=shift;
 1321:     $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
 1322:     return $str;
 1323: }
 1324: 
 1325: 1;
 1326: 
 1327: __END__;
 1328: 
 1329: =pod
 1330: 
 1331: =back
 1332: 
 1333: =cut

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