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