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

1.1       matthew     1: # The LearningOnline Network with CAPA
                      2: #
1.36    ! www         3: # $Id: lonmetadata.pm,v 1.35 2012/03/14 20:53:56 www 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.16      raeburn    33: use HTML::TokeParser;
1.14      raeburn    34: use vars qw($Metadata_Table_Description $Portfolio_metadata_table_description 
1.23      raeburn    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);
1.1       matthew    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, 
1.12      matthew    81: domain TEXT
1.1       matthew    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: 
1.32      raeburn    96: ENGINE=MYISAM;
1.1       matthew    97: 
                     98: =cut
                     99: 
                    100: ######################################################################
                    101: ######################################################################
1.14      raeburn   102: $Metadata_Table_Description = 
                    103:     [
1.1       matthew   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'}, 
1.12      matthew   118:      { name => 'domain',    type=>'TEXT'},
1.1       matthew   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'},
1.9       matthew   141:      { name => 'disc',           type=>'FLOAT'},
                    142:      { name => 'disc_list',      type=>'TEXT'},
1.1       matthew   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:      #--------------------------------------------------
1.14      raeburn   150:     ];
1.1       matthew   151: 
1.14      raeburn   152: $Fulltext_indicies = [ qw/ 
1.1       matthew   153:     title
                    154:     author
                    155:     subject
                    156:     url
                    157:     keywords
                    158:     version
                    159:     notes
                    160:     abstract
                    161:     mime
                    162:     language
                    163:     owner
1.14      raeburn   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/];
1.1       matthew   229: 
                    230: ######################################################################
                    231: ######################################################################
                    232: 
1.14      raeburn   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: 
1.23      raeburn   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: ######################################################################
1.14      raeburn   270: 
1.1       matthew   271: =pod
                    272: 
                    273: =item &describe_metadata_storage
                    274: 
                    275: Input: None
                    276: 
1.2       matthew   277: Returns: An array of hash references describing the columns and indicies
                    278: of the metadata table(s).
1.1       matthew   279: 
                    280: =cut
                    281: 
                    282: ######################################################################
                    283: ######################################################################
1.14      raeburn   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, 
1.23      raeburn   291:         allusers              => $Allusers_table_description,
1.14      raeburn   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,
1.23      raeburn   298:         allusers              => $Allusers_indices,
1.14      raeburn   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:     }
1.1       matthew   316: }
                    317: 
                    318: ######################################################################
                    319: ######################################################################
                    320: 
                    321: =pod
                    322: 
                    323: =item create_metadata_storage()
                    324: 
1.3       matthew   325: Inputs: table name (optional): the name of the table.  Default is 'metadata'.
1.1       matthew   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 { 
1.14      raeburn   335:     my ($tablename,$tabletype) = @_;
1.3       matthew   336:     $tablename = 'metadata' if (! defined($tablename));
1.14      raeburn   337:     $tabletype = 'metadata' if (! defined($tabletype));
1.1       matthew   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
1.14      raeburn   343:     my ($table_columns,$table_indices) = 
                    344:                           &describe_metadata_storage($tabletype);
                    345:     my %coltype;
                    346:     foreach my $coldata (@{$table_columns}) {
1.1       matthew   347:         my $column = $coldata->{'name'};
1.14      raeburn   348:         $coltype{$column} = $coldata->{'type'};
1.1       matthew   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:         }
1.30      raeburn   359:         if (($tablename =~ /allusers/) && ($column eq 'username')) {  
1.31      raeburn   360:             $col_des .= ' CHARACTER SET latin1 COLLATE latin1_general_cs';
1.30      raeburn   361:         }
1.1       matthew   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:     }
1.14      raeburn   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.')';
1.1       matthew   385:         push (@Columns,$text);
                    386:     }
1.33      raeburn   387:     $request .= "(".join(", ",@Columns).") ENGINE=MyISAM";
1.1       matthew   388:     return $request;
                    389: }
                    390: 
                    391: ######################################################################
                    392: ######################################################################
                    393: 
                    394: =pod
                    395: 
                    396: =item store_metadata()
                    397: 
