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