loncom/metadata_database/parse_activity_log.pl - view

File: [LON-CAPA] / loncom / metadata_database / parse_activity_log.pl
Revision 1.16: download - view: text, annotated - select for diffs
Mon Sep 19 18:31:57 2005 UTC (18 years, 8 months ago) by matthew
Branches: MAIN
CVS tags: HEAD

Now hold exclusive lock on activity.log.lock until script exits, and if unable
to lock throw a warning and exit.
Added &clean_up_and_exit to attempt to make sure we die gracefully.
Fixed bug with $newfilename not being set properly (scoping issue).
get_id now uses $dbh->{'mysql_insertid'} to grab the last updated auto-increment column value.
&load_backup_xml_tables now uses $dbh->quote to quote values properly
&xml_store_id_table also uses $dbh->quote as well.

1: #!/usr/bin/perl 2: # 3: # The LearningOnline Network 4: # 5: # $Id: parse_activity_log.pl,v 1.16 2005/09/19 18:31:57 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: use HTML::TokeParser; 65: 66: # 67: # Determine parameters 68: my ($help,$course,$domain,$drop_when_done,$srcfile,$logfile,$time_run,$nocleanup,$log,$backup,$xmlfile); 69: &Getopt::Long::GetOptions( "course=s" => \$course, 70: "domain=s" => \$domain, 71: "backup" => \$backup, 72: "help" => \$help, 73: "logfile=s" => \$logfile, 74: "srcfile=s" => \$srcfile, 75: "justloadxml=s" => \$xmlfile, 76: "timerun" => \$time_run, 77: "nocleanup" => \$nocleanup, 78: "dropwhendone" => \$drop_when_done, 79: "log" => \$log); 80: if (! defined($course) || $help) { 81: print<<USAGE; 82: parse_activity_log.pl 83: 84: Process a lon-capa activity log into a database. 85: Parameters: 86: course Required 87: domain optional 88: backup optional if present, backup the activity log file 89: before processing it 90: dropwhendone optional if present, drop all course 91: specific activity log tables after processing. 92: srcfile optional Specify the file to parse, including path 93: time optional if present, print out timing data 94: nocleanup optional if present, do not remove old files 95: log optional if present, prepare log file of activity 96: logfile optional specifies the logfile to use 97: Examples: 98: $0 -course=123456abcdef -domain=msu 99: $0 -course=123456abcdef -srcfile=activity.log 100: $0 -course-123456abcdef -log -logfile=/tmp/logfile -dropwhendone 101: USAGE 102: exit; 103: } 104: 105: ## 106: ## Set up timing code 107: my $time_this = \&nothing; 108: if ($time_run) { 109: $time_this = \&time_action; 110: } 111: my $initial_time = Time::HiRes::time; 112: 113: ## 114: ## Read in configuration parameters 115: ## 116: my %perlvar = %{&LONCAPA::Configuration::read_conf('loncapa.conf')}; 117: 118: if (! defined($domain) || $domain eq '') { 119: $domain = $perlvar{'lonDefDomain'}; 120: } 121: &update_process_name($course.'@'.$domain); 122: 123: ## 124: ## Set up logging code 125: my $logthis = \&nothing; 126: 127: if ($log) { 128: if (! $logfile) { 129: $logfile = $perlvar{'lonDaemons'}.'/tmp/parse_activity_log.log.'.time; 130: } 131: print STDERR "$0: logging to $logfile".$/; 132: if (! open(LOGFILE,">$logfile")) { 133: warn("Unable to open $logfile for writing. Run aborted."); 134: &cleanup_and_exit(5); 135: } else { 136: $logthis = \&log_to_file; 137: } 138: } 139: 140: 141: ## 142: ## Determine filenames 143: ## 144: my $sourcefilename; # activity log data 145: my $newfilename; # $sourcefilename will be renamed to this 146: my $error_filename; # Errors in parsing the activity log will be written here 147: if ($srcfile) { 148: $sourcefilename = $srcfile; 149: } else { 150: $sourcefilename = &get_filename($course,$domain); 151: } 152: my $sql_filename = $sourcefilename; 153: $sql_filename =~ s|[^/]*$|activity.log.sql|; 154: my $gz_sql_filename = $sql_filename.'.gz'; 155: # 156: my $xml_filename = $sourcefilename; 157: my $gz_xml_filename = $xml_filename.'.gz'; 158: if (defined($xmlfile)) { 159: $xml_filename = $xmlfile; 160: if ($xml_filename =~ /\.gz$/) { 161: $gz_xml_filename = $xml_filename; 162: } else { 163: $gz_xml_filename = $xml_filename.'.gz'; 164: } 165: } else { 166: my $xml_filename = $sourcefilename; 167: $xml_filename =~ s|[^/]*$|activity.log.xml|; 168: $gz_xml_filename = $xml_filename.'.gz'; 169: } 170: # 171: $error_filename = $sourcefilename; 172: $error_filename =~ s|[^/]*$|activity.log.errors|; 173: $logthis->('Beginning logging '.time); 174: 175: # 176: # Wait for a lock on the lockfile to avoid collisions 177: my $lockfilename = $sourcefilename.'.lock'; 178: $newfilename = $sourcefilename.'.processing'; 179: if (! defined($xmlfile)) { 180: open(LOCKFILE,'>'.$lockfilename); 181: if (!flock(LOCKFILE,LOCK_EX|LOCK_NB)) { 182: warn("Unable to lock $lockfilename. Aborting".$/); 183: &clean_up_and_exit(6); 184: } 185: 186: if (! -e $newfilename && -e $sourcefilename) { 187: $logthis->('renaming '.$sourcefilename.' to '.$newfilename); 188: rename($sourcefilename,$newfilename); 189: Copy($newfilename,$newfilename.'.'.time) if ($backup); 190: $logthis->("renamed $sourcefilename to $newfilename"); 191: } elsif (! -e $newfilename) { 192: utime(undef,undef,$newfilename); 193: } 194: } 195: 196: ## 197: ## Table definitions 198: ## 199: my %tables = &table_names($course,$domain); 200: my $student_table_def = 201: { id => $tables{'student'}, 202: permanent => 'no', 203: columns => [ 204: { name => 'student_id', 205: type => 'MEDIUMINT UNSIGNED', 206: restrictions => 'NOT NULL', 207: auto_inc => 'yes', }, 208: { name => 'student', 209: type => 'VARCHAR(100) BINARY', 210: restrictions => 'NOT NULL', }, 211: ], 212: 'PRIMARY KEY' => ['student_id',], 213: }; 214: 215: my $res_table_def = 216: { id => $tables{'res'}, 217: permanent => 'no', 218: columns => [{ name => 'res_id', 219: type => 'MEDIUMINT UNSIGNED', 220: restrictions => 'NOT NULL', 221: auto_inc => 'yes', }, 222: { name => 'resource', 223: type => 'MEDIUMTEXT', 224: restrictions => 'NOT NULL'}, 225: ], 226: 'PRIMARY KEY' => ['res_id'], 227: }; 228: 229: #my $action_table_def = 230: #{ id => $action_table, 231: # permanent => 'no', 232: # columns => [{ name => 'action_id', 233: # type => 'MEDIUMINT UNSIGNED', 234: # restrictions => 'NOT NULL', 235: # auto_inc => 'yes', }, 236: # { name => 'action', 237: # type => 'VARCHAR(100)', 238: # restrictions => 'NOT NULL'}, 239: # ], 240: # 'PRIMARY KEY' => ['action_id',], 241: #}; 242: 243: my $machine_table_def = 244: { id => $tables{'machine'}, 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_def = 258: { id => $tables{'activity'}, 259: permanent => 'no', 260: columns => [ 261: { name => 'res_id', 262: type => 'MEDIUMINT UNSIGNED', 263: restrictions => 'NOT NULL',}, 264: { name => 'time', 265: type => 'DATETIME', 266: restrictions => 'NOT NULL',}, 267: { name => 'student_id', 268: type => 'MEDIUMINT UNSIGNED', 269: restrictions => 'NOT NULL',}, 270: { name => 'action', 271: type => 'VARCHAR(10)', 272: restrictions => 'NOT NULL',}, 273: { name => 'idx', # This is here in case a student 274: type => 'MEDIUMINT UNSIGNED', # has multiple submissions during 275: restrictions => 'NOT NULL', # one second. It happens, trust 276: auto_inc => 'yes', }, # me. 277: { name => 'machine_id', 278: type => 'MEDIUMINT UNSIGNED', 279: restrictions => 'NOT NULL',}, 280: { name => 'action_values', 281: type => 'MEDIUMTEXT', }, 282: ], 283: 'PRIMARY KEY' => ['time','student_id','res_id','idx'], 284: 'KEY' => [{columns => ['student_id']}, 285: {columns => ['time']},], 286: }; 287: 288: my @Activity_Table = ($activity_table_def); 289: my @ID_Tables = ($student_table_def,$res_table_def,$machine_table_def); 290: 291: ## 292: ## End of table definitions 293: ## 294: $logthis->('tables = '.join(',',keys(%tables))); 295: 296: $logthis->('Connectiong to mysql'); 297: &Apache::lonmysql::set_mysql_user_and_password('www', 298: $perlvar{'lonSqlAccess'}); 299: if (!&Apache::lonmysql::verify_sql_connection()) { 300: warn "Unable to connect to MySQL database."; 301: $logthis->("Unable to connect to MySQL database."); 302: &clean_up_and_exit(3); 303: } 304: $logthis->('SQL connection is up'); 305: 306: my $missing_table = &check_for_missing_tables(values(%tables)); 307: if (-s $gz_sql_filename && ! -s $gz_xml_filename) { 308: my $backup_modification_time = (stat($gz_sql_filename))[9]; 309: $logthis->($gz_sql_filename.' was last modified '. 310: localtime($backup_modification_time). 311: '('.$backup_modification_time.')'); 312: if ($missing_table) { 313: # If the backup happened prior to the last table modification, 314: # we need to save the tables. 315: if (&latest_table_modification_time() > $backup_modification_time) { 316: # Save the current tables in case we need them another time. 317: $logthis->('Backing existing tables up'); 318: &backup_tables_as_xml($gz_xml_filename.'.save_'.time,\%tables); 319: } 320: $time_this->(); 321: &load_backup_sql_tables($gz_sql_filename); 322: &backup_tables_as_xml($gz_xml_filename,\%tables); 323: $time_this->('load backup tables'); 324: } 325: } elsif (-s $gz_xml_filename) { 326: my $backup_modification_time = (stat($gz_xml_filename))[9]; 327: $logthis->($gz_xml_filename.' was last modified '. 328: localtime($backup_modification_time). 329: '('.$backup_modification_time.')'); 330: if ($missing_table) { 331: my $table_modification_time = $backup_modification_time; 332: # If the backup happened prior to the last table modification, 333: # we need to save the tables. 334: if (&latest_table_modification_time() > $backup_modification_time) { 335: # Save the current tables in case we need them another time. 336: $logthis->('Backing existing tables up'); 337: &backup_tables_as_xml($gz_xml_filename.'.save_'.time,\%tables); 338: } 339: $time_this->(); 340: # We have to make our own tables for the xml format 341: &drop_tables(); 342: &create_tables(); 343: &load_backup_xml_tables($gz_xml_filename,\%tables); 344: $time_this->('load backup tables'); 345: } 346: } 347: 348: if (defined($xmlfile)) { 349: &clean_up_and_exit(0); 350: } 351: 352: ## 353: ## Ensure the tables we need exist 354: # create_tables does not complain if the tables already exist 355: $logthis->('creating tables'); 356: if (! &create_tables()) { 357: warn "Unable to create tables"; 358: $logthis->('Unable to create tables'); 359: &clean_up_and_exit(4); 360: } 361: 362: ## 363: ## Read the ids used for various tables 364: $logthis->('reading id tables'); 365: &read_id_tables(); 366: $logthis->('finished reading id tables'); 367: 368: ## 369: ## Set up the errors file 370: my $error_fh = IO::File->new(">>$error_filename"); 371: 372: ## 373: ## Parse the course log 374: $logthis->('processing course log'); 375: if (-s $newfilename) { 376: my $result = &process_courselog($newfilename,$error_fh,\%tables); 377: if (! defined($result)) { 378: # Something went wrong along the way... 379: $logthis->('process_courselog returned undef'); 380: &clean_up_and_exit(5); 381: } elsif ($result > 0) { 382: $time_this->(); 383: $logthis->('process_courselog returned '.$result.'.'.$/. 384: 'Backing up tables'); 385: &backup_tables_as_xml($gz_xml_filename,\%tables); 386: $time_this->('write backup tables'); 387: } 388: if ($drop_when_done) { &drop_tables(); $logthis->('dropped tables'); } 389: } 390: close($error_fh); 391: 392: ## 393: ## Clean up the filesystem 394: &Apache::lonmysql::disconnect_from_db(); 395: unlink($newfilename) if (-e $newfilename && ! $nocleanup); 396: 397: ## 398: ## Print timing data 399: $logthis->('printing timing data'); 400: if ($time_run) { 401: my $elapsed_time = Time::HiRes::time - $initial_time; 402: print "Overall time: ".$elapsed_time.$/; 403: print &outputtimes(); 404: $logthis->("Overall time: ".$elapsed_time); 405: $logthis->(&outputtimes()); 406: } 407: 408: &clean_up_and_exit(0); 409: 410: ######################################################## 411: ######################################################## 412: 413: sub clean_up_and_exit { 414: my ($exit_code) = @_; 415: # Close files 416: close(LOCKFILE); 417: close(LOGFILE); 418: # Remove zero length files 419: foreach my $file ($lockfilename, $error_filename,$logfile) { 420: if (defined($file) && -z $file) { 421: unlink($file); 422: } 423: } 424: 425: exit $exit_code; 426: } 427: 428: ######################################################## 429: ######################################################## 430: sub table_names { 431: my ($course,$domain) = @_; 432: my $prefix = $course.'_'.$domain.'_'; 433: # 434: my %tables = 435: ( student =>&Apache::lonmysql::fix_table_name($prefix.'students'), 436: res =>&Apache::lonmysql::fix_table_name($prefix.'resource'), 437: machine =>&Apache::lonmysql::fix_table_name($prefix.'machine_table'), 438: activity=>&Apache::lonmysql::fix_table_name($prefix.'activity'), 439: ); 440: return %tables; 441: } 442: 443: ######################################################## 444: ######################################################## 445: ## 446: ## Process Course Log 447: ## 448: ######################################################## 449: ######################################################## 450: # 451: # Returns the number of lines in the activity.log file that were processed. 452: sub process_courselog { 453: my ($inputfile,$error_fh,$tables) = @_; 454: if (! open(IN,$inputfile)) { 455: warn "Unable to open '$inputfile' for reading"; 456: $logthis->("Unable to open '$inputfile' for reading"); 457: return undef; 458: } 459: my ($linecount,$insertcount); 460: my $dbh = &Apache::lonmysql::get_dbh(); 461: # 462: &store_entry(); 463: while (my $line=<IN>){ 464: # last if ($linecount > 1000); 465: # 466: # Bulk storage variables 467: $time_this->(); 468: chomp($line); 469: $linecount++; 470: # print $linecount++.$/; 471: my ($timestamp,$host,$log)=split(/\:/,$line,3); 472: # 473: # $log has the actual log entries; currently still escaped, and 474: # %26(timestamp)%3a(url)%3a(user)%3a(domain) 475: # then additionally 476: # %3aPOST%3a(name)%3d(value)%3a(name)%3d(value) 477: # or 478: # %3aCSTORE%3a(name)%3d(value)%26(name)%3d(value) 479: # 480: # get delimiter between timestamped entries to be &&& 481: $log=~s/\%26(\d{9,10})\%3a/\&\&\&$1\%3a/g; 482: $log = &unescape($log); 483: # now go over all log entries 484: if (! defined($host)) { $host = 'unknown'; } 485: my $prevchunk = 'none'; 486: foreach my $chunk (split(/\&\&\&/,$log)) { 487: my $warningflag = ''; 488: my ($time,$res,$uname,$udom,$action,@values)= split(/:/,$chunk); 489: if (! defined($res) || $res =~ /^\s*$/) { 490: $res = '/adm/roles'; 491: $action = 'LOGIN'; 492: } 493: if ($res =~ m|^/prtspool/|) { 494: $res = '/prtspool/'; 495: } 496: if (! defined($action) || $action eq '') { 497: $action = 'VIEW'; 498: } 499: if ($action !~ /^(LOGIN|VIEW|POST|CSTORE|STORE)$/) { 500: $warningflag .= 'action'; 501: print $error_fh 'full log entry:'.$log.$/; 502: print $error_fh 'error on chunk:'.$chunk.$/; 503: $logthis->('(action) Unable to parse '.$/.$chunk.$/. 504: 'got '. 505: 'time = '.$time.$/. 506: 'res = '.$res.$/. 507: 'uname= '.$uname.$/. 508: 'udom = '.$udom.$/. 509: 'action='.$action.$/. 510: '@values = '.join('&',@values)); 511: next; #skip it if we cannot understand what is happening. 512: } 513: # 514: my %data = (student => $uname.':'.$udom, 515: resource => $res, 516: machine => $host, 517: action => $action, 518: time => &Apache::lonmysql::sqltime($time)); 519: if ($action eq 'POST') { 520: $data{'action_values'} = 521: $dbh->quote(join('&',map { &escape($_); } @values)); 522: } else { 523: $data{'action_values'} = $dbh->quote(join('&',@values)); 524: } 525: my $error = &store_entry($dbh,$tables,\%data); 526: if ($error) { 527: $logthis->('error store_entry:'.$error." on %data"); 528: } 529: $prevchunk = $chunk; 530: } 531: } 532: my $result = &store_entry($dbh,$tables); 533: if (! defined($result)) { 534: my $error = &Apache::lonmysql::get_error(); 535: warn "Error occured during insert.".$error; 536: $logthis->('error = '.$error); 537: } 538: close IN; 539: return $linecount; 540: } 541: 542: 543: ## 544: ## default value for $logthis and $time_this 545: sub nothing { 546: return; 547: } 548: 549: ## 550: ## Logging routine (look for $log) 551: ## 552: sub log_to_file { 553: my ($input)=@_; 554: print LOGFILE $input.$/; 555: } 556: 557: ## 558: ## Timing routines 559: ## 560: { 561: my %Timing; 562: my $starttime; 563: 564: sub time_action { 565: my ($key) = @_; 566: if (defined($key)) { 567: $Timing{$key}+=Time::HiRes::time-$starttime; 568: $Timing{'count_'.$key}++; 569: } 570: $starttime = Time::HiRes::time; 571: } 572: 573: sub outputtimes { 574: my $Str; 575: if ($time_run) { 576: $Str = "Timing Data:".$/; 577: while (my($k,$v) = each(%Timing)) { 578: next if ($k =~ /^count_/); 579: my $count = $Timing{'count_'.$k}; 580: $Str .= 581: ' '.sprintf("%25.25s",$k). 582: ' '.sprintf('% 8d',$count). 583: ' '.sprintf('%12.5f',$v).$/; 584: } 585: } 586: return $Str; 587: } 588: 589: } 590: 591: sub latest_table_modification_time { 592: my $latest_time; 593: foreach my $table (@Activity_Table,@ID_Tables) { 594: my %tabledata = &Apache::lonmysql::table_information($table->{'id'}); 595: next if (! scalar(keys(%tabledata))); # table does not exist 596: if (! defined($latest_time) || 597: $latest_time < $tabledata{'Update_time'}) { 598: $latest_time = $tabledata{'Update_time'}; 599: } 600: } 601: return $latest_time; 602: } 603: 604: sub check_for_missing_tables { 605: my @wanted_tables = @_; 606: # Check for missing tables 607: my @Current_Tables = &Apache::lonmysql::tables_in_db(); 608: my %Found; 609: foreach my $tablename (@Current_Tables) { 610: foreach my $table (@wanted_tables) { 611: if ($tablename eq $table) { 612: $Found{$tablename}++; 613: } 614: } 615: } 616: $logthis->('Found tables '.join(',',keys(%Found))); 617: my $missing_a_table = 0; 618: foreach my $table (@wanted_tables) { 619: if (! $Found{$table}) { 620: $logthis->('Missing table '.$table); 621: $missing_a_table = 1; 622: last; 623: } 624: } 625: return $missing_a_table; 626: } 627: 628: ## 629: ## Use mysqldump to store backups of the tables 630: ## 631: sub backup_tables_as_sql { 632: my ($gz_sql_filename) = @_; 633: my $command = qq{mysqldump --quote-names --opt loncapa }; 634: foreach my $table (@ID_Tables,@Activity_Table) { 635: my $tablename = $table->{'id'}; 636: $tablename =~ s/\`//g; 637: $command .= $tablename.' '; 638: } 639: $command .= '| gzip >'.$gz_sql_filename; 640: $logthis->($command); 641: system($command); 642: } 643: 644: ## 645: ## Load in mysqldumped files 646: ## 647: sub load_backup_sql_tables { 648: my ($gz_sql_filename) = @_; 649: if (-s $gz_sql_filename) { 650: $logthis->('loading data from gzipped sql file'); 651: my $command='gzip -dc '.$gz_sql_filename.' | mysql --database=loncapa'; 652: system($command); 653: $logthis->('finished loading gzipped data');; 654: } else { 655: return undef; 656: } 657: } 658: 659: ## 660: ## 661: ## 662: sub update_process_name { 663: my ($text) = @_; 664: $0 = 'parse_activity_log.pl: '.$text; 665: } 666: 667: sub get_filename { 668: my ($course,$domain) = @_; 669: my ($a,$b,$c,undef) = split('',$course,4); 670: return "$perlvar{'lonUsersDir'}/$domain/$a/$b/$c/$course/activity.log"; 671: } 672: 673: sub create_tables { 674: foreach my $table (@ID_Tables,@Activity_Table) { 675: my $table_id = &Apache::lonmysql::create_table($table); 676: if (! defined($table_id)) { 677: warn "Unable to create table ".$table->{'id'}.$/; 678: $logthis->('Unable to create table '.$table->{'id'}); 679: $logthis->(join($/,&Apache::lonmysql::build_table_creation_request($table))); 680: return 0; 681: } 682: } 683: return 1; 684: } 685: 686: sub drop_tables { 687: foreach my $table (@ID_Tables,@Activity_Table) { 688: my $table_id = $table->{'id'}; 689: &Apache::lonmysql::drop_table($table_id); 690: } 691: } 692: 693: ################################################################# 694: ################################################################# 695: ## 696: ## Database item id code 697: ## 698: ################################################################# 699: ################################################################# 700: { # Scoping for ID lookup code 701: my %IDs; 702: 703: sub read_id_tables { 704: foreach my $table (@ID_Tables) { 705: my @Data = &Apache::lonmysql::get_rows($table->{'id'}); 706: my $count = 0; 707: foreach my $row (@Data) { 708: $IDs{$table->{'id'}}->{$row->[1]} = $row->[0]; 709: } 710: } 711: return; 712: } 713: 714: sub get_id { 715: my ($table,$fieldname,$value) = @_; 716: if (exists($IDs{$table}->{$value}) && $IDs{$table}->{$value} =~ /^\d+$/) { 717: return $IDs{$table}->{$value}; 718: } else { 719: # insert into the table - if the item already exists, that is 720: # okay. 721: my $result = &Apache::lonmysql::store_row($table,[undef,$value]); 722: if (! defined($result)) { 723: warn("Got error on id insert for $value\n". 724: &Apache::lonmysql::get_error()); 725: } 726: # get the id 727: my $id = &Apache::lonmysql::get_dbh()->{'mysql_insertid'}; 728: if (defined($id)) { 729: $IDs{$table}->{$value}=$id; 730: } else { 731: $logthis->("Unable to retrieve id for $table $fieldname $value"); 732: return undef; 733: } 734: } 735: } 736: 737: } # End of ID scoping 738: 739: ############################################################### 740: ############################################################### 741: ## 742: ## Save as XML 743: ## 744: ############################################################### 745: ############################################################### 746: sub backup_tables_as_xml { 747: my ($filename,$tables) = @_; 748: open(XMLFILE,"|gzip - > $filename") || return ('error:unable to write '.$filename); 749: my $query = qq{ 750: SELECT B.resource, 751: A.time, 752: A.idx, 753: C.student, 754: A.action, 755: E.machine, 756: A.action_values 757: FROM $tables->{'activity'} AS A 758: LEFT JOIN $tables->{'res'} AS B ON B.res_id=A.res_id 759: LEFT JOIN $tables->{'student'} AS C ON C.student_id=A.student_id 760: LEFT JOIN $tables->{'machine'} AS E ON E.machine_id=A.machine_id 761: ORDER BY A.time DESC 762: }; 763: $query =~ s/\s+/ /g; 764: my $dbh = &Apache::lonmysql::get_dbh(); 765: my $sth = $dbh->prepare($query); 766: if (! $sth->execute()) { 767: $logthis->('<font color="blue">'. 768: 'WARNING: Could not retrieve from database:'. 769: $sth->errstr().'</font>'); 770: return undef; 771: } else { 772: my ($res,$sqltime,$idx,$student,$action,$machine,$action_values); 773: if ($sth->bind_columns(\$res,\$sqltime,\$idx,\$student,\$action, 774: \$machine,\$action_values)) { 775: 776: while ($sth->fetch) { 777: print XMLFILE '<row>'. 778: qq{<resource>$res</resource>}. 779: qq{<time>$sqltime</time>}. 780: qq{<idx>$idx</idx>}. 781: qq{<student>$student</student>}. 782: qq{<action>$action</action>}. 783: qq{<machine>$machine</machine>}. 784: qq{<action_values>$action_values</action_values>}. 785: '</row>'.$/; 786: } 787: } else { 788: warn "Unable to bind to columns.\n"; 789: return undef; 790: } 791: } 792: close XMLFILE; 793: return; 794: } 795: 796: ############################################################### 797: ############################################################### 798: ## 799: ## load as xml 800: ## 801: ############################################################### 802: ############################################################### 803: { 804: my @fields = ('resource','time', 805: 'student','action','idx','machine','action_values'); 806: my %ids = (); 807: sub load_backup_xml_tables { 808: my ($filename,$tables) = @_; 809: my $dbh = &Apache::lonmysql::get_dbh(); 810: my $xmlfh; 811: open($xmlfh,"cat $filename | gzip -d - |"); 812: if (! defined($xmlfh)) { 813: return ('error:unable to read '.$filename); 814: } 815: # 816: %ids = (resource=> {"\0count"=>1}, 817: student=> {"\0count"=>1}, 818: machine=> {"\0count"=>1}); 819: # 820: my %data; 821: while (my $inputline = <$xmlfh>) { 822: my ($resource,$time,undef,$student,$action,$machine,$action_values) = 823: ($inputline =~ m{<row> 824: <resource>(.*)</resource> 825: <time>(.*)</time> 826: <idx>(.*)</idx> 827: <student>(.*)</student> 828: <action>(.*)</action> 829: <machine>(.*)</machine> 830: <action_values>(.*)</action_values> 831: </row>$ 832: }x 833: ); 834: my $resource_id = &xml_get_id('resource',$resource); 835: my $student_id = &xml_get_id('student',$student); 836: my $machine_id = &xml_get_id('machine',$machine); 837: &xml_store_activity_row(map { defined($_)?$dbh->quote($_):'' 838: } ($resource_id, 839: $time, 840: $student_id, 841: $action, 842: 'NULL', 843: $machine_id, 844: $action_values)); 845: } 846: &xml_store_activity_row(); 847: close($xmlfh); 848: # Store id tables 849: while (my ($id_name,$id_data) = each(%ids)) { 850: if ($id_name eq 'resource') { $id_name = 'res'; } 851: delete($id_data->{"\0count"}); 852: &xml_store_id_table($id_name,$id_data); 853: } 854: return; 855: } 856: 857: sub xml_get_id { 858: my ($table,$element) = @_; 859: if (! exists($ids{$table}->{$element})) { 860: $ids{$table}->{$element} = $ids{$table}->{"\0count"}++; 861: } 862: return $ids{$table}->{$element}; 863: } 864: 865: { 866: my @data_rows; 867: sub xml_store_activity_row { 868: my @data = @_; 869: if (scalar(@data)) { 870: push(@data_rows,[@data]); 871: } 872: if (! scalar(@data) || scalar(@data_rows) > 500) { 873: if (! &Apache::lonmysql::bulk_store_rows($tables{'activity'}, 874: scalar(@{$data_rows[0]}), 875: \@data_rows)) { 876: $logthis->("Error:".&Apache::lonmysql::get_error()); 877: warn("Error:".&Apache::lonmysql::get_error()); 878: } else { 879: undef(@data_rows); 880: } 881: } 882: return; 883: } 884: 885: } 886: 887: sub xml_store_id_table { 888: my ($table,$tabledata) =@_; 889: my $dbh = &Apache::lonmysql::get_dbh(); 890: if (! &Apache::lonmysql::bulk_store_rows 891: ($tables{$table},2, 892: [map{[$tabledata->{$_},$dbh->quote($_)]} keys(%$tabledata)])) { 893: $logthis->("Error:".&Apache::lonmysql::get_error()); 894: warn "Error:".&Apache::lonmysql::get_error().$/; 895: } 896: } 897: 898: } # End of load xml scoping 899: 900: ####################################################################### 901: ####################################################################### 902: ## 903: ## store_entry - accumulate data to be inserted into the database 904: ## 905: ## Pass no values in to clear accumulator 906: ## Pass ($dbh,\%tables) to initiate storage of values 907: ## Pass ($dbh,\%tables,\%data) to use normally 908: ## 909: ####################################################################### 910: ####################################################################### 911: { 912: my @rows; 913: my $max_row_count = 100; 914: 915: sub store_entry { 916: if (! @_) { 917: undef(@rows); 918: return ''; 919: } 920: my ($dbh,$tables,$data) = @_; 921: return if (! defined($tables)); 922: if (defined($data)) { 923: my $error; 924: foreach my $field ('student','resource','action','time') { 925: if (! defined($data->{$field}) || $data->{$field} eq ':' || 926: $data->{$field}=~ /^\s*$/) { 927: $error.=$field.','; 928: } 929: } 930: if ($error) { $error=~s/,$//; return $error; } 931: # 932: my $student_id = &get_id($tables->{'student'},'student', 933: $data->{'student'}); 934: my $res_id = &get_id($tables->{'res'}, 935: 'resource',$data->{'resource'}); 936: my $machine_id = &get_id($tables->{'machine'}, 937: 'machine',$data->{'machine'}); 938: my $idx = $data->{'idx'}; if (! $idx) { $idx = "''"; } 939: # 940: push(@rows,[$res_id, 941: qq{'$data->{'time'}'}, 942: $student_id, 943: qq{'$data->{'action'}'}, 944: $idx, 945: $machine_id, 946: $data->{'action_values'}]); 947: } 948: if (defined($tables) && 949: ( (! defined($data) && scalar(@rows)) || scalar(@rows)>$max_row_count) 950: ){ 951: # Store the rows 952: my $result = 953: &Apache::lonmysql::bulk_store_rows($tables->{'activity'}, 954: undef, 955: \@rows); 956: if (! defined($result)) { 957: my $error = &Apache::lonmysql::get_error(); 958: warn "Error occured during insert.".$error; 959: return $error; 960: } 961: undef(@rows); 962: return $result if (! defined($data)); 963: } 964: return ''; 965: } 966: 967: } # end of scope for &store_entry 968: 969: ############################################################### 970: ############################################################### 971: ## 972: ## The usual suspects 973: ## 974: ############################################################### 975: ############################################################### 976: sub escape { 977: my $str=shift; 978: $str =~ s/(\W)/"%".unpack('H2',$1)/eg; 979: return $str; 980: } 981: 982: sub unescape { 983: my $str=shift; 984: $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; 985: return $str; 986: }