1.14      raeburn   398: Inputs: database handle ($dbh), a table name, table type and a hash or hash 
                    399: reference containing the metadata for a single resource.
1.1       matthew   400: 
                    401: Returns: 1 on success, 0 on failure to store.
                    402: 
                    403: =cut
                    404: 
                    405: ######################################################################
                    406: ######################################################################
1.2       matthew   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
1.14      raeburn   415:     ##  is annoying but $sth apparently does not have a link back to the 
1.2       matthew   416:     ##  $dbh, so we can't check our validity.
                    417:     ##
                    418:     my $sth = undef;
1.4       matthew   419:     my $sth_table = undef;
1.2       matthew   420: 
                    421: sub create_statement_handler {
1.14      raeburn   422:     my ($dbh,$tablename,$tabletype) = @_;
1.4       matthew   423:     $tablename = 'metadata' if (! defined($tablename));
1.14      raeburn   424:     $tabletype = 'metadata' if (! defined($tabletype));
                    425:     my ($table_columns,$table_indices) = 
                    426:           &describe_metadata_storage($tabletype);
1.4       matthew   427:     $sth_table = $tablename;
                    428:     my $request = 'INSERT INTO '.$tablename.' VALUES(';
1.14      raeburn   429:     foreach (@{$table_columns}) {
1.2       matthew   430:         $request .= '?,';
                    431:     }
                    432:     chop $request;
                    433:     $request.= ')';
                    434:     $sth = $dbh->prepare($request);
                    435:     return;
                    436: }
                    437: 
1.4       matthew   438: sub clear_sth { $sth=undef; $sth_table=undef;}
1.2       matthew   439: 
1.1       matthew   440: sub store_metadata {
1.14      raeburn   441:     my ($dbh,$tablename,$tabletype,@Metadata)=@_;
1.2       matthew   442:     my $errors = '';
1.4       matthew   443:     if (! defined($sth) || 
                    444:         ( defined($tablename) && ($sth_table ne $tablename)) || 
                    445:         (! defined($tablename) && $sth_table ne 'metadata')) {
1.14      raeburn   446:         &create_statement_handler($dbh,$tablename,$tabletype);
1.2       matthew   447:     }
                    448:     my $successcount = 0;
1.14      raeburn   449:     if (! defined($tabletype)) {
                    450:         $tabletype = 'metadata';
                    451:     }
                    452:     my ($table_columns,$table_indices) = 
                    453:                         &describe_metadata_storage($tabletype);
1.10      matthew   454:     foreach my $mdata (@Metadata) {
1.2       matthew   455:         next if (ref($mdata) ne "HASH");
                    456:         my @MData;
1.14      raeburn   457:         foreach my $field (@{$table_columns}) {
1.10      matthew   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 '') {
1.5       matthew   464:                     push(@MData,'NULL');
                    465:                 } else {
1.34      droeschl  466:                     push(@MData, $field->{type} eq 'DATETIME' ? 
                    467:                         sqltime($mdata->{$fname}) : $mdata->{$fname});
1.5       matthew   468:                 }
1.2       matthew   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:         }
1.10      matthew   479:         $errors =~ s/^,//;
1.2       matthew   480:     }
                    481:     if (wantarray()) {
                    482:         return ($successcount,$errors);
                    483:     } else {
                    484:         return $successcount;
                    485:     }
                    486: }
1.1       matthew   487: 
                    488: }
                    489: 
                    490: ######################################################################
                    491: ######################################################################
                    492: 
                    493: =pod
                    494: 
1.24      albertel  495: =item lookup_metadata()
1.1       matthew   496: 
                    497: Inputs: database handle ($dbh) and a hash or hash reference containing 
                    498: metadata which will be used for a search.
                    499: 
1.2       matthew   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().
1.1       matthew   502: 
                    503: =cut
                    504: 
                    505: ######################################################################
                    506: ######################################################################
1.2       matthew   507: sub lookup_metadata {
1.10      matthew   508:     my ($dbh,$condition,$fetchparameter,$tablename) = @_;
                    509:     $tablename = 'metadata' if (! defined($tablename));
1.2       matthew   510:     my $error;
                    511:     my $returnvalue=[];
1.10      matthew   512:     my $request = 'SELECT * FROM '.$tablename;
1.2       matthew   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:         }
1.16      raeburn   530:     } 
1.2       matthew   531:     return ($error,$returnvalue);
                    532: }
