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