loncom/metadata_database/LONCAPA/lonmetadata.pm - view

File: [LON-CAPA] / loncom / metadata_database / LONCAPA / lonmetadata.pm
Revision 1.23: download - view: text, annotated - select for diffs
Wed Jul 25 23:17:49 2007 UTC (16 years, 10 months ago) by raeburn
Branches: MAIN
CVS tags: version_2_5_X, version_2_5_2, version_2_5_1, version_2_5_0, version_2_4_99_0, HEAD

searchcat.pl
- Additional MySQL table to build: allusers
- &descend_tree() arguments changed. $dom added as first arg, and reference to %allusers hash added as last arg.
- %allusers keys are usernames for all users in the domain which are not courses.
- user information put into allusers MySQL table.

LONCAPA/lonmetadata.pm
- description of allusers table
- &update_metadata(), &lookup_metadata() and &delete_metadata() modified to allow more flexibility in the WHERE condition in the SQL query (no longer forced to be url = ).
- &process_allusers_data() added to add/modify the contents of the allusers table.

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