1.1       matthew   533: 
                    534: ######################################################################
                    535: ######################################################################
                    536: 
                    537: =pod
                    538: 
                    539: =item delete_metadata()
                    540: 
1.10      matthew   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'
1.23      raeburn   545: $delitem, the resource to remove from the metadata database, in the form: 
                    546:           url = quoted url 
1.10      matthew   547: 
                    548: Returns: undef on success, dbh errorstr on failure.
                    549: 
                    550: =cut
                    551: 
                    552: ######################################################################
                    553: ######################################################################
                    554: sub delete_metadata {
1.23      raeburn   555:     my ($dbh,$tablename,$delitem) = @_;
1.10      matthew   556:     $tablename = 'metadata' if (! defined($tablename));
1.23      raeburn   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:         }
1.10      matthew   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'.
1.23      raeburn   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.
1.10      matthew   590: 
                    591: Returns:
                    592: $error on failure.  undef on success.
1.1       matthew   593: 
                    594: =cut
                    595: 
                    596: ######################################################################
                    597: ######################################################################
1.10      matthew   598: sub update_metadata {
1.23      raeburn   599:     my ($dbh,$tablename,$tabletype,$newmetadata,$conditions)=@_;
                    600:     my ($error,$condition);
1.10      matthew   601:     $tablename = 'metadata' if (! defined($tablename));
1.14      raeburn   602:     $tabletype = 'metadata' if (! defined($tabletype));
1.23      raeburn   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:         }
1.10      matthew   619:     }
                    620:     return $error if (defined($error));
                    621:     # 
                    622:     # Retrieve current values
                    623:     my $row;
1.23      raeburn   624:     ($error,$row) = &lookup_metadata($dbh,$condition,undef,$tablename);
1.10      matthew   625:     return $error if ($error);
1.14      raeburn   626:     my %metadata = &LONCAPA::lonmetadata::metadata_col_to_hash($tabletype,@{$row->[0]});
1.10      matthew   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.
1.23      raeburn   634:     $error = &delete_metadata($dbh,$tablename,$condition);
1.10      matthew   635:     return $error if (defined($error));
                    636:     #
                    637:     # Store updated metadata
                    638:     my $success;
1.14      raeburn   639:     ($success,$error) = &store_metadata($dbh,$tablename,$tabletype,\%metadata);
1.10      matthew   640:     return $error;
                    641: }
1.1       matthew   642: 
                    643: ######################################################################
                    644: ######################################################################
1.5       matthew   645: 
1.6       matthew   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 {
1.14      raeburn   660:     my ($tabletype,@cols)=@_;
1.6       matthew   661:     my %hash=();
1.14      raeburn   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';
1.13      www       670: 	    } else {
1.14      raeburn   671: 		$hash{$columns->[$i]->{'name'}}=0;
1.13      www       672: 	    }
                    673: 	}
1.6       matthew   674:     }
                    675:     return %hash;
                    676: }
1.5       matthew   677: 
                    678: ######################################################################
                    679: ######################################################################
                    680: 
                    681: =pod
                    682: 
