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