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