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