File:
[LON-CAPA] /
loncom /
metadata_database /
parse_activity_log.pl
Revision
1.24:
download - view:
text,
annotated -
select for diffs
Sat Apr 8 07:10:10 2006 UTC (18 years, 5 months ago) by
albertel
Branches:
MAIN
CVS tags:
version_2_9_X,
version_2_9_99_0,
version_2_9_1,
version_2_9_0,
version_2_8_X,
version_2_8_99_1,
version_2_8_99_0,
version_2_8_2,
version_2_8_1,
version_2_8_0,
version_2_7_X,
version_2_7_99_1,
version_2_7_99_0,
version_2_7_1,
version_2_7_0,
version_2_6_X,
version_2_6_99_1,
version_2_6_99_0,
version_2_6_3,
version_2_6_2,
version_2_6_1,
version_2_6_0,
version_2_5_X,
version_2_5_99_1,
version_2_5_99_0,
version_2_5_2,
version_2_5_1,
version_2_5_0,
version_2_4_X,
version_2_4_99_0,
version_2_4_2,
version_2_4_1,
version_2_4_0,
version_2_3_X,
version_2_3_99_0,
version_2_3_2,
version_2_3_1,
version_2_3_0,
version_2_2_X,
version_2_2_99_1,
version_2_2_99_0,
version_2_2_2,
version_2_2_1,
version_2_2_0,
version_2_1_99_3,
version_2_1_99_2,
version_2_1_99_1,
version_2_1_99_0,
version_2_11_0_RC3,
version_2_11_0_RC2,
version_2_11_0_RC1,
version_2_11_0,
version_2_10_X,
version_2_10_1,
version_2_10_0_RC2,
version_2_10_0_RC1,
version_2_10_0,
loncapaMITrelate_1,
language_hyphenation_merge,
language_hyphenation,
bz6209-base,
bz6209,
bz5969,
bz2851,
PRINT_INCOMPLETE_base,
PRINT_INCOMPLETE,
HEAD,
GCI_3,
GCI_2,
GCI_1,
BZ5971-printing-apage,
BZ5434-fox,
BZ4492-merge,
BZ4492-feature_horizontal_radioresponse
-removing non-functional use Apache2::compat
- removing extraneous uses
1: #!/usr/bin/perl
2: #
3: # The LearningOnline Network
4: #
5: # $Id: parse_activity_log.pl,v 1.24 2006/04/08 07:10:10 albertel Exp $
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: #
29: #--------------------------------------------------------------------
30: #
31: # Exit codes
32: # 0 Everything is okay
33: # 1 Another copy is running on this course
34: # 2 Activity log does not exist
35: # 3 Unable to connect to database
36: # 4 Unable to create database tables
37: # 5 Unable to open log file
38: # 6 Unable to get lock on activity log
39: #
40:
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: use strict;
52: use DBI;
53: use lib '/home/httpd/lib/perl/';
54: use LONCAPA::Configuration();
55: use Apache::lonmysql();
56: use Time::HiRes();
57: use Getopt::Long();
58: use IO::File;
59: use File::Copy;
60: use Fcntl qw(:flock);
61: use HTML::TokeParser;
62:
63: #
64: # Determine parameters
65: my ($help,$course,$domain,$drop_when_done,$srcfile,$logfile,$time_run,$nocleanup,$log,$backup,$xmlfile);
66: &Getopt::Long::GetOptions( "course=s" => \$course,
67: "domain=s" => \$domain,
68: "backup" => \$backup,
69: "help" => \$help,
70: "logfile=s" => \$logfile,
71: "srcfile=s" => \$srcfile,
72: "justloadxml=s" => \$xmlfile,
73: "timerun" => \$time_run,
74: "nocleanup" => \$nocleanup,
75: "dropwhendone" => \$drop_when_done,
76: "log" => \$log);
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
85: backup optional if present, backup the activity log file
86: before processing it
87: dropwhendone optional if present, drop all course
88: specific activity log tables after processing.
89: srcfile 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
92: log optional if present, prepare log file of activity
93: logfile optional specifies the logfile to use
94: Examples:
95: $0 -course=123456abcdef -domain=msu
96: $0 -course=123456abcdef -srcfile=activity.log
97: $0 -course-123456abcdef -log -logfile=/tmp/logfile -dropwhendone
98: USAGE
99: exit;
100: }
101:
102: ##
103: ## Set up timing code
104: my $time_this = \¬hing;
105: if ($time_run) {
106: $time_this = \&time_action;
107: }
108: my $initial_time = Time::HiRes::time;
109:
110: ##
111: ## Read in configuration parameters
112: ##
113: my %perlvar = %{&LONCAPA::Configuration::read_conf('loncapa.conf')};
114:
115: if (! defined($domain) || $domain eq '') {
116: $domain = $perlvar{'lonDefDomain'};
117: }
118: &update_process_name($course.'@'.$domain);
119:
120: ##
121: ## Set up logging code
122: my $logthis = \¬hing;
123:
124: if ($log) {
125: if (! $logfile) {
126: $logfile = $perlvar{'lonDaemons'}.'/tmp/parse_activity_log.log.'.time;
127: }
128: print STDERR "$0: logging to $logfile".$/;
129: if (! open(LOGFILE,">$logfile")) {
130: warn("Unable to open $logfile for writing. Run aborted.");
131: &clean_up_and_exit(5);
132: } else {
133: $logthis = \&log_to_file;
134: }
135: }
136:
137:
138: ##
139: ## Determine filenames
140: ##
141: my $sourcefilename; # activity log data
142: my $newfilename; # $sourcefilename will be renamed to this
143: my $error_filename; # Errors in parsing the activity log will be written here
144: my $chunk_filename; # where we save data we are not going to write to db
145: if ($srcfile) {
146: $sourcefilename = $srcfile;
147: } else {
148: $sourcefilename = &get_filename($course,$domain);
149: }
150: my $sql_filename = $sourcefilename;
151: $sql_filename =~ s|[^/]*$|activity.log.sql|;
152: my $gz_sql_filename = $sql_filename.'.gz';
153: #
154: $chunk_filename = $sourcefilename.".unprocessed_chunks";
155: #
156: my $xml_filename = $sourcefilename;
157: my $gz_xml_filename = $xml_filename.'.gz';
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: }
170: #
171: $error_filename = $sourcefilename;
172: $error_filename =~ s|[^/]*$|activity.log.errors|;
173: $logthis->('Beginning logging '.time);
174:
175: #
176: # Wait for a lock on the lockfile to avoid collisions
177: my $lockfilename = $sourcefilename.'.lock';
178: $newfilename = $sourcefilename.'.processing';
179: if (! defined($xmlfile)) {
180: open(LOCKFILE,'>'.$lockfilename);
181: if (!flock(LOCKFILE,LOCK_EX|LOCK_NB)) {
182: warn("Unable to lock $lockfilename. Aborting".$/);
183: # don't call clean_up_and_exit another instance is running and
184: # we don't want to 'cleanup' their files
185: exit 6;
186: }
187:
188: if (! -e $newfilename && -e $sourcefilename) {
189: $logthis->('renaming '.$sourcefilename.' to '.$newfilename);
190: rename($sourcefilename,$newfilename);
191: Copy($newfilename,$newfilename.'.'.time) if ($backup);
192: $logthis->("renamed $sourcefilename to $newfilename");
193: } elsif (! -e $newfilename) {
194: utime(undef,undef,$newfilename);
195: }
196: }
197:
198: ##
199: ## Table definitions
200: ##
201: my %tables = &table_names($course,$domain);
202: my $student_table_def =
203: { id => $tables{'student'},
204: permanent => 'no',
205: columns => [
206: { name => 'student_id',
207: type => 'MEDIUMINT UNSIGNED',
208: restrictions => 'NOT NULL',
209: auto_inc => 'yes', },
210: { name => 'student',
211: type => 'VARCHAR(100) BINARY',
212: restrictions => 'NOT NULL', },
213: ],
214: 'PRIMARY KEY' => ['student_id',],
215: };
216:
217: my $res_table_def =
218: { id => $tables{'res'},
219: permanent => 'no',
220: columns => [{ name => 'res_id',
221: type => 'MEDIUMINT UNSIGNED',
222: restrictions => 'NOT NULL',
223: auto_inc => 'yes', },
224: { name => 'resource',
225: type => 'MEDIUMTEXT',
226: restrictions => 'NOT NULL'},
227: ],
228: 'PRIMARY KEY' => ['res_id'],
229: };
230:
231: #my $action_table_def =
232: #{ id => $action_table,
233: # permanent => 'no',
234: # columns => [{ name => 'action_id',
235: # type => 'MEDIUMINT UNSIGNED',
236: # restrictions => 'NOT NULL',
237: # auto_inc => 'yes', },
238: # { name => 'action',
239: # type => 'VARCHAR(100)',
240: # restrictions => 'NOT NULL'},
241: # ],
242: # 'PRIMARY KEY' => ['action_id',],
243: #};
244:
245: my $machine_table_def =
246: { id => $tables{'machine'},
247: permanent => 'no',
248: columns => [{ name => 'machine_id',
249: type => 'MEDIUMINT UNSIGNED',
250: restrictions => 'NOT NULL',
251: auto_inc => 'yes', },
252: { name => 'machine',
253: type => 'VARCHAR(100)',
254: restrictions => 'NOT NULL'},
255: ],
256: 'PRIMARY KEY' => ['machine_id',],
257: };
258:
259: my $activity_table_def =
260: { id => $tables{'activity'},
261: permanent => 'no',
262: columns => [
263: { name => 'res_id',
264: type => 'MEDIUMINT UNSIGNED',
265: restrictions => 'NOT NULL',},
266: { name => 'time',
267: type => 'DATETIME',
268: restrictions => 'NOT NULL',},
269: { name => 'student_id',
270: type => 'MEDIUMINT UNSIGNED',
271: restrictions => 'NOT NULL',},
272: { name => 'action',
273: type => 'VARCHAR(10)',
274: restrictions => 'NOT NULL',},
275: { name => 'idx', # This is here in case a student
276: type => 'MEDIUMINT UNSIGNED', # has multiple submissions during
277: restrictions => 'NOT NULL', # one second. It happens, trust
278: auto_inc => 'yes', }, # me.
279: { name => 'machine_id',
280: type => 'MEDIUMINT UNSIGNED',
281: restrictions => 'NOT NULL',},
282: { name => 'action_values',
283: type => 'MEDIUMTEXT', },
284: ],
285: 'PRIMARY KEY' => ['time','student_id','res_id','idx'],
286: 'KEY' => [{columns => ['student_id']},
287: {columns => ['time']},],
288: };
289:
290: my @Activity_Table = ($activity_table_def);
291: my @ID_Tables = ($student_table_def,$res_table_def,$machine_table_def);
292:
293: ##
294: ## End of table definitions
295: ##
296: $logthis->('tables = '.join(',',keys(%tables)));
297:
298: $logthis->('Connectiong to mysql');
299: &Apache::lonmysql::set_mysql_user_and_password('www',
300: $perlvar{'lonSqlAccess'});
301: if (!&Apache::lonmysql::verify_sql_connection()) {
302: warn "Unable to connect to MySQL database.";
303: $logthis->("Unable to connect to MySQL database.");
304: &clean_up_and_exit(3);
305: }
306: $logthis->('SQL connection is up');
307:
308: &update_process_name($course.'@'.$domain." loading existing data");
309: my $missing_table = &check_for_missing_tables(values(%tables));
310: if (-s $gz_sql_filename && ! -s $gz_xml_filename) {
311: my $backup_modification_time = (stat($gz_sql_filename))[9];
312: $logthis->($gz_sql_filename.' was last modified '.
313: localtime($backup_modification_time).
314: '('.$backup_modification_time.')');
315: if ($missing_table) {
316: # If the backup happened prior to the last table modification,
317: # we need to save the tables.
318: if (&latest_table_modification_time() > $backup_modification_time) {
319: # Save the current tables in case we need them another time.
320: $logthis->('Backing existing tables up');
321: &backup_tables_as_xml($gz_xml_filename.'.save_'.time,\%tables);
322: }
323: $time_this->();
324: &load_backup_sql_tables($gz_sql_filename);
325: &backup_tables_as_xml($gz_xml_filename,\%tables);
326: $time_this->('load backup tables');
327: }
328: } elsif (-s $gz_xml_filename) {
329: my $backup_modification_time = (stat($gz_xml_filename))[9];
330: $logthis->($gz_xml_filename.' was last modified '.
331: localtime($backup_modification_time).
332: '('.$backup_modification_time.')');
333: if ($missing_table) {
334: my $table_modification_time = $backup_modification_time;
335: # If the backup happened prior to the last table modification,
336: # we need to save the tables.
337: if (&latest_table_modification_time() > $backup_modification_time) {
338: # Save the current tables in case we need them another time.
339: $logthis->('Backing existing tables up');
340: &backup_tables_as_xml($gz_xml_filename.'.save_'.time,\%tables);
341: }
342: $time_this->();
343: # We have to make our own tables for the xml format
344: &drop_tables();
345: &create_tables();
346: &load_backup_xml_tables($gz_xml_filename,\%tables);
347: $time_this->('load backup tables');
348: }
349: }
350:
351: if (defined($xmlfile)) {
352: &clean_up_and_exit(0);
353: }
354:
355: ##
356: ## Ensure the tables we need exist
357: # create_tables does not complain if the tables already exist
358: $logthis->('creating tables');
359: if (! &create_tables()) {
360: warn "Unable to create tables";
361: $logthis->('Unable to create tables');
362: &clean_up_and_exit(4);
363: }
364:
365: ##
366: ## Read the ids used for various tables
367: $logthis->('reading id tables');
368: &read_id_tables();
369: $logthis->('finished reading id tables');
370:
371: ##
372: ## Set up the errors file
373: my $error_fh = IO::File->new(">>$error_filename");
374:
375: ##
376: ## Parse the course log
377: $logthis->('processing course log');
378: &update_process_name($course.'@'.$domain." processing new data");
379: if (-s $newfilename) {
380: my $result = &process_courselog($newfilename,$error_fh,\%tables);
381: &update_process_name($course.'@'.$domain." backing up new data");
382: if (! defined($result)) {
383: # Something went wrong along the way...
384: $logthis->('process_courselog returned undef');
385: &clean_up_and_exit(5);
386: } elsif ($result > 0) {
387: $time_this->();
388: $logthis->('process_courselog returned '.$result.'.'.$/.
389: 'Backing up tables');
390: &backup_tables_as_xml($gz_xml_filename,\%tables);
391: $time_this->('write backup tables');
392: }
393: if ($drop_when_done) { &drop_tables(); $logthis->('dropped tables'); }
394: }
395: close($error_fh);
396:
397: ##
398: ## Clean up the filesystem
399: &Apache::lonmysql::disconnect_from_db();
400: unlink($newfilename) if (-e $newfilename && ! $nocleanup);
401:
402: ##
403: ## Print timing data
404: $logthis->('printing timing data');
405: if ($time_run) {
406: my $elapsed_time = Time::HiRes::time - $initial_time;
407: print "Overall time: ".$elapsed_time.$/;
408: print &outputtimes();
409: $logthis->("Overall time: ".$elapsed_time);
410: $logthis->(&outputtimes());
411: }
412:
413: &clean_up_and_exit(0);
414:
415: ########################################################
416: ########################################################
417:
418: sub clean_up_and_exit {
419: my ($exit_code) = @_;
420: # Close files
421: close(LOCKFILE);
422: close(LOGFILE);
423: # Remove zero length files
424: foreach my $file ($lockfilename, $error_filename,$logfile) {
425: if (defined($file) && -z $file) {
426: unlink($file);
427: }
428: }
429:
430: exit $exit_code;
431: }
432:
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: }
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 {
458: my ($inputfile,$error_fh,$tables) = @_;
459: if (! open(IN,$inputfile)) {
460: warn "Unable to open '$inputfile' for reading";
461: $logthis->("Unable to open '$inputfile' for reading");
462: return undef;
463: }
464: my ($linecount,$insertcount);
465: my $dbh = &Apache::lonmysql::get_dbh();
466: #
467: &store_entry();
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
489: if (! defined($host)) { $host = 'unknown'; }
490: my $prevchunk = 'none';
491: foreach my $chunk (split(/\&\&\&/,$log)) {
492: if (length($chunk) > 20000) {
493: # avoid putting too much data into the database
494: # (usually an uploaded file or something similar)
495: if (! &savechunk(\$chunk,$timestamp,$host)) {
496: close(IN);
497: return undef;
498: }
499: next;
500: }
501: my $warningflag = '';
502: my ($time,$res,$uname,$udom,$action,@values)= split(/:/,$chunk);
503: #
504: if (! defined($res) || $res =~ /^\s*$/) {
505: $res = '/adm/roles';
506: $action = 'LOGIN';
507: }
508: if ($res =~ m|^/prtspool/|) {
509: $res = '/prtspool/';
510: }
511: if (! defined($action) || $action eq '') {
512: $action = 'VIEW';
513: }
514: if ($action !~ /^(LOGIN|VIEW|POST|CSTORE|STORE)$/) {
515: $warningflag .= 'action';
516: print $error_fh 'full log entry:'.$log.$/;
517: print $error_fh 'error on chunk (saving)'.$/;
518: if (! &savechunk(\$chunk,$timestamp,$host)) {
519: close(IN);
520: return undef;
521: }
522: $logthis->('(action) Unable to parse chunk'.$/.
523: 'got '.
524: 'time = '.$time.$/.
525: 'res = '.$res.$/.
526: 'uname= '.$uname.$/.
527: 'udom = '.$udom.$/.
528: 'action='.$action.$/.
529: '@values = '.join('&',@values));
530: next; #skip it if we cannot understand what is happening.
531: }
532: #
533: my %data = (student => $uname.':'.$udom,
534: resource => $res,
535: machine => $host,
536: action => $action,
537: time => &Apache::lonmysql::sqltime($time));
538: if ($action eq 'POST') {
539: $data{'action_values'} =
540: $dbh->quote(join('&',map { &escape($_); } @values));
541: } else {
542: $data{'action_values'} = $dbh->quote(join('&',@values));
543: }
544: my $error = &store_entry($dbh,$tables,\%data);
545: if ($error) {
546: $logthis->('error store_entry:'.$error." on %data");
547: }
548: $prevchunk = $chunk;
549: }
550: }
551: my $result = &store_entry($dbh,$tables);
552: if (! defined($result)) {
553: my $error = &Apache::lonmysql::get_error();
554: warn "Error occured during insert.".$error;
555: $logthis->('error = '.$error);
556: }
557: close IN;
558: return $linecount;
559: ##
560: ##
561: sub savechunk {
562: my ($chunkref,$timestamp,$host) = @_;
563: my $chunk = &escape(${$chunkref});
564: if (! open(CHUNKFILE,">>$chunk_filename") ||
565: ! print CHUNKFILE $timestamp.':'.$host.':'.$chunk.$/) {
566: # abort
567: close(CHUNKFILE);
568: return 0;
569: }
570: close(CHUNKFILE);
571: return 1;
572: }
573: }
574:
575:
576: ##
577: ## default value for $logthis and $time_this
578: sub nothing {
579: return;
580: }
581:
582: ##
583: ## Logging routine (look for $log)
584: ##
585: sub log_to_file {
586: my ($input)=@_;
587: print LOGFILE $input.$/;
588: }
589:
590: ##
591: ## Timing routines
592: ##
593: {
594: my %Timing;
595: my $starttime;
596:
597: sub time_action {
598: my ($key) = @_;
599: if (defined($key)) {
600: $Timing{$key}+=Time::HiRes::time-$starttime;
601: $Timing{'count_'.$key}++;
602: }
603: $starttime = Time::HiRes::time;
604: }
605:
606: sub outputtimes {
607: my $Str;
608: if ($time_run) {
609: $Str = "Timing Data:".$/;
610: while (my($k,$v) = each(%Timing)) {
611: next if ($k =~ /^count_/);
612: my $count = $Timing{'count_'.$k};
613: $Str .=
614: ' '.sprintf("%25.25s",$k).
615: ' '.sprintf('% 8d',$count).
616: ' '.sprintf('%12.5f',$v).$/;
617: }
618: }
619: return $Str;
620: }
621:
622: }
623:
624: sub latest_table_modification_time {
625: my $latest_time;
626: foreach my $table (@Activity_Table,@ID_Tables) {
627: my %tabledata = &Apache::lonmysql::table_information($table->{'id'});
628: next if (! scalar(keys(%tabledata))); # table does not exist
629: if (! defined($latest_time) ||
630: $latest_time < $tabledata{'Update_time'}) {
631: $latest_time = $tabledata{'Update_time'};
632: }
633: }
634: return $latest_time;
635: }
636:
637: sub check_for_missing_tables {
638: my @wanted_tables = @_;
639: # Check for missing tables
640: my @Current_Tables = &Apache::lonmysql::tables_in_db();
641: my %Found;
642: foreach my $tablename (@Current_Tables) {
643: foreach my $table (@wanted_tables) {
644: if ($tablename eq $table) {
645: $Found{$tablename}++;
646: }
647: }
648: }
649: $logthis->('Found tables '.join(',',keys(%Found)));
650: my $missing_a_table = 0;
651: foreach my $table (@wanted_tables) {
652: if (! $Found{$table}) {
653: $logthis->('Missing table '.$table);
654: $missing_a_table = 1;
655: last;
656: }
657: }
658: return $missing_a_table;
659: }
660:
661: ##
662: ## Use mysqldump to store backups of the tables
663: ##
664: sub backup_tables_as_sql {
665: my ($gz_sql_filename) = @_;
666: my $command = qq{mysqldump --quote-names --opt loncapa };
667: foreach my $table (@ID_Tables,@Activity_Table) {
668: my $tablename = $table->{'id'};
669: $tablename =~ s/\`//g;
670: $command .= $tablename.' ';
671: }
672: $command .= '| gzip >'.$gz_sql_filename;
673: $logthis->($command);
674: system($command);
675: }
676:
677: ##
678: ## Load in mysqldumped files
679: ##
680: sub load_backup_sql_tables {
681: my ($gz_sql_filename) = @_;
682: if (-s $gz_sql_filename) {
683: $logthis->('loading data from gzipped sql file');
684: my $command='gzip -dc '.$gz_sql_filename.' | mysql --database=loncapa';
685: system($command);
686: $logthis->('finished loading gzipped data');;
687: } else {
688: return undef;
689: }
690: }
691:
692: ##
693: ##
694: ##
695: sub update_process_name {
696: my ($text) = @_;
697: $0 = 'parse_activity_log.pl: '.$text;
698: }
699:
700: sub get_filename {
701: my ($course,$domain) = @_;
702: my ($a,$b,$c,undef) = split('',$course,4);
703: return "$perlvar{'lonUsersDir'}/$domain/$a/$b/$c/$course/activity.log";
704: }
705:
706: sub create_tables {
707: foreach my $table (@ID_Tables,@Activity_Table) {
708: my $table_id = &Apache::lonmysql::create_table($table);
709: if (! defined($table_id)) {
710: warn "Unable to create table ".$table->{'id'}.$/;
711: $logthis->('Unable to create table '.$table->{'id'});
712: $logthis->(join($/,&Apache::lonmysql::build_table_creation_request($table)));
713: return 0;
714: }
715: }
716: return 1;
717: }
718:
719: sub drop_tables {
720: foreach my $table (@ID_Tables,@Activity_Table) {
721: my $table_id = $table->{'id'};
722: &Apache::lonmysql::drop_table($table_id);
723: }
724: }
725:
726: #################################################################
727: #################################################################
728: ##
729: ## Database item id code
730: ##
731: #################################################################
732: #################################################################
733: { # Scoping for ID lookup code
734: my %IDs;
735:
736: sub read_id_tables {
737: foreach my $table (@ID_Tables) {
738: my @Data = &Apache::lonmysql::get_rows($table->{'id'});
739: my $count = 0;
740: foreach my $row (@Data) {
741: $IDs{$table->{'id'}}->{$row->[1]} = $row->[0];
742: }
743: }
744: return;
745: }
746:
747: sub get_id {
748: my ($table,$fieldname,$value) = @_;
749: if (exists($IDs{$table}->{$value}) && $IDs{$table}->{$value} =~ /^\d+$/) {
750: return $IDs{$table}->{$value};
751: } else {
752: # insert into the table - if the item already exists, that is
753: # okay.
754: my $result = &Apache::lonmysql::store_row($table,[undef,$value]);
755: if (! defined($result)) {
756: warn("Got error on id insert for $value\n".
757: &Apache::lonmysql::get_error());
758: }
759: # get the id
760: my $id = &Apache::lonmysql::get_dbh()->{'mysql_insertid'};
761: if (defined($id)) {
762: $IDs{$table}->{$value}=$id;
763: } else {
764: $logthis->("Unable to retrieve id for $table $fieldname $value");
765: return undef;
766: }
767: }
768: }
769:
770: } # End of ID scoping
771:
772: ###############################################################
773: ###############################################################
774: ##
775: ## Save as XML
776: ##
777: ###############################################################
778: ###############################################################
779: sub backup_tables_as_xml {
780: my ($filename,$tables) = @_;
781: open(XMLFILE,"|gzip - > $filename") || return ('error:unable to write '.$filename);
782: my $query = qq{
783: SELECT B.resource,
784: A.time,
785: A.idx,
786: C.student,
787: A.action,
788: E.machine,
789: A.action_values
790: FROM $tables->{'activity'} AS A
791: LEFT JOIN $tables->{'res'} AS B ON B.res_id=A.res_id
792: LEFT JOIN $tables->{'student'} AS C ON C.student_id=A.student_id
793: LEFT JOIN $tables->{'machine'} AS E ON E.machine_id=A.machine_id
794: ORDER BY A.time DESC
795: };
796: $query =~ s/\s+/ /g;
797: my $dbh = &Apache::lonmysql::get_dbh();
798: my $sth = $dbh->prepare($query);
799: if (! $sth->execute()) {
800: $logthis->('<font color="blue">'.
801: 'WARNING: Could not retrieve from database:'.
802: $sth->errstr().'</font>');
803: return undef;
804: } else {
805: my ($res,$sqltime,$idx,$student,$action,$machine,$action_values);
806: if ($sth->bind_columns(\$res,\$sqltime,\$idx,\$student,\$action,
807: \$machine,\$action_values)) {
808:
809: while ($sth->fetch) {
810: print XMLFILE '<row>'.
811: qq{<resource>$res</resource>}.
812: qq{<time>$sqltime</time>}.
813: qq{<idx>$idx</idx>}.
814: qq{<student>$student</student>}.
815: qq{<action>$action</action>}.
816: qq{<machine>$machine</machine>}.
817: qq{<action_values>$action_values</action_values>}.
818: '</row>'.$/;
819: }
820: } else {
821: warn "Unable to bind to columns.\n";
822: return undef;
823: }
824: }
825: close XMLFILE;
826: return;
827: }
828:
829: ###############################################################
830: ###############################################################
831: ##
832: ## load as xml
833: ##
834: ###############################################################
835: ###############################################################
836: {
837: my @fields = ('resource','time',
838: 'student','action','idx','machine','action_values');
839: my %ids = ();
840: sub load_backup_xml_tables {
841: my ($filename,$tables) = @_;
842: my $dbh = &Apache::lonmysql::get_dbh();
843: my $xmlfh;
844: open($xmlfh,"cat $filename | gzip -d - |");
845: if (! defined($xmlfh)) {
846: return ('error:unable to read '.$filename);
847: }
848: #
849: %ids = (resource=> {"\0count"=>1},
850: student=> {"\0count"=>1},
851: machine=> {"\0count"=>1});
852: #
853: my %data;
854: while (my $inputline = <$xmlfh>) {
855: my ($resource,$time,undef,$student,$action,$machine,$action_values) =
856: ($inputline =~ m{<row>
857: <resource>(.*)</resource>
858: <time>(.*)</time>
859: <idx>(.*)</idx>
860: <student>(.*)</student>
861: <action>(.*)</action>
862: <machine>(.*)</machine>
863: <action_values>(.*)</action_values>
864: </row>$
865: }x
866: );
867: my $resource_id = &xml_get_id('resource',$resource);
868: my $student_id = &xml_get_id('student',$student);
869: my $machine_id = &xml_get_id('machine',$machine);
870: &xml_store_activity_row(map { defined($_)?$dbh->quote($_):''
871: } ($resource_id,
872: $time,
873: $student_id,
874: $action,
875: 'NULL',
876: $machine_id,
877: $action_values));
878: }
879: &xml_store_activity_row();
880: close($xmlfh);
881: # Store id tables
882: while (my ($id_name,$id_data) = each(%ids)) {
883: if ($id_name eq 'resource') { $id_name = 'res'; }
884: delete($id_data->{"\0count"});
885: &xml_store_id_table($id_name,$id_data);
886: }
887: return;
888: }
889:
890: sub xml_get_id {
891: my ($table,$element) = @_;
892: if (! exists($ids{$table}->{$element})) {
893: $ids{$table}->{$element} = $ids{$table}->{"\0count"}++;
894: }
895: return $ids{$table}->{$element};
896: }
897:
898: {
899: my @data_rows;
900: sub xml_store_activity_row {
901: my @data = @_;
902: if (scalar(@data)) {
903: push(@data_rows,[@data]);
904: }
905: if (! scalar(@data) || scalar(@data_rows) > 500) {
906: if (! &Apache::lonmysql::bulk_store_rows($tables{'activity'},
907: scalar(@{$data_rows[0]}),
908: \@data_rows)) {
909: $logthis->("Error:".&Apache::lonmysql::get_error());
910: warn("Error:".&Apache::lonmysql::get_error());
911: } else {
912: undef(@data_rows);
913: }
914: }
915: return;
916: }
917:
918: }
919:
920: sub xml_store_id_table {
921: my ($table,$tabledata) =@_;
922: my $dbh = &Apache::lonmysql::get_dbh();
923: if (! &Apache::lonmysql::bulk_store_rows
924: ($tables{$table},2,
925: [map{[$tabledata->{$_},$dbh->quote($_)]} keys(%$tabledata)])) {
926: $logthis->("Error:".&Apache::lonmysql::get_error());
927: warn "Error:".&Apache::lonmysql::get_error().$/;
928: }
929: }
930:
931: } # End of load xml scoping
932:
933: #######################################################################
934: #######################################################################
935: ##
936: ## store_entry - accumulate data to be inserted into the database
937: ##
938: ## Pass no values in to clear accumulator
939: ## Pass ($dbh,\%tables) to initiate storage of values
940: ## Pass ($dbh,\%tables,\%data) to use normally
941: ##
942: #######################################################################
943: #######################################################################
944: {
945: my @rows;
946:
947: sub store_entry {
948: my $max_row_count = 100;
949: if (! @_) {
950: undef(@rows);
951: return '';
952: }
953: my ($dbh,$tables,$data) = @_;
954: return if (! defined($tables));
955: if (defined($data)) {
956: my $error;
957: foreach my $field ('student','resource','action','time') {
958: if (! defined($data->{$field}) || $data->{$field} eq ':' ||
959: $data->{$field}=~ /^\s*$/) {
960: $error.=$field.',';
961: }
962: }
963: if ($error) { $error=~s/,$//; return $error; }
964: #
965: my $student_id = &get_id($tables->{'student'},'student',
966: $data->{'student'});
967: my $res_id = &get_id($tables->{'res'},
968: 'resource',$data->{'resource'});
969: my $machine_id = &get_id($tables->{'machine'},
970: 'machine',$data->{'machine'});
971: my $idx = $data->{'idx'}; if (! $idx) { $idx = "''"; }
972: #
973: push(@rows,[$res_id,
974: qq{'$data->{'time'}'},
975: $student_id,
976: qq{'$data->{'action'}'},
977: $idx,
978: $machine_id,
979: $data->{'action_values'}]);
980: }
981: if (defined($tables) &&
982: ( (! defined($data) && scalar(@rows)) || scalar(@rows)>$max_row_count)
983: ){
984: # Store the rows
985: my $result =
986: &Apache::lonmysql::bulk_store_rows($tables->{'activity'},
987: undef,
988: \@rows);
989: if (! defined($result)) {
990: my $error = &Apache::lonmysql::get_error();
991: warn "Error occured during insert.".$error;
992: return $error;
993: }
994: undef(@rows);
995: return $result if (! defined($data));
996: }
997: return '';
998: }
999:
1000: } # end of scope for &store_entry
1001:
1002: ###############################################################
1003: ###############################################################
1004: ##
1005: ## The usual suspects
1006: ##
1007: ###############################################################
1008: ###############################################################
1009: sub escape {
1010: my $str=shift;
1011: $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
1012: return $str;
1013: }
1014:
1015: sub unescape {
1016: my $str=shift;
1017: $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1018: return $str;
1019: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>