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