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