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