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