1: #!/usr/bin/perl
2: #
3: # The LearningOnline Network
4: #
5: # $Id: parse_activity_log.pl,v 1.17 2005/09/19 20:30:37 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:
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: if ($srcfile) {
148: $sourcefilename = $srcfile;
149: } else {
150: $sourcefilename = &get_filename($course,$domain);
151: }
152: my $sql_filename = $sourcefilename;
153: $sql_filename =~ s|[^/]*$|activity.log.sql|;
154: my $gz_sql_filename = $sql_filename.'.gz';
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' there 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: my $missing_table = &check_for_missing_tables(values(%tables));
309: if (-s $gz_sql_filename && ! -s $gz_xml_filename) {
310: my $backup_modification_time = (stat($gz_sql_filename))[9];
311: $logthis->($gz_sql_filename.' was last modified '.
312: localtime($backup_modification_time).
313: '('.$backup_modification_time.')');
314: if ($missing_table) {
315: # If the backup happened prior to the last table modification,
316: # we need to save the tables.
317: if (&latest_table_modification_time() > $backup_modification_time) {
318: # Save the current tables in case we need them another time.
319: $logthis->('Backing existing tables up');
320: &backup_tables_as_xml($gz_xml_filename.'.save_'.time,\%tables);
321: }
322: $time_this->();
323: &load_backup_sql_tables($gz_sql_filename);
324: &backup_tables_as_xml($gz_xml_filename,\%tables);
325: $time_this->('load backup tables');
326: }
327: } elsif (-s $gz_xml_filename) {
328: my $backup_modification_time = (stat($gz_xml_filename))[9];
329: $logthis->($gz_xml_filename.' was last modified '.
330: localtime($backup_modification_time).
331: '('.$backup_modification_time.')');
332: if ($missing_table) {
333: my $table_modification_time = $backup_modification_time;
334: # If the backup happened prior to the last table modification,
335: # we need to save the tables.
336: if (&latest_table_modification_time() > $backup_modification_time) {
337: # Save the current tables in case we need them another time.
338: $logthis->('Backing existing tables up');
339: &backup_tables_as_xml($gz_xml_filename.'.save_'.time,\%tables);
340: }
341: $time_this->();
342: # We have to make our own tables for the xml format
343: &drop_tables();
344: &create_tables();
345: &load_backup_xml_tables($gz_xml_filename,\%tables);
346: $time_this->('load backup tables');
347: }
348: }
349:
350: if (defined($xmlfile)) {
351: &clean_up_and_exit(0);
352: }
353:
354: ##
355: ## Ensure the tables we need exist
356: # create_tables does not complain if the tables already exist
357: $logthis->('creating tables');
358: if (! &create_tables()) {
359: warn "Unable to create tables";
360: $logthis->('Unable to create tables');
361: &clean_up_and_exit(4);
362: }
363:
364: ##
365: ## Read the ids used for various tables
366: $logthis->('reading id tables');
367: &read_id_tables();
368: $logthis->('finished reading id tables');
369:
370: ##
371: ## Set up the errors file
372: my $error_fh = IO::File->new(">>$error_filename");
373:
374: ##
375: ## Parse the course log
376: $logthis->('processing course log');
377: if (-s $newfilename) {
378: my $result = &process_courselog($newfilename,$error_fh,\%tables);
379: if (! defined($result)) {
380: # Something went wrong along the way...
381: $logthis->('process_courselog returned undef');
382: &clean_up_and_exit(5);
383: } elsif ($result > 0) {
384: $time_this->();
385: $logthis->('process_courselog returned '.$result.'.'.$/.
386: 'Backing up tables');
387: &backup_tables_as_xml($gz_xml_filename,\%tables);
388: $time_this->('write backup tables');
389: }
390: if ($drop_when_done) { &drop_tables(); $logthis->('dropped tables'); }
391: }
392: close($error_fh);
393:
394: ##
395: ## Clean up the filesystem
396: &Apache::lonmysql::disconnect_from_db();
397: unlink($newfilename) if (-e $newfilename && ! $nocleanup);
398:
399: ##
400: ## Print timing data
401: $logthis->('printing timing data');
402: if ($time_run) {
403: my $elapsed_time = Time::HiRes::time - $initial_time;
404: print "Overall time: ".$elapsed_time.$/;
405: print &outputtimes();
406: $logthis->("Overall time: ".$elapsed_time);
407: $logthis->(&outputtimes());
408: }
409:
410: &clean_up_and_exit(0);
411:
412: ########################################################
413: ########################################################
414:
415: sub clean_up_and_exit {
416: my ($exit_code) = @_;
417: # Close files
418: close(LOCKFILE);
419: close(LOGFILE);
420: # Remove zero length files
421: foreach my $file ($lockfilename, $error_filename,$logfile) {
422: if (defined($file) && -z $file) {
423: unlink($file);
424: }
425: }
426:
427: exit $exit_code;
428: }
429:
430: ########################################################
431: ########################################################
432: sub table_names {
433: my ($course,$domain) = @_;
434: my $prefix = $course.'_'.$domain.'_';
435: #
436: my %tables =
437: ( student =>&Apache::lonmysql::fix_table_name($prefix.'students'),
438: res =>&Apache::lonmysql::fix_table_name($prefix.'resource'),
439: machine =>&Apache::lonmysql::fix_table_name($prefix.'machine_table'),
440: activity=>&Apache::lonmysql::fix_table_name($prefix.'activity'),
441: );
442: return %tables;
443: }
444:
445: ########################################################
446: ########################################################
447: ##
448: ## Process Course Log
449: ##
450: ########################################################
451: ########################################################
452: #
453: # Returns the number of lines in the activity.log file that were processed.
454: sub process_courselog {
455: my ($inputfile,$error_fh,$tables) = @_;
456: if (! open(IN,$inputfile)) {
457: warn "Unable to open '$inputfile' for reading";
458: $logthis->("Unable to open '$inputfile' for reading");
459: return undef;
460: }
461: my ($linecount,$insertcount);
462: my $dbh = &Apache::lonmysql::get_dbh();
463: #
464: &store_entry();
465: while (my $line=<IN>){
466: # last if ($linecount > 1000);
467: #
468: # Bulk storage variables
469: $time_this->();
470: chomp($line);
471: $linecount++;
472: # print $linecount++.$/;
473: my ($timestamp,$host,$log)=split(/\:/,$line,3);
474: #
475: # $log has the actual log entries; currently still escaped, and
476: # %26(timestamp)%3a(url)%3a(user)%3a(domain)
477: # then additionally
478: # %3aPOST%3a(name)%3d(value)%3a(name)%3d(value)
479: # or
480: # %3aCSTORE%3a(name)%3d(value)%26(name)%3d(value)
481: #
482: # get delimiter between timestamped entries to be &&&
483: $log=~s/\%26(\d{9,10})\%3a/\&\&\&$1\%3a/g;
484: $log = &unescape($log);
485: # now go over all log entries
486: if (! defined($host)) { $host = 'unknown'; }
487: my $prevchunk = 'none';
488: foreach my $chunk (split(/\&\&\&/,$log)) {
489: my $warningflag = '';
490: my ($time,$res,$uname,$udom,$action,@values)= split(/:/,$chunk);
491: if (! defined($res) || $res =~ /^\s*$/) {
492: $res = '/adm/roles';
493: $action = 'LOGIN';
494: }
495: if ($res =~ m|^/prtspool/|) {
496: $res = '/prtspool/';
497: }
498: if (! defined($action) || $action eq '') {
499: $action = 'VIEW';
500: }
501: if ($action !~ /^(LOGIN|VIEW|POST|CSTORE|STORE)$/) {
502: $warningflag .= 'action';
503: print $error_fh 'full log entry:'.$log.$/;
504: print $error_fh 'error on chunk:'.$chunk.$/;
505: $logthis->('(action) Unable to parse '.$/.$chunk.$/.
506: 'got '.
507: 'time = '.$time.$/.
508: 'res = '.$res.$/.
509: 'uname= '.$uname.$/.
510: 'udom = '.$udom.$/.
511: 'action='.$action.$/.
512: '@values = '.join('&',@values));
513: next; #skip it if we cannot understand what is happening.
514: }
515: #
516: my %data = (student => $uname.':'.$udom,
517: resource => $res,
518: machine => $host,
519: action => $action,
520: time => &Apache::lonmysql::sqltime($time));
521: if ($action eq 'POST') {
522: $data{'action_values'} =
523: $dbh->quote(join('&',map { &escape($_); } @values));
524: } else {
525: $data{'action_values'} = $dbh->quote(join('&',@values));
526: }
527: my $error = &store_entry($dbh,$tables,\%data);
528: if ($error) {
529: $logthis->('error store_entry:'.$error." on %data");
530: }
531: $prevchunk = $chunk;
532: }
533: }
534: my $result = &store_entry($dbh,$tables);
535: if (! defined($result)) {
536: my $error = &Apache::lonmysql::get_error();
537: warn "Error occured during insert.".$error;
538: $logthis->('error = '.$error);
539: }
540: close IN;
541: return $linecount;
542: }
543:
544:
545: ##
546: ## default value for $logthis and $time_this
547: sub nothing {
548: return;
549: }
550:
551: ##
552: ## Logging routine (look for $log)
553: ##
554: sub log_to_file {
555: my ($input)=@_;
556: print LOGFILE $input.$/;
557: }
558:
559: ##
560: ## Timing routines
561: ##
562: {
563: my %Timing;
564: my $starttime;
565:
566: sub time_action {
567: my ($key) = @_;
568: if (defined($key)) {
569: $Timing{$key}+=Time::HiRes::time-$starttime;
570: $Timing{'count_'.$key}++;
571: }
572: $starttime = Time::HiRes::time;
573: }
574:
575: sub outputtimes {
576: my $Str;
577: if ($time_run) {
578: $Str = "Timing Data:".$/;
579: while (my($k,$v) = each(%Timing)) {
580: next if ($k =~ /^count_/);
581: my $count = $Timing{'count_'.$k};
582: $Str .=
583: ' '.sprintf("%25.25s",$k).
584: ' '.sprintf('% 8d',$count).
585: ' '.sprintf('%12.5f',$v).$/;
586: }
587: }
588: return $Str;
589: }
590:
591: }
592:
593: sub latest_table_modification_time {
594: my $latest_time;
595: foreach my $table (@Activity_Table,@ID_Tables) {
596: my %tabledata = &Apache::lonmysql::table_information($table->{'id'});
597: next if (! scalar(keys(%tabledata))); # table does not exist
598: if (! defined($latest_time) ||
599: $latest_time < $tabledata{'Update_time'}) {
600: $latest_time = $tabledata{'Update_time'};
601: }
602: }
603: return $latest_time;
604: }
605:
606: sub check_for_missing_tables {
607: my @wanted_tables = @_;
608: # Check for missing tables
609: my @Current_Tables = &Apache::lonmysql::tables_in_db();
610: my %Found;
611: foreach my $tablename (@Current_Tables) {
612: foreach my $table (@wanted_tables) {
613: if ($tablename eq $table) {
614: $Found{$tablename}++;
615: }
616: }
617: }
618: $logthis->('Found tables '.join(',',keys(%Found)));
619: my $missing_a_table = 0;
620: foreach my $table (@wanted_tables) {
621: if (! $Found{$table}) {
622: $logthis->('Missing table '.$table);
623: $missing_a_table = 1;
624: last;
625: }
626: }
627: return $missing_a_table;
628: }
629:
630: ##
631: ## Use mysqldump to store backups of the tables
632: ##
633: sub backup_tables_as_sql {
634: my ($gz_sql_filename) = @_;
635: my $command = qq{mysqldump --quote-names --opt loncapa };
636: foreach my $table (@ID_Tables,@Activity_Table) {
637: my $tablename = $table->{'id'};
638: $tablename =~ s/\`//g;
639: $command .= $tablename.' ';
640: }
641: $command .= '| gzip >'.$gz_sql_filename;
642: $logthis->($command);
643: system($command);
644: }
645:
646: ##
647: ## Load in mysqldumped files
648: ##
649: sub load_backup_sql_tables {
650: my ($gz_sql_filename) = @_;
651: if (-s $gz_sql_filename) {
652: $logthis->('loading data from gzipped sql file');
653: my $command='gzip -dc '.$gz_sql_filename.' | mysql --database=loncapa';
654: system($command);
655: $logthis->('finished loading gzipped data');;
656: } else {
657: return undef;
658: }
659: }
660:
661: ##
662: ##
663: ##
664: sub update_process_name {
665: my ($text) = @_;
666: $0 = 'parse_activity_log.pl: '.$text;
667: }
668:
669: sub get_filename {
670: my ($course,$domain) = @_;
671: my ($a,$b,$c,undef) = split('',$course,4);
672: return "$perlvar{'lonUsersDir'}/$domain/$a/$b/$c/$course/activity.log";
673: }
674:
675: sub create_tables {
676: foreach my $table (@ID_Tables,@Activity_Table) {
677: my $table_id = &Apache::lonmysql::create_table($table);
678: if (! defined($table_id)) {
679: warn "Unable to create table ".$table->{'id'}.$/;
680: $logthis->('Unable to create table '.$table->{'id'});
681: $logthis->(join($/,&Apache::lonmysql::build_table_creation_request($table)));
682: return 0;
683: }
684: }
685: return 1;
686: }
687:
688: sub drop_tables {
689: foreach my $table (@ID_Tables,@Activity_Table) {
690: my $table_id = $table->{'id'};
691: &Apache::lonmysql::drop_table($table_id);
692: }
693: }
694:
695: #################################################################
696: #################################################################
697: ##
698: ## Database item id code
699: ##
700: #################################################################
701: #################################################################
702: { # Scoping for ID lookup code
703: my %IDs;
704:
705: sub read_id_tables {
706: foreach my $table (@ID_Tables) {
707: my @Data = &Apache::lonmysql::get_rows($table->{'id'});
708: my $count = 0;
709: foreach my $row (@Data) {
710: $IDs{$table->{'id'}}->{$row->[1]} = $row->[0];
711: }
712: }
713: return;
714: }
715:
716: sub get_id {
717: my ($table,$fieldname,$value) = @_;
718: if (exists($IDs{$table}->{$value}) && $IDs{$table}->{$value} =~ /^\d+$/) {
719: return $IDs{$table}->{$value};
720: } else {
721: # insert into the table - if the item already exists, that is
722: # okay.
723: my $result = &Apache::lonmysql::store_row($table,[undef,$value]);
724: if (! defined($result)) {
725: warn("Got error on id insert for $value\n".
726: &Apache::lonmysql::get_error());
727: }
728: # get the id
729: my $id = &Apache::lonmysql::get_dbh()->{'mysql_insertid'};
730: if (defined($id)) {
731: $IDs{$table}->{$value}=$id;
732: } else {
733: $logthis->("Unable to retrieve id for $table $fieldname $value");
734: return undef;
735: }
736: }
737: }
738:
739: } # End of ID scoping
740:
741: ###############################################################
742: ###############################################################
743: ##
744: ## Save as XML
745: ##
746: ###############################################################
747: ###############################################################
748: sub backup_tables_as_xml {
749: my ($filename,$tables) = @_;
750: open(XMLFILE,"|gzip - > $filename") || return ('error:unable to write '.$filename);
751: my $query = qq{
752: SELECT B.resource,
753: A.time,
754: A.idx,
755: C.student,
756: A.action,
757: E.machine,
758: A.action_values
759: FROM $tables->{'activity'} AS A
760: LEFT JOIN $tables->{'res'} AS B ON B.res_id=A.res_id
761: LEFT JOIN $tables->{'student'} AS C ON C.student_id=A.student_id
762: LEFT JOIN $tables->{'machine'} AS E ON E.machine_id=A.machine_id
763: ORDER BY A.time DESC
764: };
765: $query =~ s/\s+/ /g;
766: my $dbh = &Apache::lonmysql::get_dbh();
767: my $sth = $dbh->prepare($query);
768: if (! $sth->execute()) {
769: $logthis->('<font color="blue">'.
770: 'WARNING: Could not retrieve from database:'.
771: $sth->errstr().'</font>');
772: return undef;
773: } else {
774: my ($res,$sqltime,$idx,$student,$action,$machine,$action_values);
775: if ($sth->bind_columns(\$res,\$sqltime,\$idx,\$student,\$action,
776: \$machine,\$action_values)) {
777:
778: while ($sth->fetch) {
779: print XMLFILE '<row>'.
780: qq{<resource>$res</resource>}.
781: qq{<time>$sqltime</time>}.
782: qq{<idx>$idx</idx>}.
783: qq{<student>$student</student>}.
784: qq{<action>$action</action>}.
785: qq{<machine>$machine</machine>}.
786: qq{<action_values>$action_values</action_values>}.
787: '</row>'.$/;
788: }
789: } else {
790: warn "Unable to bind to columns.\n";
791: return undef;
792: }
793: }
794: close XMLFILE;
795: return;
796: }
797:
798: ###############################################################
799: ###############################################################
800: ##
801: ## load as xml
802: ##
803: ###############################################################
804: ###############################################################
805: {
806: my @fields = ('resource','time',
807: 'student','action','idx','machine','action_values');
808: my %ids = ();
809: sub load_backup_xml_tables {
810: my ($filename,$tables) = @_;
811: my $dbh = &Apache::lonmysql::get_dbh();
812: my $xmlfh;
813: open($xmlfh,"cat $filename | gzip -d - |");
814: if (! defined($xmlfh)) {
815: return ('error:unable to read '.$filename);
816: }
817: #
818: %ids = (resource=> {"\0count"=>1},
819: student=> {"\0count"=>1},
820: machine=> {"\0count"=>1});
821: #
822: my %data;
823: while (my $inputline = <$xmlfh>) {
824: my ($resource,$time,undef,$student,$action,$machine,$action_values) =
825: ($inputline =~ m{<row>
826: <resource>(.*)</resource>
827: <time>(.*)</time>
828: <idx>(.*)</idx>
829: <student>(.*)</student>
830: <action>(.*)</action>
831: <machine>(.*)</machine>
832: <action_values>(.*)</action_values>
833: </row>$
834: }x
835: );
836: my $resource_id = &xml_get_id('resource',$resource);
837: my $student_id = &xml_get_id('student',$student);
838: my $machine_id = &xml_get_id('machine',$machine);
839: &xml_store_activity_row(map { defined($_)?$dbh->quote($_):''
840: } ($resource_id,
841: $time,
842: $student_id,
843: $action,
844: 'NULL',
845: $machine_id,
846: $action_values));
847: }
848: &xml_store_activity_row();
849: close($xmlfh);
850: # Store id tables
851: while (my ($id_name,$id_data) = each(%ids)) {
852: if ($id_name eq 'resource') { $id_name = 'res'; }
853: delete($id_data->{"\0count"});
854: &xml_store_id_table($id_name,$id_data);
855: }
856: return;
857: }
858:
859: sub xml_get_id {
860: my ($table,$element) = @_;
861: if (! exists($ids{$table}->{$element})) {
862: $ids{$table}->{$element} = $ids{$table}->{"\0count"}++;
863: }
864: return $ids{$table}->{$element};
865: }
866:
867: {
868: my @data_rows;
869: sub xml_store_activity_row {
870: my @data = @_;
871: if (scalar(@data)) {
872: push(@data_rows,[@data]);
873: }
874: if (! scalar(@data) || scalar(@data_rows) > 500) {
875: if (! &Apache::lonmysql::bulk_store_rows($tables{'activity'},
876: scalar(@{$data_rows[0]}),
877: \@data_rows)) {
878: $logthis->("Error:".&Apache::lonmysql::get_error());
879: warn("Error:".&Apache::lonmysql::get_error());
880: } else {
881: undef(@data_rows);
882: }
883: }
884: return;
885: }
886:
887: }
888:
889: sub xml_store_id_table {
890: my ($table,$tabledata) =@_;
891: my $dbh = &Apache::lonmysql::get_dbh();
892: if (! &Apache::lonmysql::bulk_store_rows
893: ($tables{$table},2,
894: [map{[$tabledata->{$_},$dbh->quote($_)]} keys(%$tabledata)])) {
895: $logthis->("Error:".&Apache::lonmysql::get_error());
896: warn "Error:".&Apache::lonmysql::get_error().$/;
897: }
898: }
899:
900: } # End of load xml scoping
901:
902: #######################################################################
903: #######################################################################
904: ##
905: ## store_entry - accumulate data to be inserted into the database
906: ##
907: ## Pass no values in to clear accumulator
908: ## Pass ($dbh,\%tables) to initiate storage of values
909: ## Pass ($dbh,\%tables,\%data) to use normally
910: ##
911: #######################################################################
912: #######################################################################
913: {
914: my @rows;
915: my $max_row_count = 100;
916:
917: sub store_entry {
918: if (! @_) {
919: undef(@rows);
920: return '';
921: }
922: my ($dbh,$tables,$data) = @_;
923: return if (! defined($tables));
924: if (defined($data)) {
925: my $error;
926: foreach my $field ('student','resource','action','time') {
927: if (! defined($data->{$field}) || $data->{$field} eq ':' ||
928: $data->{$field}=~ /^\s*$/) {
929: $error.=$field.',';
930: }
931: }
932: if ($error) { $error=~s/,$//; return $error; }
933: #
934: my $student_id = &get_id($tables->{'student'},'student',
935: $data->{'student'});
936: my $res_id = &get_id($tables->{'res'},
937: 'resource',$data->{'resource'});
938: my $machine_id = &get_id($tables->{'machine'},
939: 'machine',$data->{'machine'});
940: my $idx = $data->{'idx'}; if (! $idx) { $idx = "''"; }
941: #
942: push(@rows,[$res_id,
943: qq{'$data->{'time'}'},
944: $student_id,
945: qq{'$data->{'action'}'},
946: $idx,
947: $machine_id,
948: $data->{'action_values'}]);
949: }
950: if (defined($tables) &&
951: ( (! defined($data) && scalar(@rows)) || scalar(@rows)>$max_row_count)
952: ){
953: # Store the rows
954: my $result =
955: &Apache::lonmysql::bulk_store_rows($tables->{'activity'},
956: undef,
957: \@rows);
958: if (! defined($result)) {
959: my $error = &Apache::lonmysql::get_error();
960: warn "Error occured during insert.".$error;
961: return $error;
962: }
963: undef(@rows);
964: return $result if (! defined($data));
965: }
966: return '';
967: }
968:
969: } # end of scope for &store_entry
970:
971: ###############################################################
972: ###############################################################
973: ##
974: ## The usual suspects
975: ##
976: ###############################################################
977: ###############################################################
978: sub escape {
979: my $str=shift;
980: $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
981: return $str;
982: }
983:
984: sub unescape {
985: my $str=shift;
986: $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
987: return $str;
988: }
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