File:  [LON-CAPA] / loncom / metadata_database / parse_activity_log.pl
Revision 1.4: download - view: text, annotated - select for diffs
Wed Aug 25 15:55:17 2004 UTC (19 years, 9 months ago) by matthew
Branches: MAIN
CVS tags: HEAD
Removed $action_table as MySQL really did not like doing joins with it.
logfile now appears in the lonDaemons directory.  Added indicies to
the activity table on the student_id and time columns.

    1: #!/usr/bin/perl
    2: #
    3: # The LearningOnline Network
    4: #
    5: # $Id: parse_activity_log.pl,v 1.4 2004/08/25 15:55:17 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     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();
   46: use IO::File;
   47: 
   48: #
   49: # Determine parameters
   50: my ($help,$course,$domain,$drop,$file,$time_run,$nocleanup,$log);
   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,
   57:                            "drop"      => \$drop,
   58:                            "log"       => \$log);
   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
   72:    log                optional   if present, prepare log file of activity
   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 = \&nothing;
   83: if ($time_run) {
   84:     $time_this = \&time_action;
   85: }
   86: my $initial_time = Time::HiRes::time;
   87: 
   88: ##
   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: ##
   99: ## Set up logging code
  100: my $logthis = \&nothing;
  101: if ($log) {
  102:     my $logfile = $perlvar{'lonDaemons'}.'/tmp/parse_activity_log.log.'.time;
  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: }
  110: 
  111: 
  112: ##
  113: ## Determine filenames
  114: ##
  115: my $sourcefilename;   # activity log data
  116: my $newfilename;      # $sourcefilename will be renamed to this
  117: my $sql_filename;     # the mysql backup data file name.
  118: my $error_filename;   # Errors in parsing the activity log will be written here
  119: if ($file) {
  120:     $sourcefilename = $file;
  121: } else {
  122:     $sourcefilename = &get_filename($course,$domain);
  123: }
  124: $sql_filename = $sourcefilename;
  125: $sql_filename =~ s|[^/]*$|activity.log.sql|;
  126: $error_filename = $sourcefilename;
  127: $error_filename =~ s|[^/]*$|activity.log.errors|;
  128: $logthis->('Beginning logging '.time);
  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";
  136:     $logthis->($newfilename.' exists');
  137:     exit 2;
  138: }
  139: 
  140: if (-e $sourcefilename) {
  141:     $logthis->('renaming '.$sourcefilename.' to '.$newfilename);
  142:     rename($sourcefilename,$newfilename);
  143:     $logthis->("renamed $sourcefilename to $newfilename");
  144: } else {
  145:     my $command = 'touch '.$newfilename;
  146:     $logthis->($command);
  147:     system($command);
  148:     $logthis->('touch was completed');
  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: 
  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: #};
  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',
  228:                 type => 'MEDIUMINT UNSIGNED',
  229:                 restrictions => 'NOT NULL',},
  230:               { name => 'action',
  231:                 type => 'VARCHAR(10)',
  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',
  238:                 type => 'MEDIUMINT UNSIGNED',
  239:                 restrictions => 'NOT NULL',},
  240:               { name => 'action_values',
  241:                 type => 'MEDIUMTEXT', },
  242:               ], 
  243:       'PRIMARY KEY' => ['time','student_id','res_id','idx'],
  244:       'KEY' => [{columns => ['student_id']},
  245:                 {columns => ['time']},],
  246: };
  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:                       
  254: 
  255: ##
  256: ## End of table definitions
  257: ##
  258: 
  259: # 
  260: $logthis->('Connectiong to mysql');
  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.";
  265:     $logthis->("Unable to connect to MySQL database.");
  266:     exit 3;
  267: }
  268: 
  269: $logthis->('SQL connection is up');
  270: 
  271: if ($drop) { &drop_tables(); $logthis->('dropped tables'); }
  272: 
  273: if (-s $sql_filename) {
  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) {
  279:         foreach my $table (@Activity_Table,@ID_Tables) {
  280:             if ($tablename eq  $table->{'id'}) {
  281:                 $Found{$tablename}++;
  282:             }
  283:         }
  284:     }
  285:     foreach my $table (@Activity_Table,@ID_Tables) {    
  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: 
  295: ##
  296: ## Ensure the tables we need exist
  297: # create_tables does not complain if the tables already exist
  298: $logthis->('creating tables');
  299: if (! &create_tables()) {
  300:     warn "Unable to create tables";
  301:     $logthis->('Unable to create tables');
  302:     exit 4;
  303: }
  304: 
  305: ##
  306: ## Read the ids used for various tables
  307: $logthis->('reading id tables');
  308: &read_id_tables();
  309: $logthis->('finished reading id tables');
  310: 
  311: ##
  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);
  320:     if (! defined($result)) {
  321:         # Something went wrong along the way...
  322:         $logthis->('process_courselog returned undef');
  323:         exit 5;
  324:     } elsif ($result > 0) {
  325:         $time_this->();
  326:         $logthis->('process_courselog returned '.$result.' backup up tables');
  327:         &backup_tables($sql_filename);
  328:         $time_this->('write backup tables');
  329:     }
  330: }
  331: close($error_fh);
  332: 
  333: ##
  334: ## Clean up the filesystem
  335: &Apache::lonmysql::disconnect_from_db();
  336: unlink($newfilename) if (-e $newfilename && ! $nocleanup);
  337: 
  338: ##
  339: ## Print timing data
  340: $logthis->('printing timing data');
  341: if ($time_run) {
  342:     my $elapsed_time = Time::HiRes::time - $initial_time;
  343:     print "Overall time: ".$elapsed_time.$/;
  344:     print &outputtimes();
  345:     $logthis->("Overall time: ".$elapsed_time);
  346:     $logthis->(&outputtimes());
  347: }
  348: 
  349: if ($log) {
  350:     close LOGFILE;
  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 {
  365:     my ($inputfile,$error_fh) = @_;
  366:     if (! open(IN,$inputfile)) {
  367:         warn "Unable to open '$inputfile' for reading";
  368:         $logthis->("Unable to open '$inputfile' for reading");
  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 
  399:         if (! defined($host)) { $host = 'unknown'; }
  400:         my $machine_id = &get_id($machine_table,'machine',$host);
  401:         my $prevchunk = 'none';
  402:         foreach my $chunk (split(/\&\&\&/,$log)) {
  403:             my $warningflag = '';
  404:             $time_this->();
  405: 	    my ($time,$res,$uname,$udom,$action,@values)= split(/:/,$chunk);
  406:             my $student = $uname.':'.$udom;
  407:             if (! defined($res) || $res =~ /^\s*$/) {
  408:                 $res = '/adm/roles';
  409:                 $action = 'LOGIN';
  410:             }
  411:             if ($res =~ m|^/prtspool/|) {
  412:                 $res = '/prtspool/';
  413:             }
  414:             if (! defined($action) || $action eq '') {
  415:                 $action = 'VIEW';
  416:             }
  417:             if ($action !~ /^(LOGIN|VIEW|POST|CSTORE|STORE)$/) {
  418:                 $warningflag .= 'action';
  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.
  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:             #
  448:             $time_this->('split_and_error_check');
  449:             my $student_id = &get_id($student_table,'student',$student);
  450:             my $res_id     = &get_id($res_table,'resource',$res);
  451: #            my $action_id  = &get_id($action_table,'action',$action);
  452:             my $sql_time   = &Apache::lonmysql::sqltime($time);
  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:             }
  460: #            if (! defined($action_id) || $action_id eq '') { 
  461: #                $warningflag.='action_id'; 
  462: #            }
  463:             if ($warningflag ne '') {
  464:                 print $error_fh 'full log entry:'.$log.$/;
  465:                 print $error_fh 'error on chunk:'.$chunk.$/;
  466:                 $logthis->('warningflag ('.$warningflag.') on chunk '.
  467:                            $/.$chunk.$/.'prevchunk = '.$/.$prevchunk);
  468:                 $prevchunk .= $chunk;
  469:                 next; # skip this chunk
  470:             }
  471:             #
  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,
  478:                        "'".$action."'",
  479: #                       $action_id,
  480:                        qq{''},        # idx
  481:                        $machine_id,
  482:                        $values];
  483:             push(@RowData,$row);
  484:             $time_this->('push_row');
  485:             $prevchunk = $chunk;
  486:             #
  487:         }
  488:         $time_this->();
  489:         if ((scalar(@RowData) > 0) && ($linecount % 100 == 0)) {
  490:             my $result = &Apache::lonmysql::bulk_store_rows($activity_table,
  491:                                                             undef,
  492:                                                             \@RowData);
  493:             # $logthis->('result = '.$result);
  494:             $time_this->('bulk_store_rows');
  495:             if (! defined($result)) {
  496:                 my $error = &Apache::lonmysql::get_error();
  497:                 warn "Error occured during insert.".$error;
  498:                 $logthis->('error = '.$error);
  499:             }
  500:             undef(@RowData);
  501:         }
  502:     }
  503:     if (@RowData) {
  504:         $time_this->();
  505:         $logthis->('storing '.$linecount);
  506:         my $result = &Apache::lonmysql::bulk_store_rows($activity_table,
  507:                                                         undef,
  508:                                                         \@RowData);
  509:         $logthis->('result = '.$result);
  510:         $time_this->('bulk_store_rows');
  511:         if (! defined($result)) {
  512:             my $error = &Apache::lonmysql::get_error();
  513:             warn "Error occured during insert.".$error;
  514:             $logthis->('error = '.$error);
  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: 
  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: 
  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:                              
  581:     foreach my $table (@ID_Tables,@Activity_Table) {
  582:         my $tablename = $table->{'id'};
  583:         $command .= $tablename.' ';
  584:     }
  585:     $command .= '>'.$sql_filename;
  586:     $logthis->($command);
  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';
  598:     $logthis->('loading previously saved sql table'.$/.$command);
  599:     system($command);
  600:     $logthis->('finished loading old data');
  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 {
  626:     foreach my $table (@ID_Tables,@Activity_Table) {
  627:         my $table_id = &Apache::lonmysql::create_table($table);
  628: #        print STDERR "Unable to create table ".$table->{'id'}.$/;
  629: #        print STDERR join($/,&Apache::lonmysql::build_table_creation_request($table)).$/;
  630:         if (! defined($table_id)) {
  631:             warn "Unable to create table ".$table->{'id'}.$/;
  632:             warn join($/,&Apache::lonmysql::build_table_creation_request($table)).$/;
  633:             return 0;
  634:         }
  635:     }
  636:     return 1;
  637: }
  638: 
  639: sub drop_tables {
  640:     foreach my $table (@ID_Tables,@Activity_Table) {
  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 {
  657:     foreach my $table (@ID_Tables) {
  658:         my @Data = &Apache::lonmysql::get_rows($table->{'id'});
  659:         my $count = 0;
  660:         foreach my $row (@Data) {
  661:             $IDs{$table->{'id'}}->{$row->[1]} = $row->[0];
  662:         }
  663:     }
  664:     return;
  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 {
  685:             $logthis->("Unable to retrieve id for $table $fieldname $value");
  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>