Annotation of loncom/metadata_database/parse_activity_log.pl, revision 1.15
1.1 matthew 1: #!/usr/bin/perl
2: #
3: # The LearningOnline Network
4: #
1.15 ! matthew 5: # $Id: parse_activity_log.pl,v 1.14 2005/03/31 22:09:40 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);
1.14 matthew 64: use HTML::TokeParser;
1.7 matthew 65:
1.1 matthew 66: #
67: # Determine parameters
1.15 ! matthew 68: my ($help,$course,$domain,$drop_when_done,$srcfile,$logfile,$time_run,$nocleanup,$log,$backup,$xmlfile);
1.1 matthew 69: &Getopt::Long::GetOptions( "course=s" => \$course,
70: "domain=s" => \$domain,
1.5 matthew 71: "backup" => \$backup,
1.1 matthew 72: "help" => \$help,
1.12 matthew 73: "logfile=s" => \$logfile,
74: "srcfile=s" => \$srcfile,
1.15 ! matthew 75: "justloadxml=s" => \$xmlfile,
1.1 matthew 76: "timerun" => \$time_run,
77: "nocleanup" => \$nocleanup,
1.12 matthew 78: "dropwhendone" => \$drop_when_done,
1.2 matthew 79: "log" => \$log);
1.1 matthew 80: if (! defined($course) || $help) {
81: print<<USAGE;
82: parse_activity_log.pl
83:
84: Process a lon-capa activity log into a database.
85: Parameters:
86: course Required
1.12 matthew 87: domain optional
1.5 matthew 88: backup optional if present, backup the activity log file
89: before processing it
1.12 matthew 90: dropwhendone optional if present, drop all course
91: specific activity log tables after processing.
92: srcfile optional Specify the file to parse, including path
1.1 matthew 93: time optional if present, print out timing data
94: nocleanup optional if present, do not remove old files
1.2 matthew 95: log optional if present, prepare log file of activity
1.12 matthew 96: logfile optional specifies the logfile to use
1.1 matthew 97: Examples:
98: $0 -course=123456abcdef -domain=msu
1.12 matthew 99: $0 -course=123456abcdef -srcfile=activity.log
100: $0 -course-123456abcdef -log -logfile=/tmp/logfile -dropwhendone
1.1 matthew 101: USAGE
102: exit;
103: }
104:
105: ##
106: ## Set up timing code
107: my $time_this = \¬hing;
108: if ($time_run) {
109: $time_this = \&time_action;
110: }
111: my $initial_time = Time::HiRes::time;
112:
113: ##
1.3 matthew 114: ## Read in configuration parameters
115: ##
1.8 matthew 116: my %perlvar = %{&LONCAPA::Configuration::read_conf('loncapa.conf')};
117:
1.3 matthew 118: if (! defined($domain) || $domain eq '') {
119: $domain = $perlvar{'lonDefDomain'};
120: }
121: &update_process_name($course.'@'.$domain);
122:
123: ##
1.2 matthew 124: ## Set up logging code
125: my $logthis = \¬hing;
1.12 matthew 126:
1.2 matthew 127: if ($log) {
1.12 matthew 128: if (! $logfile) {
129: $logfile = $perlvar{'lonDaemons'}.'/tmp/parse_activity_log.log.'.time;
130: }
1.2 matthew 131: print STDERR "$0: logging to $logfile".$/;
132: if (! open(LOGFILE,">$logfile")) {
1.9 matthew 133: warn("Unable to open $logfile for writing. Run aborted.");
134: exit 5;
1.2 matthew 135: } else {
136: $logthis = \&log_to_file;
137: }
138: }
1.3 matthew 139:
1.1 matthew 140:
141: ##
142: ## Determine filenames
143: ##
144: my $sourcefilename; # activity log data
145: my $newfilename; # $sourcefilename will be renamed to this
1.3 matthew 146: my $error_filename; # Errors in parsing the activity log will be written here
1.12 matthew 147: if ($srcfile) {
148: $sourcefilename = $srcfile;
1.1 matthew 149: } else {
150: $sourcefilename = &get_filename($course,$domain);
151: }
1.6 matthew 152: my $sql_filename = $sourcefilename;
1.2 matthew 153: $sql_filename =~ s|[^/]*$|activity.log.sql|;
1.14 matthew 154: my $gz_sql_filename = $sql_filename.'.gz';
155: #
156: my $xml_filename = $sourcefilename;
157: my $gz_xml_filename = $xml_filename.'.gz';
1.15 ! matthew 158: if (defined($xmlfile)) {
! 159: $xml_filename = $xmlfile;
! 160: if ($xml_filename =~ /\.gz$/) {
! 161: $gz_xml_filename = $xml_filename;
! 162: } else {
! 163: $gz_xml_filename = $xml_filename.'.gz';
! 164: }
! 165: } else {
! 166: my $xml_filename = $sourcefilename;
! 167: $xml_filename =~ s|[^/]*$|activity.log.xml|;
! 168: $gz_xml_filename = $xml_filename.'.gz';
! 169: }
1.14 matthew 170: #
1.3 matthew 171: $error_filename = $sourcefilename;
172: $error_filename =~ s|[^/]*$|activity.log.errors|;
173: $logthis->('Beginning logging '.time);
1.1 matthew 174:
1.7 matthew 175: #
176: # Wait for a lock on the lockfile to avoid collisions
177: my $lockfilename = $sourcefilename.'.lock';
1.15 ! matthew 178: if (! defined($xmlfile)) {
1.7 matthew 179: open(LOCKFILE,'>'.$lockfilename);
1.9 matthew 180: if (!flock(LOCKFILE,LOCK_EX)) {
181: warn("Unable to lock $lockfilename. Aborting".$/);
182: exit 6;
183: }
1.7 matthew 184:
1.1 matthew 185: ##
186: ## There will only be a $newfilename file if a copy of this program is already
187: ## running.
188: my $newfilename = $sourcefilename.'.processing';
189: if (-e $newfilename) {
190: warn "$newfilename exists";
1.7 matthew 191: $logthis->($newfilename.' exists, so I cannot work on it.');
1.1 matthew 192: exit 2;
193: }
194:
195: if (-e $sourcefilename) {
1.3 matthew 196: $logthis->('renaming '.$sourcefilename.' to '.$newfilename);
1.1 matthew 197: rename($sourcefilename,$newfilename);
1.5 matthew 198: Copy($newfilename,$newfilename.'.'.time) if ($backup);
1.2 matthew 199: $logthis->("renamed $sourcefilename to $newfilename");
1.3 matthew 200: } else {
201: my $command = 'touch '.$newfilename;
202: $logthis->($command);
203: system($command);
204: $logthis->('touch was completed');
1.1 matthew 205: }
206:
1.7 matthew 207: close(LOCKFILE);
1.15 ! matthew 208: }
1.1 matthew 209: ##
210: ## Table definitions
211: ##
1.14 matthew 212: my %tables = &table_names($course,$domain);
1.1 matthew 213: my $student_table_def =
1.14 matthew 214: { id => $tables{'student'},
1.1 matthew 215: permanent => 'no',
216: columns => [
217: { name => 'student_id',
218: type => 'MEDIUMINT UNSIGNED',
219: restrictions => 'NOT NULL',
220: auto_inc => 'yes', },
221: { name => 'student',
222: type => 'VARCHAR(100) BINARY',
223: restrictions => 'NOT NULL', },
224: ],
225: 'PRIMARY KEY' => ['student_id',],
226: };
227:
228: my $res_table_def =
1.14 matthew 229: { id => $tables{'res'},
1.1 matthew 230: permanent => 'no',
231: columns => [{ name => 'res_id',
232: type => 'MEDIUMINT UNSIGNED',
233: restrictions => 'NOT NULL',
234: auto_inc => 'yes', },
235: { name => 'resource',
236: type => 'MEDIUMTEXT',
237: restrictions => 'NOT NULL'},
238: ],
239: 'PRIMARY KEY' => ['res_id'],
240: };
241:
1.4 matthew 242: #my $action_table_def =
243: #{ id => $action_table,
244: # permanent => 'no',
245: # columns => [{ name => 'action_id',
246: # type => 'MEDIUMINT UNSIGNED',
247: # restrictions => 'NOT NULL',
248: # auto_inc => 'yes', },
249: # { name => 'action',
250: # type => 'VARCHAR(100)',
251: # restrictions => 'NOT NULL'},
252: # ],
253: # 'PRIMARY KEY' => ['action_id',],
254: #};
1.1 matthew 255:
256: my $machine_table_def =
1.14 matthew 257: { id => $tables{'machine'},
1.1 matthew 258: permanent => 'no',
259: columns => [{ name => 'machine_id',
260: type => 'MEDIUMINT UNSIGNED',
261: restrictions => 'NOT NULL',
262: auto_inc => 'yes', },
263: { name => 'machine',
264: type => 'VARCHAR(100)',
265: restrictions => 'NOT NULL'},
266: ],
267: 'PRIMARY KEY' => ['machine_id',],
268: };
269:
270: my $activity_table_def =
1.14 matthew 271: { id => $tables{'activity'},
1.1 matthew 272: permanent => 'no',
273: columns => [
274: { name => 'res_id',
275: type => 'MEDIUMINT UNSIGNED',
276: restrictions => 'NOT NULL',},
277: { name => 'time',
278: type => 'DATETIME',
279: restrictions => 'NOT NULL',},
280: { name => 'student_id',
1.2 matthew 281: type => 'MEDIUMINT UNSIGNED',
1.1 matthew 282: restrictions => 'NOT NULL',},
1.4 matthew 283: { name => 'action',
284: type => 'VARCHAR(10)',
1.1 matthew 285: restrictions => 'NOT NULL',},
286: { name => 'idx', # This is here in case a student
287: type => 'MEDIUMINT UNSIGNED', # has multiple submissions during
288: restrictions => 'NOT NULL', # one second. It happens, trust
289: auto_inc => 'yes', }, # me.
290: { name => 'machine_id',
1.2 matthew 291: type => 'MEDIUMINT UNSIGNED',
1.1 matthew 292: restrictions => 'NOT NULL',},
293: { name => 'action_values',
294: type => 'MEDIUMTEXT', },
295: ],
1.4 matthew 296: 'PRIMARY KEY' => ['time','student_id','res_id','idx'],
297: 'KEY' => [{columns => ['student_id']},
298: {columns => ['time']},],
1.1 matthew 299: };
1.4 matthew 300:
1.8 matthew 301: my @Activity_Table = ($activity_table_def);
1.4 matthew 302: my @ID_Tables = ($student_table_def,$res_table_def,$machine_table_def);
1.14 matthew 303:
1.1 matthew 304: ##
1.13 matthew 305: ## End of table definitions
1.1 matthew 306: ##
1.14 matthew 307: $logthis->('tables = '.join(',',keys(%tables)));
1.1 matthew 308:
1.3 matthew 309: $logthis->('Connectiong to mysql');
1.8 matthew 310: &Apache::lonmysql::set_mysql_user_and_password('www',
1.1 matthew 311: $perlvar{'lonSqlAccess'});
312: if (!&Apache::lonmysql::verify_sql_connection()) {
313: warn "Unable to connect to MySQL database.";
1.2 matthew 314: $logthis->("Unable to connect to MySQL database.");
1.1 matthew 315: exit 3;
316: }
1.3 matthew 317: $logthis->('SQL connection is up');
318:
1.14 matthew 319: my $missing_table = &check_for_missing_tables(values(%tables));
320: if (-s $gz_sql_filename && ! -s $gz_xml_filename) {
1.8 matthew 321: my $backup_modification_time = (stat($gz_sql_filename))[9];
322: $logthis->($gz_sql_filename.' was last modified '.
323: localtime($backup_modification_time).
324: '('.$backup_modification_time.')');
1.14 matthew 325: if ($missing_table) {
326: # If the backup happened prior to the last table modification,
327: # we need to save the tables.
328: if (&latest_table_modification_time() > $backup_modification_time) {
329: # Save the current tables in case we need them another time.
330: $logthis->('Backing existing tables up');
331: &backup_tables_as_xml($gz_xml_filename.'.save_'.time,\%tables);
1.1 matthew 332: }
1.14 matthew 333: $time_this->();
334: &load_backup_sql_tables($gz_sql_filename);
335: &backup_tables_as_xml($gz_xml_filename,\%tables);
336: $time_this->('load backup tables');
1.1 matthew 337: }
1.14 matthew 338: } elsif (-s $gz_xml_filename) {
339: my $backup_modification_time = (stat($gz_xml_filename))[9];
340: $logthis->($gz_xml_filename.' was last modified '.
341: localtime($backup_modification_time).
342: '('.$backup_modification_time.')');
343: if ($missing_table) {
1.8 matthew 344: my $table_modification_time = $backup_modification_time;
345: # If the backup happened prior to the last table modification,
1.14 matthew 346: # we need to save the tables.
347: if (&latest_table_modification_time() > $backup_modification_time) {
1.8 matthew 348: # Save the current tables in case we need them another time.
1.14 matthew 349: $logthis->('Backing existing tables up');
350: &backup_tables_as_xml($gz_xml_filename.'.save_'.time,\%tables);
1.8 matthew 351: }
352: $time_this->();
1.14 matthew 353: # We have to make our own tables for the xml format
354: &drop_tables();
355: &create_tables();
356: &load_backup_xml_tables($gz_xml_filename,\%tables);
1.8 matthew 357: $time_this->('load backup tables');
1.14 matthew 358: }
1.1 matthew 359: }
360:
1.15 ! matthew 361: if (defined($xmlfile)) {
! 362: exit(0);
! 363: }
! 364:
1.3 matthew 365: ##
366: ## Ensure the tables we need exist
1.1 matthew 367: # create_tables does not complain if the tables already exist
1.3 matthew 368: $logthis->('creating tables');
1.1 matthew 369: if (! &create_tables()) {
370: warn "Unable to create tables";
1.2 matthew 371: $logthis->('Unable to create tables');
1.1 matthew 372: exit 4;
373: }
374:
1.3 matthew 375: ##
376: ## Read the ids used for various tables
1.2 matthew 377: $logthis->('reading id tables');
1.1 matthew 378: &read_id_tables();
1.2 matthew 379: $logthis->('finished reading id tables');
1.1 matthew 380:
381: ##
1.3 matthew 382: ## Set up the errors file
383: my $error_fh = IO::File->new(">>$error_filename");
384:
385: ##
386: ## Parse the course log
387: $logthis->('processing course log');
388: if (-s $newfilename) {
1.14 matthew 389: my $result = &process_courselog($newfilename,$error_fh,\%tables);
1.1 matthew 390: if (! defined($result)) {
391: # Something went wrong along the way...
1.2 matthew 392: $logthis->('process_courselog returned undef');
1.1 matthew 393: exit 5;
394: } elsif ($result > 0) {
395: $time_this->();
1.15 ! matthew 396: $logthis->('process_courselog returned '.$result.'.'.$/.
! 397: 'Backing up tables');
1.14 matthew 398: &backup_tables_as_xml($gz_xml_filename,\%tables);
1.1 matthew 399: $time_this->('write backup tables');
400: }
1.12 matthew 401: if ($drop_when_done) { &drop_tables(); $logthis->('dropped tables'); }
1.1 matthew 402: }
1.3 matthew 403: close($error_fh);
1.1 matthew 404:
405: ##
406: ## Clean up the filesystem
407: &Apache::lonmysql::disconnect_from_db();
1.3 matthew 408: unlink($newfilename) if (-e $newfilename && ! $nocleanup);
1.1 matthew 409:
1.3 matthew 410: ##
411: ## Print timing data
412: $logthis->('printing timing data');
1.1 matthew 413: if ($time_run) {
1.2 matthew 414: my $elapsed_time = Time::HiRes::time - $initial_time;
415: print "Overall time: ".$elapsed_time.$/;
1.1 matthew 416: print &outputtimes();
1.2 matthew 417: $logthis->("Overall time: ".$elapsed_time);
418: $logthis->(&outputtimes());
419: }
420:
421: if ($log) {
422: close LOGFILE;
1.1 matthew 423: }
424:
1.12 matthew 425: foreach my $file ($lockfilename, $error_filename,$logfile) {
1.15 ! matthew 426: if (defined($file) && -z $file) {
1.12 matthew 427: unlink($file);
428: }
429: }
430:
1.14 matthew 431: exit 0; # Everything is okay, so end here before it gets worse.
1.12 matthew 432:
1.14 matthew 433: ########################################################
434: ########################################################
435: sub table_names {
436: my ($course,$domain) = @_;
437: my $prefix = $course.'_'.$domain.'_';
438: #
439: my %tables =
440: ( student =>&Apache::lonmysql::fix_table_name($prefix.'students'),
441: res =>&Apache::lonmysql::fix_table_name($prefix.'resource'),
442: machine =>&Apache::lonmysql::fix_table_name($prefix.'machine_table'),
443: activity=>&Apache::lonmysql::fix_table_name($prefix.'activity'),
444: );
445: return %tables;
446: }
1.1 matthew 447:
448: ########################################################
449: ########################################################
450: ##
451: ## Process Course Log
452: ##
453: ########################################################
454: ########################################################
455: #
456: # Returns the number of lines in the activity.log file that were processed.
457: sub process_courselog {
1.14 matthew 458: my ($inputfile,$error_fh,$tables) = @_;
1.1 matthew 459: if (! open(IN,$inputfile)) {
460: warn "Unable to open '$inputfile' for reading";
1.2 matthew 461: $logthis->("Unable to open '$inputfile' for reading");
1.1 matthew 462: return undef;
463: }
464: my ($linecount,$insertcount);
465: my $dbh = &Apache::lonmysql::get_dbh();
466: #
1.14 matthew 467: &store_entry();
1.1 matthew 468: while (my $line=<IN>){
469: # last if ($linecount > 1000);
470: #
471: # Bulk storage variables
472: $time_this->();
473: chomp($line);
474: $linecount++;
475: # print $linecount++.$/;
476: my ($timestamp,$host,$log)=split(/\:/,$line,3);
477: #
478: # $log has the actual log entries; currently still escaped, and
479: # %26(timestamp)%3a(url)%3a(user)%3a(domain)
480: # then additionally
481: # %3aPOST%3a(name)%3d(value)%3a(name)%3d(value)
482: # or
483: # %3aCSTORE%3a(name)%3d(value)%26(name)%3d(value)
484: #
485: # get delimiter between timestamped entries to be &&&
486: $log=~s/\%26(\d{9,10})\%3a/\&\&\&$1\%3a/g;
487: $log = &unescape($log);
488: # now go over all log entries
1.2 matthew 489: if (! defined($host)) { $host = 'unknown'; }
490: my $prevchunk = 'none';
491: foreach my $chunk (split(/\&\&\&/,$log)) {
492: my $warningflag = '';
493: my ($time,$res,$uname,$udom,$action,@values)= split(/:/,$chunk);
1.1 matthew 494: if (! defined($res) || $res =~ /^\s*$/) {
495: $res = '/adm/roles';
1.2 matthew 496: $action = 'LOGIN';
1.1 matthew 497: }
498: if ($res =~ m|^/prtspool/|) {
499: $res = '/prtspool/';
500: }
501: if (! defined($action) || $action eq '') {
1.2 matthew 502: $action = 'VIEW';
1.1 matthew 503: }
1.2 matthew 504: if ($action !~ /^(LOGIN|VIEW|POST|CSTORE|STORE)$/) {
505: $warningflag .= 'action';
1.3 matthew 506: print $error_fh 'full log entry:'.$log.$/;
507: print $error_fh 'error on chunk:'.$chunk.$/;
508: $logthis->('(action) Unable to parse '.$/.$chunk.$/.
509: 'got '.
510: 'time = '.$time.$/.
511: 'res = '.$res.$/.
512: 'uname= '.$uname.$/.
513: 'udom = '.$udom.$/.
514: 'action='.$action.$/.
1.11 matthew 515: '@values = '.join('&',@values));
1.3 matthew 516: next; #skip it if we cannot understand what is happening.
1.2 matthew 517: }
518: #
1.14 matthew 519: my %data = (student => $uname.':'.$udom,
520: resource => $res,
521: machine => $host,
522: action => $action,
523: time => &Apache::lonmysql::sqltime($time));
1.11 matthew 524: if ($action eq 'POST') {
1.14 matthew 525: $data{'action_values'} =
1.11 matthew 526: $dbh->quote(join('&',map { &escape($_); } @values));
527: } else {
1.14 matthew 528: $data{'action_values'} = $dbh->quote(join('&',@values));
529: }
530: my $error = &store_entry($dbh,$tables,\%data);
531: if ($error) {
532: $logthis->('error store_entry:'.$error." on %data");
1.11 matthew 533: }
1.2 matthew 534: $prevchunk = $chunk;
1.1 matthew 535: }
536: }
1.14 matthew 537: my $result = &store_entry($dbh,$tables);
538: if (! defined($result)) {
539: my $error = &Apache::lonmysql::get_error();
540: warn "Error occured during insert.".$error;
541: $logthis->('error = '.$error);
1.1 matthew 542: }
543: close IN;
544: return $linecount;
545: }
546:
1.2 matthew 547:
548: ##
1.14 matthew 549: ## default value for $logthis and $time_this
1.2 matthew 550: sub nothing {
551: return;
552: }
553:
554: ##
1.14 matthew 555: ## Logging routine (look for $log)
1.2 matthew 556: ##
557: sub log_to_file {
558: my ($input)=@_;
559: print LOGFILE $input.$/;
560: }
561:
1.1 matthew 562: ##
563: ## Timing routines
564: ##
565: {
566: my %Timing;
567: my $starttime;
568:
569: sub time_action {
570: my ($key) = @_;
571: if (defined($key)) {
572: $Timing{$key}+=Time::HiRes::time-$starttime;
573: $Timing{'count_'.$key}++;
574: }
575: $starttime = Time::HiRes::time;
576: }
577:
578: sub outputtimes {
579: my $Str;
580: if ($time_run) {
581: $Str = "Timing Data:".$/;
582: while (my($k,$v) = each(%Timing)) {
583: next if ($k =~ /^count_/);
584: my $count = $Timing{'count_'.$k};
585: $Str .=
586: ' '.sprintf("%25.25s",$k).
587: ' '.sprintf('% 8d',$count).
588: ' '.sprintf('%12.5f',$v).$/;
589: }
590: }
591: return $Str;
592: }
593:
594: }
595:
1.14 matthew 596: sub latest_table_modification_time {
597: my $latest_time;
598: foreach my $table (@Activity_Table,@ID_Tables) {
599: my %tabledata = &Apache::lonmysql::table_information($table->{'id'});
600: next if (! scalar(keys(%tabledata))); # table does not exist
601: if (! defined($latest_time) ||
602: $latest_time < $tabledata{'Update_time'}) {
603: $latest_time = $tabledata{'Update_time'};
604: }
605: }
606: return $latest_time;
607: }
608:
609: sub check_for_missing_tables {
610: my @wanted_tables = @_;
611: # Check for missing tables
612: my @Current_Tables = &Apache::lonmysql::tables_in_db();
613: my %Found;
614: foreach my $tablename (@Current_Tables) {
615: foreach my $table (@wanted_tables) {
616: if ($tablename eq $table) {
617: $Found{$tablename}++;
618: }
619: }
620: }
621: $logthis->('Found tables '.join(',',keys(%Found)));
622: my $missing_a_table = 0;
623: foreach my $table (@wanted_tables) {
624: if (! $Found{$table}) {
625: $logthis->('Missing table '.$table);
626: $missing_a_table = 1;
627: last;
628: }
629: }
630: return $missing_a_table;
631: }
1.1 matthew 632:
633: ##
634: ## Use mysqldump to store backups of the tables
635: ##
1.14 matthew 636: sub backup_tables_as_sql {
1.6 matthew 637: my ($gz_sql_filename) = @_;
1.12 matthew 638: my $command = qq{mysqldump --quote-names --opt loncapa };
1.3 matthew 639: foreach my $table (@ID_Tables,@Activity_Table) {
1.1 matthew 640: my $tablename = $table->{'id'};
1.12 matthew 641: $tablename =~ s/\`//g;
1.1 matthew 642: $command .= $tablename.' ';
643: }
1.6 matthew 644: $command .= '| gzip >'.$gz_sql_filename;
1.2 matthew 645: $logthis->($command);
1.1 matthew 646: system($command);
647: }
648:
649: ##
650: ## Load in mysqldumped files
651: ##
1.14 matthew 652: sub load_backup_sql_tables {
1.6 matthew 653: my ($gz_sql_filename) = @_;
654: if (-s $gz_sql_filename) {
1.8 matthew 655: $logthis->('loading data from gzipped sql file');
656: my $command='gzip -dc '.$gz_sql_filename.' | mysql --database=loncapa';
1.6 matthew 657: system($command);
658: $logthis->('finished loading gzipped data');;
659: } else {
660: return undef;
661: }
1.1 matthew 662: }
663:
664: ##
665: ##
666: ##
667: sub update_process_name {
668: my ($text) = @_;
669: $0 = 'parse_activity_log.pl: '.$text;
670: }
671:
672: sub get_filename {
673: my ($course,$domain) = @_;
674: my ($a,$b,$c,undef) = split('',$course,4);
675: return "$perlvar{'lonUsersDir'}/$domain/$a/$b/$c/$course/activity.log";
676: }
677:
678: sub create_tables {
1.3 matthew 679: foreach my $table (@ID_Tables,@Activity_Table) {
1.1 matthew 680: my $table_id = &Apache::lonmysql::create_table($table);
681: if (! defined($table_id)) {
682: warn "Unable to create table ".$table->{'id'}.$/;
1.12 matthew 683: $logthis->('Unable to create table '.$table->{'id'});
684: $logthis->(join($/,&Apache::lonmysql::build_table_creation_request($table)));
1.1 matthew 685: return 0;
686: }
687: }
688: return 1;
689: }
690:
691: sub drop_tables {
1.3 matthew 692: foreach my $table (@ID_Tables,@Activity_Table) {
1.1 matthew 693: my $table_id = $table->{'id'};
694: &Apache::lonmysql::drop_table($table_id);
695: }
696: }
697:
698: #################################################################
699: #################################################################
700: ##
701: ## Database item id code
702: ##
703: #################################################################
704: #################################################################
705: { # Scoping for ID lookup code
706: my %IDs;
707:
708: sub read_id_tables {
1.3 matthew 709: foreach my $table (@ID_Tables) {
1.1 matthew 710: my @Data = &Apache::lonmysql::get_rows($table->{'id'});
1.3 matthew 711: my $count = 0;
1.1 matthew 712: foreach my $row (@Data) {
713: $IDs{$table->{'id'}}->{$row->[1]} = $row->[0];
714: }
715: }
1.3 matthew 716: return;
1.1 matthew 717: }
718:
719: sub get_id {
720: my ($table,$fieldname,$value) = @_;
721: if (exists($IDs{$table}->{$value})) {
722: return $IDs{$table}->{$value};
723: } else {
724: # insert into the table - if the item already exists, that is
725: # okay.
726: my $result = &Apache::lonmysql::store_row($table,[undef,$value]);
727: if (! defined($result)) {
728: warn("Got error on id insert for $value\n".&Apache::lonmysql::get_error());
729: }
730: # get the id
731: my @Data =
732: &Apache::lonmysql::get_rows($table,qq{$fieldname='$value'});
733: if (@Data) {
734: $IDs{$table}->{$value}=$Data[0]->[0];
735: return $IDs{$table}->{$value};
736: } else {
1.2 matthew 737: $logthis->("Unable to retrieve id for $table $fieldname $value");
1.1 matthew 738: return undef;
739: }
740: }
741: }
742:
743: } # End of ID scoping
744:
1.14 matthew 745: ###############################################################
746: ###############################################################
747: ##
748: ## Save as XML
749: ##
750: ###############################################################
751: ###############################################################
752: sub backup_tables_as_xml {
753: my ($filename,$tables) = @_;
754: open(XMLFILE,"|gzip - > $filename") || return ('error:unable to write '.$filename);
755: my $query = qq{
756: SELECT B.resource,
757: A.time,
758: A.idx,
759: C.student,
760: A.action,
761: E.machine,
762: A.action_values
763: FROM $tables->{'activity'} AS A
764: LEFT JOIN $tables->{'res'} AS B ON B.res_id=A.res_id
765: LEFT JOIN $tables->{'student'} AS C ON C.student_id=A.student_id
766: LEFT JOIN $tables->{'machine'} AS E ON E.machine_id=A.machine_id
767: ORDER BY A.time DESC
768: };
769: $query =~ s/\s+/ /g;
770: my $dbh = &Apache::lonmysql::get_dbh();
771: my $sth = $dbh->prepare($query);
772: if (! $sth->execute()) {
773: $logthis->('<font color="blue">'.
774: 'WARNING: Could not retrieve from database:'.
775: $sth->errstr().'</font>');
776: return undef;
777: } else {
778: my ($res,$sqltime,$idx,$student,$action,$machine,$action_values);
779: if ($sth->bind_columns(\$res,\$sqltime,\$idx,\$student,\$action,
780: \$machine,\$action_values)) {
781:
782: while ($sth->fetch) {
783: print XMLFILE '<row>'.
784: qq{<resource>$res</resource>}.
785: qq{<time>$sqltime</time>}.
786: qq{<idx>$idx</idx>}.
787: qq{<student>$student</student>}.
788: qq{<action>$action</action>}.
789: qq{<machine>$machine</machine>}.
790: qq{<action_values>$action_values</action_values>}.
791: '</row>'.$/;
792: }
793: } else {
794: warn "Unable to bind to columns.\n";
795: return undef;
796: }
797: }
798: close XMLFILE;
799: return;
800: }
801:
802: ###############################################################
803: ###############################################################
804: ##
805: ## load as xml
806: ##
807: ###############################################################
808: ###############################################################
1.15 ! matthew 809: {
! 810: my @fields = ('resource','time',
! 811: 'student','action','idx','machine','action_values');
! 812: my %ids = ();
1.14 matthew 813: sub load_backup_xml_tables {
814: my ($filename,$tables) = @_;
815: my $xmlfh;
816: open($xmlfh,"cat $filename | gzip -d - |");
817: if (! defined($xmlfh)) {
818: return ('error:unable to read '.$filename);
819: }
1.15 ! matthew 820: #
! 821: %ids = (resource=> {"\0count"=>1},
! 822: student=> {"\0count"=>1},
! 823: machine=> {"\0count"=>1});
! 824: #
1.14 matthew 825: my %data;
1.15 ! matthew 826: while (my $inputline = <$xmlfh>) {
! 827: my ($resource,$time,undef,$student,$action,$machine,$action_values) =
! 828: ($inputline =~ m{<row>
! 829: <resource>(.*)</resource>
! 830: <time>(.*)</time>
! 831: <idx>(.*)</idx>
! 832: <student>(.*)</student>
! 833: <action>(.*)</action>
! 834: <machine>(.*)</machine>
! 835: <action_values>(.*)</action_values>
! 836: </row>$
! 837: }x
! 838: );
! 839: my $resource_id = &xml_get_id('resource',$resource);
! 840: my $student_id = &xml_get_id('student',$student);
! 841: my $machine_id = &xml_get_id('machine',$machine);
! 842: &xml_store_activity_row(map { defined($_)?qq{'$_'}:''
! 843: } ($resource_id,
! 844: $time,
! 845: $student_id,
! 846: $action,
! 847: 'NULL',
! 848: $machine_id,
! 849: $action_values));
! 850: }
! 851: &xml_store_activity_row();
! 852: close($xmlfh);
! 853: # Store id tables
! 854: while (my ($id_name,$id_data) = each(%ids)) {
! 855: if ($id_name eq 'resource') { $id_name = 'res'; }
! 856: delete($id_data->{"\0count"});
! 857: &xml_store_id_table($id_name,$id_data);
! 858: }
! 859: return;
! 860: }
! 861:
! 862: sub xml_get_id {
! 863: my ($table,$element) = @_;
! 864: if (! exists($ids{$table}->{$element})) {
! 865: $ids{$table}->{$element} = $ids{$table}->{"\0count"}++;
! 866: }
! 867: return $ids{$table}->{$element};
! 868: }
! 869:
! 870: {
! 871: my @data_rows;
! 872: sub xml_store_activity_row {
! 873: my @data = @_;
! 874: if (scalar(@data)) {
! 875: push(@data_rows,[@data]);
! 876: }
! 877: if (! scalar(@data) || scalar(@data_rows) > 500) {
! 878: if (! &Apache::lonmysql::bulk_store_rows($tables{'activity'},
! 879: scalar(@{$data_rows[0]}),
! 880: \@data_rows)) {
! 881: $logthis->("Error:".&Apache::lonmysql::get_error());
! 882: warn("Error:".&Apache::lonmysql::get_error());
! 883: } else {
! 884: undef(@data_rows);
1.14 matthew 885: }
886: }
887: return;
888: }
889:
1.15 ! matthew 890: }
! 891:
! 892: sub xml_store_id_table {
! 893: my ($table,$tabledata) =@_;
! 894: if (! &Apache::lonmysql::bulk_store_rows
! 895: ($tables{$table},2,
! 896: [map{[$tabledata->{$_},qq{"$_"}]} keys(%$tabledata)])) {
! 897: $logthis->("Error:".&Apache::lonmysql::get_error());
! 898: warn "Error:".&Apache::lonmysql::get_error().$/;
! 899: }
! 900: }
! 901:
! 902: } # End of load xml scoping
1.14 matthew 903:
904: #######################################################################
905: #######################################################################
906: ##
907: ## store_entry - accumulate data to be inserted into the database
1.15 ! matthew 908: ##
1.14 matthew 909: ## Pass no values in to clear accumulator
910: ## Pass ($dbh,\%tables) to initiate storage of values
911: ## Pass ($dbh,\%tables,\%data) to use normally
912: ##
913: #######################################################################
914: #######################################################################
915: {
916: my @rows;
917: my $max_row_count = 100;
918:
919: sub store_entry {
920: if (! @_) {
921: undef(@rows);
922: return '';
923: }
924: my ($dbh,$tables,$data) = @_;
925: return if (! defined($tables));
926: if (defined($data)) {
927: my $error;
928: foreach my $field ('student','resource','action','time') {
929: if (! defined($data->{$field}) || $data->{$field} eq ':' ||
930: $data->{$field}=~ /^\s*$/) {
931: $error.=$field.',';
932: }
933: }
934: if ($error) { $error=~s/,$//; return $error; }
935: #
936: my $student_id = &get_id($tables->{'student'},'student',
937: $data->{'student'});
938: my $res_id = &get_id($tables->{'res'},
939: 'resource',$data->{'resource'});
940: my $machine_id = &get_id($tables->{'machine'},
941: 'machine',$data->{'machine'});
942: my $idx = $data->{'idx'}; if (! $idx) { $idx = "''"; }
943: #
944: push(@rows,[$res_id,
945: qq{'$data->{'time'}'},
946: $student_id,
947: qq{'$data->{'action'}'},
948: $idx,
949: $machine_id,
950: $data->{'action_values'}]);
951: }
1.15 ! matthew 952: if (defined($tables) &&
1.14 matthew 953: ( (! defined($data) && scalar(@rows)) || scalar(@rows)>$max_row_count)
954: ){
955: # Store the rows
1.15 ! matthew 956: my $result =
1.14 matthew 957: &Apache::lonmysql::bulk_store_rows($tables->{'activity'},
958: undef,
959: \@rows);
960: if (! defined($result)) {
961: my $error = &Apache::lonmysql::get_error();
962: warn "Error occured during insert.".$error;
963: return $error;
964: }
965: undef(@rows);
966: return $result if (! defined($data));
967: }
968: return '';
969: }
970:
971: } # end of scope for &store_entry
1.1 matthew 972:
973: ###############################################################
974: ###############################################################
975: ##
976: ## The usual suspects
977: ##
978: ###############################################################
979: ###############################################################
980: sub escape {
981: my $str=shift;
982: $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
983: return $str;
984: }
985:
986: sub unescape {
987: my $str=shift;
988: $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
989: return $str;
990: }
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