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