1.8       matthew   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
1.11      www       702:  $username@$dom___$resource___correct
1.8       matthew   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: 
1.5       matthew   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;
1.11      www       772:         } elsif ($type =~ /^(clear|comments|depth|technical|helpful|correct)$/){
1.5       matthew   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:             #
1.8       matthew   790:             my ($cid,$sec,$stdno)=split('&',$source);
                    791:             my $crssec = $cid.'&'.$sec;
1.5       matthew   792:             my @Data = split('&',$value);
                    793:             my %Statistics;
                    794:             while (my ($key,$value) = split('=',pop(@Data))) {
                    795:                 $Statistics{$key} = $value;
                    796:             }
1.8       matthew   797:             $sec =~ s:("$|^")::g;
                    798:             $Statistics{'sections'} = $sec;
1.5       matthew   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:     #
1.8       matthew   840:     # Get the statistical data - Use a weighted average
                    841:     foreach my $type (qw/avetries difficulty disc/) {
                    842:         my $studentcount;
1.21      albertel  843: 	my %course_counted;
1.5       matthew   844:         my $sum;
                    845:         my @Values;
1.8       matthew   846:         my @Students;
1.5       matthew   847:         #
1.21      albertel  848:         # New data
1.8       matthew   849:         if (exists($resdata->{'stats'})) {
                    850:             foreach my $identifier (sort(keys(%{$resdata->{'stats'}}))) {
                    851:                 my $coursedata = $resdata->{'stats'}->{$identifier};
1.21      albertel  852: 		next if (lc($coursedata->{$type}) eq 'nan');
                    853: 		$course_counted{$coursedata->{'course'}}++;
1.8       matthew   854:                 $studentcount += $coursedata->{'stdno'};
                    855:                 $sum += $coursedata->{$type}*$coursedata->{'stdno'};
                    856:                 push(@Values,$coursedata->{$type});                
                    857:                 push(@Students,$coursedata->{'stdno'});
                    858:             }
                    859:         }
                    860:         #
1.21      albertel  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:         }
1.8       matthew   873:         if (defined($studentcount) && $studentcount>0) {
                    874:             $data{$type} = $sum/$studentcount;
1.5       matthew   875:             $data{$type.'_list'} = join(',',@Values);
                    876:         }
                    877:     }
                    878:     #
1.8       matthew   879:     # Find out the number of students who have completed the resource...
                    880:     my $stdno;
1.20      albertel  881:     my %course_counted;
1.8       matthew   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;
1.20      albertel  894: 		$course_counted{$coursedata->{'course'}}++;
1.8       matthew   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:     }
1.20      albertel  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:     }
1.8       matthew   912:     $data{'stdno'}=$stdno;
                    913:     #
1.5       matthew   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:     }
1.35      www       922: #
                    923: # NOTE: usage is named sequsage elsewhere in LON-CAPA
                    924: # The translation happens here
                    925: #
1.5       matthew   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
1.26      bisitz    946:     my $comments = '';
1.5       matthew   947:     foreach my $evaluator (keys(%{$resdata->{'evaluation'}->{'comments'}})){
1.7       matthew   948:         $comments .= 
                    949:             '<p>'.
1.26      bisitz    950:             '<b>'.$evaluator.'</b>: '.
1.7       matthew   951:             $resdata->{'evaluation'}->{'comments'}->{$evaluator}.
                    952:             '</p>';
1.5       matthew   953:     }
1.26      bisitz    954:     if ($comments) {
                    955:         $comments = '<div class="LCevalcomments">'
                    956:                    .$comments
                    957:                    .'</div>';
1.27      bisitz    958:         $data{'comments'} = $comments;
1.26      bisitz    959:     }
1.5       matthew   960:     #
1.8       matthew   961:     if (exists($resdata->{'stats'})) {
                    962:         $data{'stats'} = $resdata->{'stats'};
                    963:     }
1.12      matthew   964:     if (exists($DynamicData->{'domain'})) {
                    965:         $data{'domain'} = $DynamicData->{'domain'};
                    966:     }
1.8       matthew   967:     #
1.5       matthew   968:     return %data;
                    969: }
                    970: 
1.8       matthew   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'};
1.36    ! www       977:     my $part = $data->{'part'};
        !           978:     my $symb = $data->{'symb'};
        !           979:     my $key = $courseid.'&'.$sections.'&'.$numstu.'&'.$part.'___'.$symb.'___stats';
1.8       matthew   980:     $Store{$key} =
                    981:         'course='.$courseid.'&'.
                    982:         'sections='.$sections.'&'.
                    983:         'timestamp='.time.'&'.
1.36    ! www       984:         'part='.$part.'&'.
        !           985:         'stdno='.$numstu.'&'.
1.8       matthew   986:         'avetries='.$data->{'mean_tries'}.'&'.
1.36    ! www       987:         'difficulty='.$data->{'deg_of_diff'}.'&'.
        !           988:         'disc='.$data->{'deg_of_disc'};
