loncom/metadata_database/parse_activity_log.pl - view

File: [LON-CAPA] / loncom / metadata_database / parse_activity_log.pl
Revision 1.12: download - view: text, annotated - select for diffs
Wed Feb 9 21:24:33 2005 UTC (19 years, 3 months ago) by matthew
Branches: MAIN
CVS tags: HEAD

Many changes:
   corrected help text
   changed command line option 'drop' to 'dropwhendone'
   allow user to specify the name of the logfile
   call lonmysql::fix_table_name
   remove zero length files when done processing
   use "--quote-names " with mysqldump
   increase the amount of logging when table creation fails

1: #!/usr/bin/perl 2: # 3: # The LearningOnline Network 4: # 5: # $Id: parse_activity_log.pl,v 1.12 2005/02/09 21:24:33 matthew Exp $ 6: # 7: # Copyright Michigan State University Board of Trustees 8: # 9: # This file is part of the LearningOnline Network with CAPA (LON-CAPA). 10: # 11: # LON-CAPA is free software; you can redistribute it and/or modify 12: # it under the terms of the GNU General Public License as published by 13: # the Free Software Foundation; either version 2 of the License, or 14: # (at your option) any later version. 15: # 16: # LON-CAPA is distributed in the hope that it will be useful, 17: # but WITHOUT ANY WARRANTY; without even the implied warranty of 18: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19: # GNU General Public License for more details. 20: # 21: # You should have received a copy of the GNU General Public License 22: # along with LON-CAPA; if not, write to the Free Software 23: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 24: # 25: # /home/httpd/html/adm/gpl.txt 26: # 27: # http://www.lon-capa.org/ 28: # 29: #-------------------------------------------------------------------- 30: # 31: # Exit codes 32: # 0 Everything is okay 33: # 1 Another copy is running on this course 34: # 2 Activity log does not exist 35: # 3 Unable to connect to database 36: # 4 Unable to create database tables 37: # 5 Unable to open log file 38: # 6 Unable to get lock on activity log 39: # 40: 41: # 42: # Notes: 43: # 44: # Logging is done via the $logthis variable, which may be the result of 45: # overcleverness. log via $logthis->('logtext'); Those are parentheses, 46: # not curly braces. If the -log command line parameter is set, the $logthis 47: # routine is set to a routine which writes to a file. If the command line 48: # parameter is not set $logthis is set to &nothing, which does what you 49: # would expect. 50: # 51: 52: use strict; 53: use DBI; 54: use lib '/home/httpd/lib/perl/Apache'; 55: use lib '/home/httpd/lib/perl/'; 56: use LONCAPA::Configuration(); 57: use Apache::lonmysql(); 58: use lonmysql(); 59: use Time::HiRes(); 60: use Getopt::Long(); 61: use IO::File; 62: use File::Copy; 63: use Fcntl qw(:flock); 64: 65: # 66: # Determine parameters 67: my ($help,$course,$domain,$drop_when_done,$srcfile,$logfile,$time_run,$nocleanup,$log,$backup); 68: &Getopt::Long::GetOptions( "course=s" => \$course, 69: "domain=s" => \$domain, 70: "backup" => \$backup, 71: "help" => \$help, 72: "logfile=s" => \$logfile, 73: "srcfile=s" => \$srcfile, 74: "timerun" => \$time_run, 75: "nocleanup" => \$nocleanup, 76: "dropwhendone" => \$drop_when_done, 77: "log" => \$log); 78: if (! defined($course) || $help) { 79: print<<USAGE; 80: parse_activity_log.pl 81: 82: Process a lon-capa activity log into a database. 83: Parameters: 84: course Required 85: domain optional 86: backup optional if present, backup the activity log file 87: before processing it 88: dropwhendone optional if present, drop all course 89: specific activity log tables after processing. 90: srcfile optional Specify the file to parse, including path 91: time optional if present, print out timing data 92: nocleanup optional if present, do not remove old files 93: log optional if present, prepare log file of activity 94: logfile optional specifies the logfile to use 95: Examples: 96: $0 -course=123456abcdef -domain=msu 97: $0 -course=123456abcdef -srcfile=activity.log 98: $0 -course-123456abcdef -log -logfile=/tmp/logfile -dropwhendone 99: USAGE 100: exit; 101: } 102: 103: ## 104: ## Set up timing code 105: my $time_this = \&nothing; 106: if ($time_run) { 107: $time_this = \&time_action; 108: } 109: my $initial_time = Time::HiRes::time; 110: 111: ## 112: ## Read in configuration parameters 113: ## 114: my %perlvar = %{&LONCAPA::Configuration::read_conf('loncapa.conf')}; 115: 116: if (! defined($domain) || $domain eq '') { 117: $domain = $perlvar{'lonDefDomain'}; 118: } 119: &update_process_name($course.'@'.$domain); 120: 121: ## 122: ## Set up logging code 123: my $logthis = \&nothing; 124: 125: if ($log) { 126: if (! $logfile) { 127: $logfile = $perlvar{'lonDaemons'}.'/tmp/parse_activity_log.log.'.time; 128: } 129: print STDERR "$0: logging to $logfile".$/; 130: if (! open(LOGFILE,">$logfile")) { 131: warn("Unable to open $logfile for writing. Run aborted."); 132: exit 5; 133: } else { 134: $logthis = \&log_to_file; 135: } 136: } 137: 138: 139: ## 140: ## Determine filenames 141: ## 142: my $sourcefilename; # activity log data 143: my $newfilename; # $sourcefilename will be renamed to this 144: my $gz_sql_filename; # the gzipped mysql backup data file name. 145: my $error_filename; # Errors in parsing the activity log will be written here 146: if ($srcfile) { 147: $sourcefilename = $srcfile; 148: } else { 149: $sourcefilename = &get_filename($course,$domain); 150: } 151: my $sql_filename = $sourcefilename; 152: $sql_filename =~ s|[^/]*$|activity.log.sql|; 153: $gz_sql_filename = $sql_filename.'.gz'; 154: $error_filename = $sourcefilename; 155: $error_filename =~ s|[^/]*$|activity.log.errors|; 156: $logthis->('Beginning logging '.time); 157: 158: 159: # 160: # Wait for a lock on the lockfile to avoid collisions 161: my $lockfilename = $sourcefilename.'.lock'; 162: open(LOCKFILE,'>'.$lockfilename); 163: if (!flock(LOCKFILE,LOCK_EX)) { 164: warn("Unable to lock $lockfilename. Aborting".$/); 165: exit 6; 166: } 167: 168: ## 169: ## There will only be a $newfilename file if a copy of this program is already 170: ## running. 171: my $newfilename = $sourcefilename.'.processing'; 172: if (-e $newfilename) { 173: warn "$newfilename exists"; 174: $logthis->($newfilename.' exists, so I cannot work on it.'); 175: exit 2; 176: } 177: 178: if (-e $sourcefilename) { 179: $logthis->('renaming '.$sourcefilename.' to '.$newfilename); 180: rename($sourcefilename,$newfilename); 181: Copy($newfilename,$newfilename.'.'.time) if ($backup); 182: $logthis->("renamed $sourcefilename to $newfilename"); 183: } else { 184: my $command = 'touch '.$newfilename; 185: $logthis->($command); 186: system($command); 187: $logthis->('touch was completed'); 188: } 189: 190: close(LOCKFILE); 191: 192: ## 193: ## Table definitions 194: ## 195: my $prefix = $course.'_'.$domain.'_'; 196: my $student_table = &Apache::lonmysql::fix_table_name($prefix.'students'); 197: my $student_table_def = 198: { id => $student_table, 199: permanent => 'no', 200: columns => [ 201: { name => 'student_id', 202: type => 'MEDIUMINT UNSIGNED', 203: restrictions => 'NOT NULL', 204: auto_inc => 'yes', }, 205: { name => 'student', 206: type => 'VARCHAR(100) BINARY', 207: restrictions => 'NOT NULL', }, 208: ], 209: 'PRIMARY KEY' => ['student_id',], 210: }; 211: 212: my $res_table = &Apache::lonmysql::fix_table_name($prefix.'resource'); 213: my $res_table_def = 214: { id => $res_table, 215: permanent => 'no', 216: columns => [{ name => 'res_id', 217: type => 'MEDIUMINT UNSIGNED', 218: restrictions => 'NOT NULL', 219: auto_inc => 'yes', }, 220: { name => 'resource', 221: type => 'MEDIUMTEXT', 222: restrictions => 'NOT NULL'}, 223: ], 224: 'PRIMARY KEY' => ['res_id'], 225: }; 226: 227: #my $action_table = &Apache::lonmysql::fix_table_name($prefix.'actions'); 228: #my $action_table_def = 229: #{ id => $action_table, 230: # permanent => 'no', 231: # columns => [{ name => 'action_id', 232: # type => 'MEDIUMINT UNSIGNED', 233: # restrictions => 'NOT NULL', 234: # auto_inc => 'yes', }, 235: # { name => 'action', 236: # type => 'VARCHAR(100)', 237: # restrictions => 'NOT NULL'}, 238: # ], 239: # 'PRIMARY KEY' => ['action_id',], 240: #}; 241: 242: my $machine_table = &Apache::lonmysql::fix_table_name($prefix.'machine_table'); 243: my $machine_table_def = 244: { id => $machine_table, 245: permanent => 'no', 246: columns => [{ name => 'machine_id', 247: type => 'MEDIUMINT UNSIGNED', 248: restrictions => 'NOT NULL', 249: auto_inc => 'yes', }, 250: { name => 'machine', 251: type => 'VARCHAR(100)', 252: restrictions => 'NOT NULL'}, 253: ], 254: 'PRIMARY KEY' => ['machine_id',], 255: }; 256: 257: my $activity_table = &Apache::lonmysql::fix_table_name($prefix.'activity'); 258: my $activity_table_def = 259: { id => $activity_table, 260: permanent => 'no', 261: columns => [ 262: { name => 'res_id', 263: type => 'MEDIUMINT UNSIGNED', 264: restrictions => 'NOT NULL',}, 265: { name => 'time', 266: type => 'DATETIME', 267: restrictions => 'NOT NULL',}, 268: { name => 'student_id', 269: type => 'MEDIUMINT UNSIGNED', 270: restrictions => 'NOT NULL',}, 271: { name => 'action', 272: type => 'VARCHAR(10)', 273: restrictions => 'NOT NULL',}, 274: { name => 'idx', # This is here in case a student 275: type => 'MEDIUMINT UNSIGNED', # has multiple submissions during 276: restrictions => 'NOT NULL', # one second. It happens, trust 277: auto_inc => 'yes', }, # me. 278: { name => 'machine_id', 279: type => 'MEDIUMINT UNSIGNED', 280: restrictions => 'NOT NULL',}, 281: { name => 'action_values', 282: type => 'MEDIUMTEXT', }, 283: ], 284: 'PRIMARY KEY' => ['time','student_id','res_id','idx'], 285: 'KEY' => [{columns => ['student_id']}, 286: {columns => ['time']},], 287: }; 288: 289: my @Activity_Table = ($activity_table_def); 290: my @ID_Tables = ($student_table_def,$res_table_def,$machine_table_def); 291: ## 292: ## End of table definitionsOB 293: ## 294: 295: $logthis->('Connectiong to mysql'); 296: &Apache::lonmysql::set_mysql_user_and_password('www', 297: $perlvar{'lonSqlAccess'}); 298: if (!&Apache::lonmysql::verify_sql_connection()) { 299: warn "Unable to connect to MySQL database."; 300: $logthis->("Unable to connect to MySQL database."); 301: exit 3; 302: } 303: $logthis->('SQL connection is up'); 304: 305: if (-s $gz_sql_filename) { 306: my $backup_modification_time = (stat($gz_sql_filename))[9]; 307: $logthis->($gz_sql_filename.' was last modified '. 308: localtime($backup_modification_time). 309: '('.$backup_modification_time.')'); 310: # Check for missing tables 311: my @Current_Tables = &Apache::lonmysql::tables_in_db(); 312: $logthis->(join(',',@Current_Tables)); 313: my %Found; 314: foreach my $tablename (@Current_Tables) { 315: foreach my $table (@Activity_Table,@ID_Tables) { 316: if ($tablename eq $table->{'id'}) { 317: $Found{$tablename}++; 318: } 319: } 320: } 321: $logthis->('Found tables '.join(',',keys(%Found))); 322: my $missing_a_table = 0; 323: foreach my $table (@Activity_Table,@ID_Tables) { 324: # Hmmm, should I dump the tables? 325: if (! $Found{$table->{'id'}}) { 326: $logthis->('Missing table '.$table->{'id'}); 327: $missing_a_table = 1; 328: last; 329: } 330: } 331: if ($missing_a_table) { 332: my $table_modification_time = $backup_modification_time; 333: # If the backup happened prior to the last table modification, 334: foreach my $table (@Activity_Table,@ID_Tables) { 335: my %tabledata = &Apache::lonmysql::table_information($table->{'id'}); 336: next if (! scalar(keys(%tabledata))); # table does not exist 337: if ($table_modification_time < $tabledata{'Update_time'}) { 338: $table_modification_time = $tabledata{'Update_time'}; 339: } 340: } 341: $logthis->("Table modification time = ".$table_modification_time); 342: if ($table_modification_time > $backup_modification_time) { 343: # Save the current tables in case we need them another time. 344: my $backup_name = $gz_sql_filename.'.'.time; 345: $logthis->('Backing existing tables up in '.$backup_name); 346: &backup_tables($backup_name); 347: } 348: $time_this->(); 349: &load_backup_tables($gz_sql_filename); 350: $time_this->('load backup tables'); 351: } 352: } 353: 354: ## 355: ## Ensure the tables we need exist 356: # create_tables does not complain if the tables already exist 357: $logthis->('creating tables'); 358: if (! &create_tables()) { 359: warn "Unable to create tables"; 360: $logthis->('Unable to create tables'); 361: exit 4; 362: } 363: 364: ## 365: ## Read the ids used for various tables 366: $logthis->('reading id tables'); 367: &read_id_tables(); 368: $logthis->('finished reading id tables'); 369: 370: ## 371: ## Set up the errors file 372: my $error_fh = IO::File->new(">>$error_filename"); 373: 374: ## 375: ## Parse the course log 376: $logthis->('processing course log'); 377: if (-s $newfilename) { 378: my $result = &process_courselog($newfilename,$error_fh); 379: if (! defined($result)) { 380: # Something went wrong along the way... 381: $logthis->('process_courselog returned undef'); 382: exit 5; 383: } elsif ($result > 0) { 384: $time_this->(); 385: $logthis->('process_courselog returned '.$result.' backing up tables'); 386: &backup_tables($gz_sql_filename); 387: $time_this->('write backup tables'); 388: } 389: if ($drop_when_done) { &drop_tables(); $logthis->('dropped tables'); } 390: } 391: close($error_fh); 392: 393: ## 394: ## Clean up the filesystem 395: &Apache::lonmysql::disconnect_from_db(); 396: unlink($newfilename) if (-e $newfilename && ! $nocleanup); 397: 398: ## 399: ## Print timing data 400: $logthis->('printing timing data'); 401: if ($time_run) { 402: my $elapsed_time = Time::HiRes::time - $initial_time; 403: print "Overall time: ".$elapsed_time.$/; 404: print &outputtimes(); 405: $logthis->("Overall time: ".$elapsed_time); 406: $logthis->(&outputtimes()); 407: } 408: 409: if ($log) { 410: close LOGFILE; 411: } 412: 413: foreach my $file ($lockfilename, $error_filename,$logfile) { 414: if (-z $file) { 415: unlink($file); 416: } 417: } 418: 419: 420: exit 0; # Everything is okay, so end here before it gets worse. 421: 422: ######################################################## 423: ######################################################## 424: ## 425: ## Process Course Log 426: ## 427: ######################################################## 428: ######################################################## 429: # 430: # Returns the number of lines in the activity.log file that were processed. 431: sub process_courselog { 432: my ($inputfile,$error_fh) = @_; 433: if (! open(IN,$inputfile)) { 434: warn "Unable to open '$inputfile' for reading"; 435: $logthis->("Unable to open '$inputfile' for reading"); 436: return undef; 437: } 438: my ($linecount,$insertcount); 439: my $dbh = &Apache::lonmysql::get_dbh(); 440: # 441: # Timing variables 442: my @RowData; 443: while (my $line=<IN>){ 444: # last if ($linecount > 1000); 445: # 446: # Bulk storage variables 447: $time_this->(); 448: chomp($line); 449: $linecount++; 450: # print $linecount++.$/; 451: my ($timestamp,$host,$log)=split(/\:/,$line,3); 452: $time_this->('splitline'); 453: # 454: # $log has the actual log entries; currently still escaped, and 455: # %26(timestamp)%3a(url)%3a(user)%3a(domain) 456: # then additionally 457: # %3aPOST%3a(name)%3d(value)%3a(name)%3d(value) 458: # or 459: # %3aCSTORE%3a(name)%3d(value)%26(name)%3d(value) 460: # 461: # get delimiter between timestamped entries to be &&& 462: $log=~s/\%26(\d{9,10})\%3a/\&\&\&$1\%3a/g; 463: $log = &unescape($log); 464: $time_this->('translate_and_unescape'); 465: # now go over all log entries 466: if (! defined($host)) { $host = 'unknown'; } 467: my $machine_id = &get_id($machine_table,'machine',$host); 468: my $prevchunk = 'none'; 469: foreach my $chunk (split(/\&\&\&/,$log)) { 470: my $warningflag = ''; 471: $time_this->(); 472: my ($time,$res,$uname,$udom,$action,@values)= split(/:/,$chunk); 473: my $student = $uname.':'.$udom; 474: if (! defined($res) || $res =~ /^\s*$/) { 475: $res = '/adm/roles'; 476: $action = 'LOGIN'; 477: } 478: if ($res =~ m|^/prtspool/|) { 479: $res = '/prtspool/'; 480: } 481: if (! defined($action) || $action eq '') { 482: $action = 'VIEW'; 483: } 484: if ($action !~ /^(LOGIN|VIEW|POST|CSTORE|STORE)$/) { 485: $warningflag .= 'action'; 486: print $error_fh 'full log entry:'.$log.$/; 487: print $error_fh 'error on chunk:'.$chunk.$/; 488: $logthis->('(action) Unable to parse '.$/.$chunk.$/. 489: 'got '. 490: 'time = '.$time.$/. 491: 'res = '.$res.$/. 492: 'uname= '.$uname.$/. 493: 'udom = '.$udom.$/. 494: 'action='.$action.$/. 495: '@values = '.join('&',@values)); 496: next; #skip it if we cannot understand what is happening. 497: } 498: if (! defined($student) || $student eq ':') { 499: $student = 'unknown'; 500: $warningflag .= 'student'; 501: } 502: if (! defined($res) || $res =~ /^\s*$/) { 503: $res = 'unknown'; 504: $warningflag .= 'res'; 505: } 506: if (! defined($action) || $action =~ /^\s*$/) { 507: $action = 'unknown'; 508: $warningflag .= 'action'; 509: } 510: if (! defined($time) || $time !~ /^\d+$/) { 511: $time = 0; 512: $warningflag .= 'time'; 513: } 514: # 515: $time_this->('split_and_error_check'); 516: my $student_id = &get_id($student_table,'student',$student); 517: my $res_id = &get_id($res_table,'resource',$res); 518: # my $action_id = &get_id($action_table,'action',$action); 519: my $sql_time = &Apache::lonmysql::sqltime($time); 520: # 521: if (! defined($student_id) || $student_id eq '') { 522: $warningflag.='student_id'; 523: } 524: if (! defined($res_id) || $res_id eq '') { 525: $warningflag.='res_id'; 526: } 527: # if (! defined($action_id) || $action_id eq '') { 528: # $warningflag.='action_id'; 529: # } 530: if ($warningflag ne '') { 531: print $error_fh 'full log entry:'.$log.$/; 532: print $error_fh 'error on chunk:'.$chunk.$/; 533: $logthis->('warningflag ('.$warningflag.') on chunk '. 534: $/.$chunk.$/.'prevchunk = '.$/.$prevchunk); 535: $prevchunk .= $chunk; 536: next; # skip this chunk 537: } 538: # 539: my $store_values; 540: if ($action eq 'POST') { 541: $store_values = 542: $dbh->quote(join('&',map { &escape($_); } @values)); 543: } else { 544: $store_values = $dbh->quote(join('&',@values)); 545: } 546: $time_this->('get_ids'); 547: # 548: my $row = [$res_id, 549: qq{'$sql_time'}, 550: $student_id, 551: "'".$action."'", 552: # $action_id, 553: qq{''}, # idx 554: $machine_id, 555: $store_values]; 556: push(@RowData,$row); 557: $time_this->('push_row'); 558: $prevchunk = $chunk; 559: # 560: } 561: $time_this->(); 562: if ((scalar(@RowData) > 0) && ($linecount % 100 == 0)) { 563: my $result = &Apache::lonmysql::bulk_store_rows($activity_table, 564: undef, 565: \@RowData); 566: # $logthis->('result = '.$result); 567: $time_this->('bulk_store_rows'); 568: if (! defined($result)) { 569: my $error = &Apache::lonmysql::get_error(); 570: warn "Error occured during insert.".$error; 571: $logthis->('error = '.$error); 572: } 573: undef(@RowData); 574: } 575: } 576: if (@RowData) { 577: $time_this->(); 578: $logthis->('storing '.$linecount); 579: my $result = &Apache::lonmysql::bulk_store_rows($activity_table, 580: undef, 581: \@RowData); 582: $logthis->('result = '.$result); 583: $time_this->('bulk_store_rows'); 584: if (! defined($result)) { 585: my $error = &Apache::lonmysql::get_error(); 586: warn "Error occured during insert.".$error; 587: $logthis->('error = '.$error); 588: } 589: undef(@RowData); 590: } 591: close IN; 592: # print "Number of lines: ".$linecount.$/; 593: # print "Number of inserts: ".$insertcount.$/; 594: return $linecount; 595: } 596: 597: 598: ## 599: ## Somtimes, instead of doing something, doing nothing is appropriate. 600: sub nothing { 601: return; 602: } 603: 604: ## 605: ## Logging routine 606: ## 607: sub log_to_file { 608: my ($input)=@_; 609: print LOGFILE $input.$/; 610: } 611: 612: ## 613: ## Timing routines 614: ## 615: { 616: my %Timing; 617: my $starttime; 618: 619: sub time_action { 620: my ($key) = @_; 621: if (defined($key)) { 622: $Timing{$key}+=Time::HiRes::time-$starttime; 623: $Timing{'count_'.$key}++; 624: } 625: $starttime = Time::HiRes::time; 626: } 627: 628: sub outputtimes { 629: my $Str; 630: if ($time_run) { 631: $Str = "Timing Data:".$/; 632: while (my($k,$v) = each(%Timing)) { 633: next if ($k =~ /^count_/); 634: my $count = $Timing{'count_'.$k}; 635: $Str .= 636: ' '.sprintf("%25.25s",$k). 637: ' '.sprintf('% 8d',$count). 638: ' '.sprintf('%12.5f',$v).$/; 639: } 640: } 641: return $Str; 642: } 643: 644: } 645: 646: 647: ## 648: ## Use mysqldump to store backups of the tables 649: ## 650: sub backup_tables { 651: my ($gz_sql_filename) = @_; 652: my $command = qq{mysqldump --quote-names --opt loncapa }; 653: foreach my $table (@ID_Tables,@Activity_Table) { 654: my $tablename = $table->{'id'}; 655: $tablename =~ s/\`//g; 656: $command .= $tablename.' '; 657: } 658: $command .= '| gzip >'.$gz_sql_filename; 659: $logthis->($command); 660: system($command); 661: } 662: 663: ## 664: ## Load in mysqldumped files 665: ## 666: sub load_backup_tables { 667: my ($gz_sql_filename) = @_; 668: if (-s $gz_sql_filename) { 669: $logthis->('loading data from gzipped sql file'); 670: my $command='gzip -dc '.$gz_sql_filename.' | mysql --database=loncapa'; 671: system($command); 672: $logthis->('finished loading gzipped data');; 673: } else { 674: return undef; 675: } 676: } 677: 678: ## 679: ## 680: ## 681: sub update_process_name { 682: my ($text) = @_; 683: $0 = 'parse_activity_log.pl: '.$text; 684: } 685: 686: sub get_filename { 687: my ($course,$domain) = @_; 688: my ($a,$b,$c,undef) = split('',$course,4); 689: return "$perlvar{'lonUsersDir'}/$domain/$a/$b/$c/$course/activity.log"; 690: } 691: 692: sub create_tables { 693: foreach my $table (@ID_Tables,@Activity_Table) { 694: my $table_id = &Apache::lonmysql::create_table($table); 695: if (! defined($table_id)) { 696: warn "Unable to create table ".$table->{'id'}.$/; 697: $logthis->('Unable to create table '.$table->{'id'}); 698: $logthis->(join($/,&Apache::lonmysql::build_table_creation_request($table))); 699: return 0; 700: } 701: } 702: return 1; 703: } 704: 705: sub drop_tables { 706: foreach my $table (@ID_Tables,@Activity_Table) { 707: my $table_id = $table->{'id'}; 708: &Apache::lonmysql::drop_table($table_id); 709: } 710: } 711: 712: ################################################################# 713: ################################################################# 714: ## 715: ## Database item id code 716: ## 717: ################################################################# 718: ################################################################# 719: { # Scoping for ID lookup code 720: my %IDs; 721: 722: sub read_id_tables { 723: foreach my $table (@ID_Tables) { 724: my @Data = &Apache::lonmysql::get_rows($table->{'id'}); 725: my $count = 0; 726: foreach my $row (@Data) { 727: $IDs{$table->{'id'}}->{$row->[1]} = $row->[0]; 728: } 729: } 730: return; 731: } 732: 733: sub get_id { 734: my ($table,$fieldname,$value) = @_; 735: if (exists($IDs{$table}->{$value})) { 736: return $IDs{$table}->{$value}; 737: } else { 738: # insert into the table - if the item already exists, that is 739: # okay. 740: my $result = &Apache::lonmysql::store_row($table,[undef,$value]); 741: if (! defined($result)) { 742: warn("Got error on id insert for $value\n".&Apache::lonmysql::get_error()); 743: } 744: # get the id 745: my @Data = 746: &Apache::lonmysql::get_rows($table,qq{$fieldname='$value'}); 747: if (@Data) { 748: $IDs{$table}->{$value}=$Data[0]->[0]; 749: return $IDs{$table}->{$value}; 750: } else { 751: $logthis->("Unable to retrieve id for $table $fieldname $value"); 752: return undef; 753: } 754: } 755: } 756: 757: } # End of ID scoping 758: 759: 760: ############################################################### 761: ############################################################### 762: ## 763: ## The usual suspects 764: ## 765: ############################################################### 766: ############################################################### 767: sub escape { 768: my $str=shift; 769: $str =~ s/(\W)/"%".unpack('H2',$1)/eg; 770: return $str; 771: } 772: 773: sub unescape { 774: my $str=shift; 775: $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; 776: return $str; 777: }