Annotation of loncom/metadata_database/LONCAPA/lonmetadata.pm, revision 1.37
1.1 matthew 1: # The LearningOnline Network with CAPA
2: #
1.37 ! www 3: # $Id: lonmetadata.pm,v 1.36 2012/03/15 20:53:27 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})) {
1.37 ! www 763: my (@keycomponents) = split('___',$storedkey);
! 764: my $type=pop(@keycomponents);
! 765: my $file=&unescape(pop(@keycomponents));
! 766: my $source = &unescape(join('___',@keycomponents));
1.5 matthew 767: $file = &unescape($file);
768: $value = &unescape($value);
769: if ($type =~ /^(avetries|count|difficulty|stdno|timestamp)$/) {
770: #
771: # Statistics: $source is course id
772: $DynamicData{$file}->{'statistics'}->{$source}->{$type}=$value;
1.11 www 773: } elsif ($type =~ /^(clear|comments|depth|technical|helpful|correct)$/){
1.5 matthew 774: #
775: # Evaluation $source is username, check if they evaluated it
776: # more than once. If so, pad the entry with a space.
777: while(exists($DynamicData{$file}->{'evaluation'}->{$type}->{$source})) {
778: $source .= ' ';
779: }
780: $DynamicData{$file}->{'evaluation'}->{$type}->{$source}=$value;
781: } elsif ($type =~ /^(course|comefrom|goto|usage)$/) {
782: #
783: # Context $source is course id or resource
784: push(@{$DynamicData{$file}->{$type}},&unescape($source));
785: } elsif ($type eq 'stats') {
786: #
787: # Statistics storage...
788: # $source is $cid\_$sec\_$stdno
789: # $value is stat1=value&stat2=value&stat3=value,....
790: #
1.8 matthew 791: my ($cid,$sec,$stdno)=split('&',$source);
792: my $crssec = $cid.'&'.$sec;
1.5 matthew 793: my @Data = split('&',$value);
794: my %Statistics;
795: while (my ($key,$value) = split('=',pop(@Data))) {
796: $Statistics{$key} = $value;
797: }
1.8 matthew 798: $sec =~ s:("$|^")::g;
799: $Statistics{'sections'} = $sec;
1.5 matthew 800: #
801: # Only store the data if the number of students is greater
802: # than the data already stored
803: if (! exists($DynamicData{$file}->{'stats'}->{$crssec}) ||
804: $DynamicData{$file}->{'stats'}->{$crssec}->{'stdno'}<$stdno){
805: $DynamicData{$file}->{'stats'}->{$crssec}=\%Statistics;
806: }
807: }
808: }
809: return %DynamicData;
810: }
811:
812:
813: ######################################################################
814: ######################################################################
815:
816: =pod
817:
818: =item &process_dynamic_metadata
819:
820: Inputs: $url: the url of the item to process
821: $DynamicData: hash reference for the results of &process_reseval_data
822:
823: Returns: Hash containing the following keys:
824: avetries, avetries_list, difficulty, difficulty_list, stdno, stdno_list,
825: course, course_list, goto, goto_list, comefrom, comefrom_list,
826: usage, clear, technical, correct, helpful, depth, comments
827:
828: Each of the return keys is associated with either a number or a string
829: The *_list items are comma-seperated strings. 'comments' is a string
830: containing generically marked-up comments.
831:
832: =cut
833:
834: ######################################################################
835: ######################################################################
836: sub process_dynamic_metadata {
837: my ($url,$DynamicData) = @_;
838: my %data;
839: my $resdata = $DynamicData->{$url};
840: #
1.8 matthew 841: # Get the statistical data - Use a weighted average
842: foreach my $type (qw/avetries difficulty disc/) {
843: my $studentcount;
1.21 albertel 844: my %course_counted;
1.5 matthew 845: my $sum;
846: my @Values;
1.8 matthew 847: my @Students;
1.5 matthew 848: #
1.21 albertel 849: # New data
1.8 matthew 850: if (exists($resdata->{'stats'})) {
851: foreach my $identifier (sort(keys(%{$resdata->{'stats'}}))) {
852: my $coursedata = $resdata->{'stats'}->{$identifier};
1.21 albertel 853: next if (lc($coursedata->{$type}) eq 'nan');
854: $course_counted{$coursedata->{'course'}}++;
1.8 matthew 855: $studentcount += $coursedata->{'stdno'};
856: $sum += $coursedata->{$type}*$coursedata->{'stdno'};
857: push(@Values,$coursedata->{$type});
858: push(@Students,$coursedata->{'stdno'});
859: }
860: }
861: #
1.21 albertel 862: # Old data
863: foreach my $course (keys(%{$resdata->{'statistics'}})) {
864: next if (exists($course_counted{$course}));
865: my $coursedata = $resdata->{'statistics'}{$course};
866: if (ref($coursedata) eq 'HASH' && exists($coursedata->{$type})) {
867: next if (lc($coursedata->{$type}) eq 'nan');
868: $studentcount += $coursedata->{'stdno'};
869: $sum += ($coursedata->{$type}*$coursedata->{'stdno'});
870: push(@Values,$coursedata->{$type});
871: push(@Students,$coursedata->{'stdno'});
872: }
873: }
1.8 matthew 874: if (defined($studentcount) && $studentcount>0) {
875: $data{$type} = $sum/$studentcount;
1.5 matthew 876: $data{$type.'_list'} = join(',',@Values);
877: }
878: }
879: #
1.8 matthew 880: # Find out the number of students who have completed the resource...
881: my $stdno;
1.20 albertel 882: my %course_counted;
1.8 matthew 883: if (exists($resdata->{'stats'})) {
884: #
885: # For the number of students, take the maximum found for the class
886: my $current_course;
887: my $coursemax=0;
888: foreach my $identifier (sort(keys(%{$resdata->{'stats'}}))) {
889: my $coursedata = $resdata->{'stats'}->{$identifier};
890: if (! defined($current_course)) {
891: $current_course = $coursedata->{'course'};
892: }
893: if ($current_course ne $coursedata->{'course'}) {
894: $stdno += $coursemax;
1.20 albertel 895: $course_counted{$coursedata->{'course'}}++;
1.8 matthew 896: $coursemax = 0;
897: $current_course = $coursedata->{'course'};
898: }
899: if ($coursemax < $coursedata->{'stdno'}) {
900: $coursemax = $coursedata->{'stdno'};
901: }
902: }
903: $stdno += $coursemax; # pick up the final course in the list
904: }
1.20 albertel 905: # check for old data that has not been run since the format was changed
906: foreach my $course (keys(%{$resdata->{'statistics'}})) {
907: next if (exists($course_counted{$course}));
908: my $coursedata = $resdata->{'statistics'}{$course};
909: if (ref($coursedata) eq 'HASH' && exists($coursedata->{'stdno'})) {
910: $stdno += $coursedata->{'stdno'};
911: }
912: }
1.8 matthew 913: $data{'stdno'}=$stdno;
914: #
1.5 matthew 915: # Get the context data
916: foreach my $type (qw/course goto comefrom/) {
917: if (defined($resdata->{$type}) &&
918: ref($resdata->{$type}) eq 'ARRAY') {
919: $data{$type} = scalar(@{$resdata->{$type}});
920: $data{$type.'_list'} = join(',',@{$resdata->{$type}});
921: }
922: }
1.35 www 923: #
924: # NOTE: usage is named sequsage elsewhere in LON-CAPA
925: # The translation happens here
926: #
1.5 matthew 927: if (defined($resdata->{'usage'}) &&
928: ref($resdata->{'usage'}) eq 'ARRAY') {
929: $data{'sequsage'} = scalar(@{$resdata->{'usage'}});
930: $data{'sequsage_list'} = join(',',@{$resdata->{'usage'}});
931: }
932: #
933: # Get the evaluation data
934: foreach my $type (qw/clear technical correct helpful depth/) {
935: my $count;
936: my $sum;
937: foreach my $evaluator (keys(%{$resdata->{'evaluation'}->{$type}})){
938: $sum += $resdata->{'evaluation'}->{$type}->{$evaluator};
939: $count++;
940: }
941: if ($count > 0) {
942: $data{$type}=$sum/$count;
943: }
944: }
945: #
946: # put together comments
1.26 bisitz 947: my $comments = '';
1.5 matthew 948: foreach my $evaluator (keys(%{$resdata->{'evaluation'}->{'comments'}})){
1.7 matthew 949: $comments .=
950: '<p>'.
1.26 bisitz 951: '<b>'.$evaluator.'</b>: '.
1.7 matthew 952: $resdata->{'evaluation'}->{'comments'}->{$evaluator}.
953: '</p>';
1.5 matthew 954: }
1.26 bisitz 955: if ($comments) {
956: $comments = '<div class="LCevalcomments">'
957: .$comments
958: .'</div>';
1.27 bisitz 959: $data{'comments'} = $comments;
1.26 bisitz 960: }
1.5 matthew 961: #
1.8 matthew 962: if (exists($resdata->{'stats'})) {
963: $data{'stats'} = $resdata->{'stats'};
964: }
1.12 matthew 965: if (exists($DynamicData->{'domain'})) {
966: $data{'domain'} = $DynamicData->{'domain'};
967: }
1.8 matthew 968: #
1.5 matthew 969: return %data;
970: }
971:
1.8 matthew 972: sub dynamic_metadata_storage {
973: my ($data) = @_;
974: my %Store;
975: my $courseid = $data->{'course'};
976: my $sections = $data->{'sections'};
977: my $numstu = $data->{'num_students'};
1.36 www 978: my $part = $data->{'part'};
979: my $symb = $data->{'symb'};
980: my $key = $courseid.'&'.$sections.'&'.$numstu.'&'.$part.'___'.$symb.'___stats';
1.8 matthew 981: $Store{$key} =
982: 'course='.$courseid.'&'.
983: 'sections='.$sections.'&'.
984: 'timestamp='.time.'&'.
1.36 www 985: 'part='.$part.'&'.
986: 'stdno='.$numstu.'&'.
1.8 matthew 987: 'avetries='.$data->{'mean_tries'}.'&'.
1.36 www 988: 'difficulty='.$data->{'deg_of_diff'}.'&'.
989: 'disc='.$data->{'deg_of_disc'};
1.8 matthew 990: return %Store;
991: }
1.6 matthew 992:
1.16 raeburn 993: ###############################################################
994: ###############################################################
995: ### ###
996: ### &portfolio_metadata($filepath,$dom,$uname,$group) ###
997: ### Retrieve metadata for the given file ###
998: ### Returns array - ###
999: ### contains reference to metadatahash and ###
1000: ### optional reference to addedfields hash ###
1001: ### ###
1002: ###############################################################
1003: ###############################################################
1004:
1005: sub portfolio_metadata {
1006: my ($fullpath,$dom,$uname,$group)=@_;
1007: my ($mime) = ( $fullpath=~/\.(\w+)$/ );
1008: my %metacache=();
1009: if ($fullpath !~ /\.meta$/) {
1010: $fullpath .= '.meta';
1011: }
1012: my (@standard_fields,%addedfields);
1013: my $colsref = $Portfolio_metadata_table_description;
1014: if (ref($colsref) eq 'ARRAY') {
1015: my @columns = @{$colsref};
1016: foreach my $coldata (@columns) {
1017: push(@standard_fields,$coldata->{'name'});
1018: }
1019: }
1020: my $metastring=&getfile($fullpath);
1021: if (! defined($metastring)) {
1022: $metacache{'keys'}= 'owner,domain,mime';
1023: $metacache{'owner'} = $uname.':'.$dom;
1024: $metacache{'domain'} = $dom;
1025: $metacache{'mime'} = $mime;
1026: if ($group ne '') {
1027: $metacache{'keys'} .= ',courserestricted';
1028: $metacache{'courserestricted'} = 'course.'.$dom.'_'.$uname;
1029: }
1030: } else {
1031: my $parser=HTML::TokeParser->new(\$metastring);
1032: my $token;
1033: while ($token=$parser->get_token) {
1034: if ($token->[0] eq 'S') {
1035: my $entry=$token->[1];
1036: if ($metacache{'keys'}) {
1037: $metacache{'keys'}.=','.$entry;
1038: } else {
1039: $metacache{'keys'}=$entry;
1040: }
1041: my $value = $parser->get_text('/'.$entry);
1042: if (!grep(/^\Q$entry\E$/,@standard_fields)) {
1043: my $clean_value = lc($value);
1044: $clean_value =~ s/\s/_/g;
1045: if ($clean_value ne $entry) {
1046: if (defined($addedfields{$entry})) {
1047: $addedfields{$entry} .=','.$value;
1048: } else {
1049: $addedfields{$entry} = $value;
1050: }
1051: }
1052: } else {
1053: $metacache{$entry} = $value;
1054: }
1055: }
1056: } # End of ($token->[0] eq 'S')
1.22 albertel 1057:
1058: if (!exists($metacache{'domain'})) {
1059: $metacache{'domain'} = $dom;
1060: }
1.16 raeburn 1061: }
1062: return (\%metacache,$metacache{'courserestricted'},\%addedfields);
1063: }
1064:
1065: sub process_portfolio_access_data {
1066: my ($dbh,$simulate,$newnames,$url,$fullpath,$access_hash,$caller) = @_;
1067: my %loghash;
1068: if ($caller eq 'update') {
1069: # Delete old data (no error if deleting non-existent record).
1.23 raeburn 1070: my $error;
1071: if ($url eq '') {
1072: $error = 'No url specified';
1073: } else {
1074: my $delitem = 'url = '.$dbh->quote($url);
1075: $error=&delete_metadata($dbh,$newnames->{'access'},$delitem);
1076: }
1.16 raeburn 1077: if (defined($error)) {
1078: $loghash{'access'}{'err'} = "MySQL Error Delete: ".$error;
1079: return %loghash;
1080: }
1081: }
1082: # Check the file exists
1083: if (-e $fullpath) {
1084: foreach my $key (keys(%{$access_hash})) {
1085: my $acc_data;
1086: $acc_data->{url} = $url;
1087: $acc_data->{keynum} = $key;
1088: my ($num,$scope,$end,$start) =
1089: ($key =~ /^([^:]+):([a-z]+)_(\d*)_?(\d*)$/);
1090: next if (($scope ne 'public') && ($scope ne 'guest'));
1091: $acc_data->{scope} = $scope;
1.28 raeburn 1092: my $sqltime_error;
1.16 raeburn 1093: if ($end != 0) {
1.28 raeburn 1094: $acc_data->{end} = &sqltime($end,\$sqltime_error);
1095: }
1096: $acc_data->{start} = &sqltime($start,\$sqltime_error);
1097: if ($sqltime_error) {
1098: $loghash{$key}{'err'} = $sqltime_error;
1.16 raeburn 1099: }
1100: if (! $simulate) {
1101: my ($count,$err) =
1102: &store_metadata($dbh,$newnames->{'access'},
1103: 'portfolio_access',$acc_data);
1104: if ($err) {
1105: $loghash{$key}{'err'} = "MySQL Error Insert: ".$err;
1106: }
1107: if ($count < 1) {
1108: $loghash{$key}{'count'} =
1109: "Unable to insert record into MySQL database for $url";
1110: }
1111: }
1112: }
1113: }
1114: return %loghash;
1115: }
1116:
1117: sub process_portfolio_metadata {
1118: my ($dbh,$simulate,$newnames,$url,$fullpath,$is_course,$dom,$uname,$group,$caller) = @_;
1119: my %loghash;
1120: if ($caller eq 'update') {
1121: # Delete old data (no error if deleting non-existent record).
1.23 raeburn 1122: my ($error,$delitem);
1123: if ($url eq '') {
1124: $error = 'No url specified';
1125: } else {
1126: $delitem = 'url = '.$dbh->quote($url);
1127: $error=&delete_metadata($dbh,$newnames->{'portfolio'},$delitem);
1128: }
1.16 raeburn 1129: if (defined($error)) {
1130: $loghash{'metadata'}{'err'} = "MySQL Error delete metadata: ".
1131: $error;
1132: return %loghash;
1133: }
1.23 raeburn 1134: $error=&delete_metadata($dbh,$newnames->{'addedfields'},$delitem);
1.16 raeburn 1135: if (defined($error)) {
1136: $loghash{'addedfields'}{'err'}="MySQL Error delete addedfields: ".$error;
1137: }
1138: }
1139: # Check the file exists.
1140: if (-e $fullpath) {
1141: my ($ref,$crs,$addedfields) = &portfolio_metadata($fullpath,$dom,$uname,
1142: $group);
1.28 raeburn 1143: my $sqltime_error;
1144: &getfiledates($ref,$fullpath,\$sqltime_error);
1.16 raeburn 1145: if ($is_course) {
1146: $ref->{'groupname'} = $group;
1147: }
1148: my %Data;
1149: if (ref($ref) eq 'HASH') {
1150: %Data = %{$ref};
1151: }
1152: %Data = (
1153: %Data,
1154: 'url'=>$url,
1155: 'version'=>'current',
1156: );
1157: my %loghash;
1158: if (! $simulate) {
1.28 raeburn 1159: if ($sqltime_error) {
1160: $loghash{'metadata'."\0"}{'err'} = $sqltime_error;
1161: }
1.16 raeburn 1162: my ($count,$err) =
1163: &store_metadata($dbh,$newnames->{'portfolio'},'portfolio_metadata',
1164: \%Data);
1165: if ($err) {
1166: $loghash{'metadata'."\0"}{'err'} = "MySQL Error Insert: ".$err;
1167: }
1168: if ($count < 1) {
1169: $loghash{'metadata'."\0"}{'count'} = "Unable to insert record into MySQL portfolio_metadata database table for $url";
1170: }
1171: if (ref($addedfields) eq 'HASH') {
1172: if (keys(%{$addedfields}) > 0) {
1173: foreach my $key (keys(%{$addedfields})) {
1174: my $added_data = {
1175: 'url' => $url,
1176: 'field' => $key,
1177: 'value' => $addedfields->{$key},
1178: 'courserestricted' => $crs,
1179: };
1180: my ($count,$err) =
1181: &store_metadata($dbh,$newnames->{'addedfields'},
1182: 'portfolio_addedfields',$added_data);
1183: if ($err) {
1184: $loghash{$key}{'err'} =
1185: "MySQL Error Insert: ".$err;
1186: }
1187: if ($count < 1) {
1188: $loghash{$key}{'count'} = "Unable to insert record into MySQL portfolio_addedfields database table for url = $url and field = $key";
1189: }
1190: }
1191: }
1192: }
1193: }
1194: }
1195: return %loghash;
1196: }
1197:
1.23 raeburn 1198: sub process_allusers_data {
1199: my ($dbh,$simulate,$newnames,$uname,$udom,$userdata,$caller) = @_;
1200: my %loghash;
1201: if ($caller eq 'update') {
1202: # Delete old data (no error if deleting non-existent record).
1203: my ($error,$delitem);
1204: if ($udom eq '' || $uname eq '' ) {
1205: $error = 'No domain and/or username specified';
1206: } else {
1.25 raeburn 1207: $delitem = 'domain = '.$dbh->quote($udom).' AND username '.
1208: 'COLLATE latin1_general_cs = '.$dbh->quote($uname);
1.23 raeburn 1209: $error=&delete_metadata($dbh,$newnames->{'allusers'},$delitem);
1210: }
1211: if (defined($error)) {
1212: $loghash{'err'} = 'MySQL Error in allusers delete: '.$error;
1213: return %loghash;
1214: }
1215: }
1216: if (!$simulate) {
1217: if ($udom ne '' && $uname ne '') {
1218: my ($count,$err) = &store_metadata($dbh,$newnames->{'allusers'},
1219: 'allusers',$userdata);
1220: if ($err) {
1221: $loghash{'err'} = 'MySQL Error in allusers insert: '.$err;
1222: }
1223: if ($count < 1) {
1224: $loghash{'count'} =
1225: 'Unable to insert record into MySQL allusers database for '.
1226: $uname.' in '.$udom;
1227: }
1228: } else {
1229: $loghash{'err'} =
1230: 'MySQL Error allusrs insert: missing username and/or domain';
1231: }
1232: }
1233: return %loghash;
1234: }
1235:
1.5 matthew 1236: ######################################################################
1237: ######################################################################
1.14 raeburn 1238:
1.16 raeburn 1239: sub getfile {
1240: my $file = shift();
1241: if (! -e $file ) {
1242: return undef;
1243: }
1.17 albertel 1244: open(my $fh,"<$file");
1.16 raeburn 1245: my $contents = '';
1246: while (<$fh>) {
1247: $contents .= $_;
1248: }
1249: return $contents;
1250: }
1251:
1252: ##
1.28 raeburn 1253: ## &getfiledates($ref,$target,$sqltime_error)
1.16 raeburn 1254: ## Converts creationdate and modifieddates to SQL format
1255: ## Applies stat() to file to retrieve dates if missing
1256: sub getfiledates {
1.28 raeburn 1257: my ($ref,$target,$sqltime_error) = @_;
1.16 raeburn 1258: if (! defined($ref->{'creationdate'}) ||
1259: $ref->{'creationdate'} =~ /^\s*$/) {
1260: $ref->{'creationdate'} = (stat($target))[9];
1261: }
1262: if (! defined($ref->{'lastrevisiondate'}) ||
1263: $ref->{'lastrevisiondate'} =~ /^\s*$/) {
1264: $ref->{'lastrevisiondate'} = (stat($target))[9];
1265: }
1.28 raeburn 1266: $ref->{'creationdate'} = &sqltime($ref->{'creationdate'},$sqltime_error);
1267: $ref->{'lastrevisiondate'} = &sqltime($ref->{'lastrevisiondate'},$sqltime_error);
1.16 raeburn 1268: }
1269:
1.15 raeburn 1270: ##
1.28 raeburn 1271: ## &sqltime($timestamp,$sqltime_error)
1.15 raeburn 1272: ##
1273: ## Convert perl $timestamp to MySQL time. MySQL expects YYYY-MM-DD HH:MM:SS
1274: ##
1275: sub sqltime {
1.28 raeburn 1276: my ($time,$sqltime_error) = @_;
1.15 raeburn 1277: my $mysqltime;
1278: if ($time =~
1279: /(\d+)-(\d+)-(\d+) # YYYY-MM-DD
1280: \s # a space
1281: (\d+):(\d+):(\d+) # HH:MM::SS
1282: /x ) {
1283: # Some of the .meta files have the time in mysql
1284: # format already, so just make sure they are 0 padded and
1285: # pass them back.
1286: $mysqltime = sprintf('%04d-%02d-%02d %02d:%02d:%02d',
1287: $1,$2,$3,$4,$5,$6);
1288: } elsif ($time =~ /^\d+$/) {
1289: my @TimeData = gmtime($time);
1290: # Alter the month to be 1-12 instead of 0-11
1291: $TimeData[4]++;
1292: # Alter the year to be from 0 instead of from 1900
1293: $TimeData[5]+=1900;
1294: $mysqltime = sprintf('%04d-%02d-%02d %02d:%02d:%02d',
1295: @TimeData[5,4,3,2,1,0]);
1296: } elsif (! defined($time) || $time == 0) {
1297: $mysqltime = 0;
1298: } else {
1.28 raeburn 1299: if (ref($sqltime_error) eq 'SCALAR') {
1300: $$sqltime_error = "sqltime:Unable to decode time ".$time;
1301: }
1.15 raeburn 1302: $mysqltime = 0;
1303: }
1304: return $mysqltime;
1305: }
1.14 raeburn 1306:
1307: ######################################################################
1308: ######################################################################
1.5 matthew 1309: ##
1310: ## The usual suspects, repeated here to reduce dependency hell
1311: ##
1312: ######################################################################
1313: ######################################################################
1314: sub unescape {
1315: my $str=shift;
1316: $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1317: return $str;
1318: }
1319:
1320: sub escape {
1321: my $str=shift;
1322: $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
1323: return $str;
1324: }
1.6 matthew 1325:
1.1 matthew 1326: 1;
1327:
1328: __END__;
1329:
1330: =pod
1331:
1332: =back
1333:
1334: =cut
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonmetadata.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / metadata_database / LONCAPA