1.8       matthew   989:     return %Store;
                    990: }
1.6       matthew   991: 
1.16      raeburn   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')
1.22      albertel 1056: 
                   1057: 	if (!exists($metacache{'domain'})) {
                   1058: 	    $metacache{'domain'} = $dom;
                   1059: 	}
1.16      raeburn  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).
1.23      raeburn  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:         }
1.16      raeburn  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;
1.28      raeburn  1091:             my $sqltime_error;
1.16      raeburn  1092:             if ($end != 0) {
1.28      raeburn  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;
1.16      raeburn  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).
1.23      raeburn  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:         }
1.16      raeburn  1128:         if (defined($error)) {
                   1129:             $loghash{'metadata'}{'err'} = "MySQL Error delete metadata: ".
                   1130:                                                $error;
                   1131:             return %loghash;
                   1132:         }
1.23      raeburn  1133:         $error=&delete_metadata($dbh,$newnames->{'addedfields'},$delitem);
1.16      raeburn  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);
1.28      raeburn  1142:         my $sqltime_error;
                   1143:         &getfiledates($ref,$fullpath,\$sqltime_error);
1.16      raeburn  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) {
1.28      raeburn  1158:             if ($sqltime_error) {
                   1159:                 $loghash{'metadata'."\0"}{'err'} = $sqltime_error;
                   1160:             }
1.16      raeburn  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: 
1.23      raeburn  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 {
1.25      raeburn  1206:             $delitem = 'domain = '.$dbh->quote($udom).' AND username '.
                   1207:                        'COLLATE latin1_general_cs = '.$dbh->quote($uname);
1.23      raeburn  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: 
1.5       matthew  1235: ######################################################################
                   1236: ######################################################################
1.14      raeburn  1237: 
1.16      raeburn  1238: sub getfile {
                   1239:     my $file = shift();
                   1240:     if (! -e $file ) { 
                   1241:         return undef; 
                   1242:     }
1.17      albertel 1243:     open(my $fh,"<$file");
1.16      raeburn  1244:     my $contents = '';
                   1245:     while (<$fh>) { 
                   1246:         $contents .= $_;
                   1247:     }
                   1248:     return $contents;
                   1249: }
                   1250: 
                   1251: ##
1.28      raeburn  1252: ## &getfiledates($ref,$target,$sqltime_error)
1.16      raeburn  1253: ## Converts creationdate and modifieddates to SQL format
                   1254: ## Applies stat() to file to retrieve dates if missing
                   1255: sub getfiledates {
1.28      raeburn  1256:     my ($ref,$target,$sqltime_error) = @_;
1.16      raeburn  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:     }
1.28      raeburn  1265:     $ref->{'creationdate'}     = &sqltime($ref->{'creationdate'},$sqltime_error);
                   1266:     $ref->{'lastrevisiondate'} = &sqltime($ref->{'lastrevisiondate'},$sqltime_error);
1.16      raeburn  1267: }
                   1268:  
1.15      raeburn  1269: ##
1.28      raeburn  1270: ## &sqltime($timestamp,$sqltime_error)
1.15      raeburn  1271: ##
                   1272: ## Convert perl $timestamp to MySQL time.  MySQL expects YYYY-MM-DD HH:MM:SS
                   1273: ##
                   1274: sub sqltime {
1.28      raeburn  1275:     my ($time,$sqltime_error) = @_;
1.15      raeburn  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 {
1.28      raeburn  1298:         if (ref($sqltime_error) eq 'SCALAR') {
                   1299:             $$sqltime_error = "sqltime:Unable to decode time ".$time;
                   1300:         }
1.15      raeburn  1301:         $mysqltime = 0;
                   1302:     }
                   1303:     return $mysqltime;
                   1304: }
1.14      raeburn  1305: 
                   1306: ######################################################################
                   1307: ######################################################################
1.5       matthew  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: }
1.6       matthew  1324: 
1.1       matthew  1325: 1;
                   1326: 
                   1327: __END__;
                   1328: 
                   1329: =pod
                   1330: 
                   1331: =back
                   1332: 
                   1333: =cut

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