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