loncom/metadata_database/parse_activity_log.pl - view

File: [LON-CAPA] / loncom / metadata_database / parse_activity_log.pl
Revision 1.8: download - view: text, annotated - select for diffs
Mon Dec 20 19:53:36 2004 UTC (19 years, 6 months ago) by matthew
Branches: MAIN
CVS tags: HEAD

lonmysql:Added &table_information, which returns the metadata mysql keeps
    about the tables.
    Modified &update_table_info to turn the MySQL dates (creation,
    update, and check times) into unix times.
parse_activity_log.pl: Use LONCAPA::Configuration to set configuration
    options instead of the removed subroutine &initialize_configuration
    Modified backup handling code - if a table is missing and any of the
    current tables has been modified since the backup file was written,
    back up the current tables (even though one or more is missing) to
    a filename what will not be overwritten automatically, just to
    be sure no data is being lost.
    &load_backup_tables: Now actually use the filename we pass in instead of
    hard coding a file which may not actually exist.

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