Annotation of loncom/metadata_database/parse_activity_log.pl, revision 1.8
1.1 matthew 1: #!/usr/bin/perl
2: #
3: # The LearningOnline Network
4: #
1.8 ! matthew 5: # $Id: parse_activity_log.pl,v 1.7 2004/12/16 19:29:20 matthew Exp $
1.1 matthew 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: #
1.3 matthew 29: #--------------------------------------------------------------------
1.1 matthew 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 Unspecified error?
38: #
39:
1.8 ! matthew 40: #
! 41: # Notes:
! 42: #
! 43: # Logging is done via the $logthis variable, which may be the result of
! 44: # overcleverness. log via $logthis->('logtext'); Those are parentheses,
! 45: # not curly braces. If the -log command line parameter is set, the $logthis
! 46: # routine is set to a routine which writes to a file. If the command line
! 47: # parameter is not set $logthis is set to ¬hing, which does what you
! 48: # would expect.
! 49: #
! 50:
1.1 matthew 51: use strict;
52: use DBI;
1.8 ! matthew 53: use lib '/home/httpd/lib/perl/';
! 54: use LONCAPA::Configuration();
! 55: use Apache::lonmysql();
1.1 matthew 56: use lonmysql();
57: use Time::HiRes();
58: use Getopt::Long();
1.3 matthew 59: use IO::File;
1.5 matthew 60: use File::Copy;
1.7 matthew 61: use Fcntl qw(:flock);
62:
1.1 matthew 63: #
64: # Determine parameters
1.5 matthew 65: my ($help,$course,$domain,$drop,$file,$time_run,$nocleanup,$log,$backup);
1.1 matthew 66: &Getopt::Long::GetOptions( "course=s" => \$course,
67: "domain=s" => \$domain,
1.5 matthew 68: "backup" => \$backup,
1.1 matthew 69: "help" => \$help,
70: "logfile=s" => \$file,
71: "timerun" => \$time_run,
72: "nocleanup" => \$nocleanup,
1.2 matthew 73: "drop" => \$drop,
74: "log" => \$log);
1.1 matthew 75: if (! defined($course) || $help) {
76: print<<USAGE;
77: parse_activity_log.pl
78:
79: Process a lon-capa activity log into a database.
80: Parameters:
81: course Required
82: domain Optional
1.5 matthew 83: backup optional if present, backup the activity log file
84: before processing it
1.1 matthew 85: drop optional if present, drop all course
86: specific activity log tables.
87: file optional Specify the file to parse, including path
88: time optional if present, print out timing data
89: nocleanup optional if present, do not remove old files
1.2 matthew 90: log optional if present, prepare log file of activity
1.1 matthew 91: Examples:
92: $0 -course=123456abcdef -domain=msu
93: $0 -course=123456abcdef -file=activity.log
94: USAGE
95: exit;
96: }
97:
98: ##
99: ## Set up timing code
100: my $time_this = \¬hing;
101: if ($time_run) {
102: $time_this = \&time_action;
103: }
104: my $initial_time = Time::HiRes::time;
105:
106: ##
1.3 matthew 107: ## Read in configuration parameters
108: ##
1.8 ! matthew 109: my %perlvar = %{&LONCAPA::Configuration::read_conf('loncapa.conf')};
! 110:
1.3 matthew 111: if (! defined($domain) || $domain eq '') {
112: $domain = $perlvar{'lonDefDomain'};
113: }
114: &update_process_name($course.'@'.$domain);
115:
116: ##
1.2 matthew 117: ## Set up logging code
118: my $logthis = \¬hing;
119: if ($log) {
1.4 matthew 120: my $logfile = $perlvar{'lonDaemons'}.'/tmp/parse_activity_log.log.'.time;
1.2 matthew 121: print STDERR "$0: logging to $logfile".$/;
122: if (! open(LOGFILE,">$logfile")) {
123: die "Unable to open $logfile for writing. Run aborted.";
124: } else {
125: $logthis = \&log_to_file;
126: }
127: }
1.3 matthew 128:
1.1 matthew 129:
130: ##
131: ## Determine filenames
132: ##
133: my $sourcefilename; # activity log data
134: my $newfilename; # $sourcefilename will be renamed to this
1.6 matthew 135: my $gz_sql_filename; # the gzipped mysql backup data file name.
1.3 matthew 136: my $error_filename; # Errors in parsing the activity log will be written here
1.1 matthew 137: if ($file) {
138: $sourcefilename = $file;
139: } else {
140: $sourcefilename = &get_filename($course,$domain);
141: }
1.6 matthew 142: my $sql_filename = $sourcefilename;
1.2 matthew 143: $sql_filename =~ s|[^/]*$|activity.log.sql|;
1.6 matthew 144: $gz_sql_filename = $sql_filename.'.gz';
1.3 matthew 145: $error_filename = $sourcefilename;
146: $error_filename =~ s|[^/]*$|activity.log.errors|;
147: $logthis->('Beginning logging '.time);
1.1 matthew 148:
1.7 matthew 149:
150: #
151: # Wait for a lock on the lockfile to avoid collisions
152: my $lockfilename = $sourcefilename.'.lock';
153: open(LOCKFILE,'>'.$lockfilename);
154: flock(LOCKFILE,LOCK_EX) || die("Unable to lock $lockfilename. Aborting".$/);
155:
1.1 matthew 156: ##
157: ## There will only be a $newfilename file if a copy of this program is already
158: ## running.
159: my $newfilename = $sourcefilename.'.processing';
160: if (-e $newfilename) {
161: warn "$newfilename exists";
1.7 matthew 162: $logthis->($newfilename.' exists, so I cannot work on it.');
1.1 matthew 163: exit 2;
164: }
165:
166: if (-e $sourcefilename) {
1.3 matthew 167: $logthis->('renaming '.$sourcefilename.' to '.$newfilename);
1.1 matthew 168: rename($sourcefilename,$newfilename);
1.5 matthew 169: Copy($newfilename,$newfilename.'.'.time) if ($backup);
1.2 matthew 170: $logthis->("renamed $sourcefilename to $newfilename");
1.3 matthew 171: } else {
172: my $command = 'touch '.$newfilename;
173: $logthis->($command);
174: system($command);
175: $logthis->('touch was completed');
1.1 matthew 176: }
177:
1.7 matthew 178: close(LOCKFILE);
179:
1.1 matthew 180: ##
181: ## Table definitions
182: ##
183: my $prefix = $course.'_'.$domain.'_';
184: my $student_table = $prefix.'students';
185: my $student_table_def =
186: { id => $student_table,
187: permanent => 'no',
188: columns => [
189: { name => 'student_id',
190: type => 'MEDIUMINT UNSIGNED',
191: restrictions => 'NOT NULL',
192: auto_inc => 'yes', },
193: { name => 'student',
194: type => 'VARCHAR(100) BINARY',
195: restrictions => 'NOT NULL', },
196: ],
197: 'PRIMARY KEY' => ['student_id',],
198: };
199:
200: my $res_table = $prefix.'resource';
201: my $res_table_def =
202: { id => $res_table,
203: permanent => 'no',
204: columns => [{ name => 'res_id',
205: type => 'MEDIUMINT UNSIGNED',
206: restrictions => 'NOT NULL',
207: auto_inc => 'yes', },
208: { name => 'resource',
209: type => 'MEDIUMTEXT',
210: restrictions => 'NOT NULL'},
211: ],
212: 'PRIMARY KEY' => ['res_id'],
213: };
214:
1.4 matthew 215: #my $action_table = $prefix.'actions';
216: #my $action_table_def =
217: #{ id => $action_table,
218: # permanent => 'no',
219: # columns => [{ name => 'action_id',
220: # type => 'MEDIUMINT UNSIGNED',
221: # restrictions => 'NOT NULL',
222: # auto_inc => 'yes', },
223: # { name => 'action',
224: # type => 'VARCHAR(100)',
225: # restrictions => 'NOT NULL'},
226: # ],
227: # 'PRIMARY KEY' => ['action_id',],
228: #};
1.1 matthew 229:
230: my $machine_table = $prefix.'machine_table';
231: my $machine_table_def =
232: { id => $machine_table,
233: permanent => 'no',
234: columns => [{ name => 'machine_id',
235: type => 'MEDIUMINT UNSIGNED',
236: restrictions => 'NOT NULL',
237: auto_inc => 'yes', },
238: { name => 'machine',
239: type => 'VARCHAR(100)',
240: restrictions => 'NOT NULL'},
241: ],
242: 'PRIMARY KEY' => ['machine_id',],
243: };
244:
245: my $activity_table = $prefix.'activity';
246: my $activity_table_def =
247: { id => $activity_table,
248: permanent => 'no',
249: columns => [
250: { name => 'res_id',
251: type => 'MEDIUMINT UNSIGNED',
252: restrictions => 'NOT NULL',},
253: { name => 'time',
254: type => 'DATETIME',
255: restrictions => 'NOT NULL',},
256: { name => 'student_id',
1.2 matthew 257: type => 'MEDIUMINT UNSIGNED',
1.1 matthew 258: restrictions => 'NOT NULL',},
1.4 matthew 259: { name => 'action',
260: type => 'VARCHAR(10)',
1.1 matthew 261: restrictions => 'NOT NULL',},
262: { name => 'idx', # This is here in case a student
263: type => 'MEDIUMINT UNSIGNED', # has multiple submissions during
264: restrictions => 'NOT NULL', # one second. It happens, trust
265: auto_inc => 'yes', }, # me.
266: { name => 'machine_id',
1.2 matthew 267: type => 'MEDIUMINT UNSIGNED',
1.1 matthew 268: restrictions => 'NOT NULL',},
269: { name => 'action_values',
270: type => 'MEDIUMTEXT', },
271: ],
1.4 matthew 272: 'PRIMARY KEY' => ['time','student_id','res_id','idx'],
273: 'KEY' => [{columns => ['student_id']},
274: {columns => ['time']},],
1.1 matthew 275: };
1.4 matthew 276:
1.8 ! matthew 277: my @Activity_Table = ($activity_table_def);
1.4 matthew 278: my @ID_Tables = ($student_table_def,$res_table_def,$machine_table_def);
1.1 matthew 279: ##
280: ## End of table definitions
281: ##
282:
1.3 matthew 283: $logthis->('Connectiong to mysql');
1.8 ! matthew 284: &Apache::lonmysql::set_mysql_user_and_password('www',
1.1 matthew 285: $perlvar{'lonSqlAccess'});
286: if (!&Apache::lonmysql::verify_sql_connection()) {
287: warn "Unable to connect to MySQL database.";
1.2 matthew 288: $logthis->("Unable to connect to MySQL database.");
1.1 matthew 289: exit 3;
290: }
1.3 matthew 291: $logthis->('SQL connection is up');
292:
1.2 matthew 293: if ($drop) { &drop_tables(); $logthis->('dropped tables'); }
1.3 matthew 294:
1.6 matthew 295: if (-s $gz_sql_filename) {
1.8 ! matthew 296: my $backup_modification_time = (stat($gz_sql_filename))[9];
! 297: $logthis->($gz_sql_filename.' was last modified '.
! 298: localtime($backup_modification_time).
! 299: '('.$backup_modification_time.')');
! 300: # Check for missing tables
1.1 matthew 301: my @Current_Tables = &Apache::lonmysql::tables_in_db();
1.8 ! matthew 302: $logthis->(join(',',@Current_Tables));
1.1 matthew 303: my %Found;
304: foreach my $tablename (@Current_Tables) {
1.3 matthew 305: foreach my $table (@Activity_Table,@ID_Tables) {
1.1 matthew 306: if ($tablename eq $table->{'id'}) {
307: $Found{$tablename}++;
308: }
309: }
310: }
1.8 ! matthew 311: $logthis->('Found tables '.join(',',keys(%Found)));
! 312: my $missing_a_table = 0;
1.3 matthew 313: foreach my $table (@Activity_Table,@ID_Tables) {
1.8 ! matthew 314: # Hmmm, should I dump the tables?
1.1 matthew 315: if (! $Found{$table->{'id'}}) {
1.8 ! matthew 316: $logthis->('Missing table '.$table->{'id'});
! 317: $missing_a_table = 1;
1.1 matthew 318: last;
319: }
320: }
1.8 ! matthew 321: if ($missing_a_table) {
! 322: my $table_modification_time = $backup_modification_time;
! 323: # If the backup happened prior to the last table modification,
! 324: foreach my $table (@Activity_Table,@ID_Tables) {
! 325: my %tabledata = &Apache::lonmysql::table_information($table->{'id'});
! 326: next if (! scalar(keys(%tabledata))); # table does not exist
! 327: if ($table_modification_time < $tabledata{'Update_time'}) {
! 328: $table_modification_time = $tabledata{'Update_time'};
! 329: }
! 330: }
! 331: $logthis->("Table modification time = ".$table_modification_time);
! 332: if ($table_modification_time > $backup_modification_time) {
! 333: # Save the current tables in case we need them another time.
! 334: my $backup_name = $gz_sql_filename.'.'.time;
! 335: $logthis->('Backing existing tables up in '.$backup_name);
! 336: &backup_tables($backup_name);
! 337: }
! 338: $time_this->();
! 339: &load_backup_tables($gz_sql_filename);
! 340: $time_this->('load backup tables');
! 341: }
1.1 matthew 342: }
343:
1.3 matthew 344: ##
345: ## Ensure the tables we need exist
1.1 matthew 346: # create_tables does not complain if the tables already exist
1.3 matthew 347: $logthis->('creating tables');
1.1 matthew 348: if (! &create_tables()) {
349: warn "Unable to create tables";
1.2 matthew 350: $logthis->('Unable to create tables');
1.1 matthew 351: exit 4;
352: }
353:
1.3 matthew 354: ##
355: ## Read the ids used for various tables
1.2 matthew 356: $logthis->('reading id tables');
1.1 matthew 357: &read_id_tables();
1.2 matthew 358: $logthis->('finished reading id tables');
1.1 matthew 359:
360: ##
1.3 matthew 361: ## Set up the errors file
362: my $error_fh = IO::File->new(">>$error_filename");
363:
364: ##
365: ## Parse the course log
366: $logthis->('processing course log');
367: if (-s $newfilename) {
368: my $result = &process_courselog($newfilename,$error_fh);
1.1 matthew 369: if (! defined($result)) {
370: # Something went wrong along the way...
1.2 matthew 371: $logthis->('process_courselog returned undef');
1.1 matthew 372: exit 5;
373: } elsif ($result > 0) {
374: $time_this->();
1.7 matthew 375: $logthis->('process_courselog returned '.$result.' backing up tables');
1.6 matthew 376: &backup_tables($gz_sql_filename);
1.1 matthew 377: $time_this->('write backup tables');
378: }
379: }
1.3 matthew 380: close($error_fh);
1.1 matthew 381:
382: ##
383: ## Clean up the filesystem
384: &Apache::lonmysql::disconnect_from_db();
1.3 matthew 385: unlink($newfilename) if (-e $newfilename && ! $nocleanup);
1.1 matthew 386:
1.3 matthew 387: ##
388: ## Print timing data
389: $logthis->('printing timing data');
1.1 matthew 390: if ($time_run) {
1.2 matthew 391: my $elapsed_time = Time::HiRes::time - $initial_time;
392: print "Overall time: ".$elapsed_time.$/;
1.1 matthew 393: print &outputtimes();
1.2 matthew 394: $logthis->("Overall time: ".$elapsed_time);
395: $logthis->(&outputtimes());
396: }
397:
398: if ($log) {
399: close LOGFILE;
1.1 matthew 400: }
401:
402: exit 0; # Everything is okay, so end here before it gets worse.
403:
404: ########################################################
405: ########################################################
406: ##
407: ## Process Course Log
408: ##
409: ########################################################
410: ########################################################
411: #
412: # Returns the number of lines in the activity.log file that were processed.
413: sub process_courselog {
1.3 matthew 414: my ($inputfile,$error_fh) = @_;
1.1 matthew 415: if (! open(IN,$inputfile)) {
416: warn "Unable to open '$inputfile' for reading";
1.2 matthew 417: $logthis->("Unable to open '$inputfile' for reading");
1.1 matthew 418: return undef;
419: }
420: my ($linecount,$insertcount);
421: my $dbh = &Apache::lonmysql::get_dbh();
422: #
423: # Timing variables
424: my @RowData;
425: while (my $line=<IN>){
426: # last if ($linecount > 1000);
427: #
428: # Bulk storage variables
429: $time_this->();
430: chomp($line);
431: $linecount++;
432: # print $linecount++.$/;
433: my ($timestamp,$host,$log)=split(/\:/,$line,3);
434: $time_this->('splitline');
435: #
436: # $log has the actual log entries; currently still escaped, and
437: # %26(timestamp)%3a(url)%3a(user)%3a(domain)
438: # then additionally
439: # %3aPOST%3a(name)%3d(value)%3a(name)%3d(value)
440: # or
441: # %3aCSTORE%3a(name)%3d(value)%26(name)%3d(value)
442: #
443: # get delimiter between timestamped entries to be &&&
444: $log=~s/\%26(\d{9,10})\%3a/\&\&\&$1\%3a/g;
445: $log = &unescape($log);
446: $time_this->('translate_and_unescape');
447: # now go over all log entries
1.2 matthew 448: if (! defined($host)) { $host = 'unknown'; }
1.1 matthew 449: my $machine_id = &get_id($machine_table,'machine',$host);
1.2 matthew 450: my $prevchunk = 'none';
451: foreach my $chunk (split(/\&\&\&/,$log)) {
452: my $warningflag = '';
1.1 matthew 453: $time_this->();
1.2 matthew 454: my ($time,$res,$uname,$udom,$action,@values)= split(/:/,$chunk);
455: my $student = $uname.':'.$udom;
1.1 matthew 456: if (! defined($res) || $res =~ /^\s*$/) {
457: $res = '/adm/roles';
1.2 matthew 458: $action = 'LOGIN';
1.1 matthew 459: }
460: if ($res =~ m|^/prtspool/|) {
461: $res = '/prtspool/';
462: }
463: if (! defined($action) || $action eq '') {
1.2 matthew 464: $action = 'VIEW';
1.1 matthew 465: }
1.2 matthew 466: if ($action !~ /^(LOGIN|VIEW|POST|CSTORE|STORE)$/) {
467: $warningflag .= 'action';
1.3 matthew 468: print $error_fh 'full log entry:'.$log.$/;
469: print $error_fh 'error on chunk:'.$chunk.$/;
470: $logthis->('(action) Unable to parse '.$/.$chunk.$/.
471: 'got '.
472: 'time = '.$time.$/.
473: 'res = '.$res.$/.
474: 'uname= '.$uname.$/.
475: 'udom = '.$udom.$/.
476: 'action='.$action.$/.
477: '@values = '.join(':',@values));
478: next; #skip it if we cannot understand what is happening.
1.2 matthew 479: }
480: if (! defined($student) || $student eq ':') {
481: $student = 'unknown';
482: $warningflag .= 'student';
483: }
484: if (! defined($res) || $res =~ /^\s*$/) {
485: $res = 'unknown';
486: $warningflag .= 'res';
487: }
488: if (! defined($action) || $action =~ /^\s*$/) {
489: $action = 'unknown';
490: $warningflag .= 'action';
491: }
492: if (! defined($time) || $time !~ /^\d+$/) {
493: $time = 0;
494: $warningflag .= 'time';
495: }
496: #
1.1 matthew 497: $time_this->('split_and_error_check');
498: my $student_id = &get_id($student_table,'student',$student);
1.3 matthew 499: my $res_id = &get_id($res_table,'resource',$res);
1.4 matthew 500: # my $action_id = &get_id($action_table,'action',$action);
1.3 matthew 501: my $sql_time = &Apache::lonmysql::sqltime($time);
1.2 matthew 502: #
503: if (! defined($student_id) || $student_id eq '') {
504: $warningflag.='student_id';
505: }
506: if (! defined($res_id) || $res_id eq '') {
507: $warningflag.='res_id';
508: }
1.4 matthew 509: # if (! defined($action_id) || $action_id eq '') {
510: # $warningflag.='action_id';
511: # }
1.2 matthew 512: if ($warningflag ne '') {
1.3 matthew 513: print $error_fh 'full log entry:'.$log.$/;
514: print $error_fh 'error on chunk:'.$chunk.$/;
1.2 matthew 515: $logthis->('warningflag ('.$warningflag.') on chunk '.
516: $/.$chunk.$/.'prevchunk = '.$/.$prevchunk);
517: $prevchunk .= $chunk;
518: next; # skip this chunk
519: }
520: #
1.1 matthew 521: my $values = $dbh->quote(join('',@values));
522: $time_this->('get_ids');
523: #
524: my $row = [$res_id,
525: qq{'$sql_time'},
526: $student_id,
1.4 matthew 527: "'".$action."'",
528: # $action_id,
1.1 matthew 529: qq{''}, # idx
530: $machine_id,
531: $values];
532: push(@RowData,$row);
533: $time_this->('push_row');
1.2 matthew 534: $prevchunk = $chunk;
1.1 matthew 535: #
536: }
537: $time_this->();
1.2 matthew 538: if ((scalar(@RowData) > 0) && ($linecount % 100 == 0)) {
1.1 matthew 539: my $result = &Apache::lonmysql::bulk_store_rows($activity_table,
540: undef,
541: \@RowData);
1.2 matthew 542: # $logthis->('result = '.$result);
1.1 matthew 543: $time_this->('bulk_store_rows');
544: if (! defined($result)) {
1.2 matthew 545: my $error = &Apache::lonmysql::get_error();
546: warn "Error occured during insert.".$error;
547: $logthis->('error = '.$error);
1.1 matthew 548: }
549: undef(@RowData);
550: }
551: }
552: if (@RowData) {
553: $time_this->();
1.2 matthew 554: $logthis->('storing '.$linecount);
1.1 matthew 555: my $result = &Apache::lonmysql::bulk_store_rows($activity_table,
556: undef,
557: \@RowData);
1.2 matthew 558: $logthis->('result = '.$result);
1.1 matthew 559: $time_this->('bulk_store_rows');
560: if (! defined($result)) {
1.2 matthew 561: my $error = &Apache::lonmysql::get_error();
562: warn "Error occured during insert.".$error;
563: $logthis->('error = '.$error);
1.1 matthew 564: }
565: undef(@RowData);
566: }
567: close IN;
568: # print "Number of lines: ".$linecount.$/;
569: # print "Number of inserts: ".$insertcount.$/;
570: return $linecount;
571: }
572:
1.2 matthew 573:
574: ##
575: ## Somtimes, instead of doing something, doing nothing is appropriate.
576: sub nothing {
577: return;
578: }
579:
580: ##
581: ## Logging routine
582: ##
583: sub log_to_file {
584: my ($input)=@_;
585: print LOGFILE $input.$/;
586: }
587:
1.1 matthew 588: ##
589: ## Timing routines
590: ##
591: {
592: my %Timing;
593: my $starttime;
594:
595: sub time_action {
596: my ($key) = @_;
597: if (defined($key)) {
598: $Timing{$key}+=Time::HiRes::time-$starttime;
599: $Timing{'count_'.$key}++;
600: }
601: $starttime = Time::HiRes::time;
602: }
603:
604: sub outputtimes {
605: my $Str;
606: if ($time_run) {
607: $Str = "Timing Data:".$/;
608: while (my($k,$v) = each(%Timing)) {
609: next if ($k =~ /^count_/);
610: my $count = $Timing{'count_'.$k};
611: $Str .=
612: ' '.sprintf("%25.25s",$k).
613: ' '.sprintf('% 8d',$count).
614: ' '.sprintf('%12.5f',$v).$/;
615: }
616: }
617: return $Str;
618: }
619:
620: }
621:
622:
623: ##
624: ## Use mysqldump to store backups of the tables
625: ##
626: sub backup_tables {
1.6 matthew 627: my ($gz_sql_filename) = @_;
1.1 matthew 628: my $command = qq{mysqldump --opt loncapa };
629:
1.3 matthew 630: foreach my $table (@ID_Tables,@Activity_Table) {
1.1 matthew 631: my $tablename = $table->{'id'};
632: $command .= $tablename.' ';
633: }
1.6 matthew 634: $command .= '| gzip >'.$gz_sql_filename;
1.2 matthew 635: $logthis->($command);
1.1 matthew 636: system($command);
637: }
638:
639: ##
640: ## Load in mysqldumped files
641: ##
642: sub load_backup_tables {
1.6 matthew 643: my ($gz_sql_filename) = @_;
644: if (-s $gz_sql_filename) {
1.8 ! matthew 645: $logthis->('loading data from gzipped sql file');
! 646: my $command='gzip -dc '.$gz_sql_filename.' | mysql --database=loncapa';
1.6 matthew 647: system($command);
648: $logthis->('finished loading gzipped data');;
649: } else {
650: return undef;
651: }
1.1 matthew 652: }
653:
654: ##
655: ##
656: ##
657: sub update_process_name {
658: my ($text) = @_;
659: $0 = 'parse_activity_log.pl: '.$text;
660: }
661:
662: sub get_filename {
663: my ($course,$domain) = @_;
664: my ($a,$b,$c,undef) = split('',$course,4);
665: return "$perlvar{'lonUsersDir'}/$domain/$a/$b/$c/$course/activity.log";
666: }
667:
668: sub create_tables {
1.3 matthew 669: foreach my $table (@ID_Tables,@Activity_Table) {
1.1 matthew 670: my $table_id = &Apache::lonmysql::create_table($table);
1.4 matthew 671: # print STDERR "Unable to create table ".$table->{'id'}.$/;
672: # print STDERR join($/,&Apache::lonmysql::build_table_creation_request($table)).$/;
1.1 matthew 673: if (! defined($table_id)) {
674: warn "Unable to create table ".$table->{'id'}.$/;
1.4 matthew 675: warn join($/,&Apache::lonmysql::build_table_creation_request($table)).$/;
1.1 matthew 676: return 0;
677: }
678: }
679: return 1;
680: }
681:
682: sub drop_tables {
1.3 matthew 683: foreach my $table (@ID_Tables,@Activity_Table) {
1.1 matthew 684: my $table_id = $table->{'id'};
685: &Apache::lonmysql::drop_table($table_id);
686: }
687: }
688:
689: #################################################################
690: #################################################################
691: ##
692: ## Database item id code
693: ##
694: #################################################################
695: #################################################################
696: { # Scoping for ID lookup code
697: my %IDs;
698:
699: sub read_id_tables {
1.3 matthew 700: foreach my $table (@ID_Tables) {
1.1 matthew 701: my @Data = &Apache::lonmysql::get_rows($table->{'id'});
1.3 matthew 702: my $count = 0;
1.1 matthew 703: foreach my $row (@Data) {
704: $IDs{$table->{'id'}}->{$row->[1]} = $row->[0];
705: }
706: }
1.3 matthew 707: return;
1.1 matthew 708: }
709:
710: sub get_id {
711: my ($table,$fieldname,$value) = @_;
712: if (exists($IDs{$table}->{$value})) {
713: return $IDs{$table}->{$value};
714: } else {
715: # insert into the table - if the item already exists, that is
716: # okay.
717: my $result = &Apache::lonmysql::store_row($table,[undef,$value]);
718: if (! defined($result)) {
719: warn("Got error on id insert for $value\n".&Apache::lonmysql::get_error());
720: }
721: # get the id
722: my @Data =
723: &Apache::lonmysql::get_rows($table,qq{$fieldname='$value'});
724: if (@Data) {
725: $IDs{$table}->{$value}=$Data[0]->[0];
726: return $IDs{$table}->{$value};
727: } else {
1.2 matthew 728: $logthis->("Unable to retrieve id for $table $fieldname $value");
1.1 matthew 729: return undef;
730: }
731: }
732: }
733:
734: } # End of ID scoping
735:
736:
737: ###############################################################
738: ###############################################################
739: ##
740: ## The usual suspects
741: ##
742: ###############################################################
743: ###############################################################
744: sub escape {
745: my $str=shift;
746: $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
747: return $str;
748: }
749:
750: sub unescape {
751: my $str=shift;
752: $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
753: return $str;
754: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>