File:  [LON-CAPA] / loncom / metadata_database / parse_activity_log.pl
Revision 1.5: download - view: text, annotated - select for diffs
Wed Sep 15 21:11:06 2004 UTC (19 years, 8 months ago) by matthew
Branches: MAIN
CVS tags: version_1_2_99_1, version_1_2_99_0, HEAD
Added option to make a backup of the activity.log.

    1: #!/usr/bin/perl
    2: #
    3: # The LearningOnline Network
    4: #
    5: # $Id: parse_activity_log.pl,v 1.5 2004/09/15 21:11:06 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: use File::Copy;
   48: #
   49: # Determine parameters
   50: my ($help,$course,$domain,$drop,$file,$time_run,$nocleanup,$log,$backup);
   51: &Getopt::Long::GetOptions( "course=s"  => \$course,
   52:                            "domain=s"  => \$domain,
   53:                            "backup"    => \$backup,
   54:                            "help"      => \$help,
   55:                            "logfile=s" => \$file,
   56:                            "timerun"   => \$time_run,
   57:                            "nocleanup" => \$nocleanup,
   58:                            "drop"      => \$drop,
   59:                            "log"       => \$log);
   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
   68:    backup             optional   if present, backup the activity log file
   69:                                  before processing it
   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
   75:    log                optional   if present, prepare log file of activity
   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 = \&nothing;
   86: if ($time_run) {
   87:     $time_this = \&time_action;
   88: }
   89: my $initial_time = Time::HiRes::time;
   90: 
   91: ##
   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: ##
  102: ## Set up logging code
  103: my $logthis = \&nothing;
  104: if ($log) {
  105:     my $logfile = $perlvar{'lonDaemons'}.'/tmp/parse_activity_log.log.'.time;
  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: }
  113: 
  114: 
  115: ##
  116: ## Determine filenames
  117: ##
  118: my $sourcefilename;   # activity log data
  119: my $newfilename;      # $sourcefilename will be renamed to this
  120: my $sql_filename;     # the mysql backup data file name.
  121: my $error_filename;   # Errors in parsing the activity log will be written here
  122: if ($file) {
  123:     $sourcefilename = $file;
  124: } else {
  125:     $sourcefilename = &get_filename($course,$domain);
  126: }
  127: $sql_filename = $sourcefilename;
  128: $sql_filename =~ s|[^/]*$|activity.log.sql|;
  129: $error_filename = $sourcefilename;
  130: $error_filename =~ s|[^/]*$|activity.log.errors|;
  131: $logthis->('Beginning logging '.time);
  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";
  139:     $logthis->($newfilename.' exists');
  140:     exit 2;
  141: }
  142: 
  143: if (-e $sourcefilename) {
  144:     $logthis->('renaming '.$sourcefilename.' to '.$newfilename);
  145:     rename($sourcefilename,$newfilename);
  146:     Copy($newfilename,$newfilename.'.'.time) if ($backup);
  147:     $logthis->("renamed $sourcefilename to $newfilename");
  148: } else {
  149:     my $command = 'touch '.$newfilename;
  150:     $logthis->($command);
  151:     system($command);
  152:     $logthis->('touch was completed');
  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: 
  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: #};
  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',
  232:                 type => 'MEDIUMINT UNSIGNED',
  233:                 restrictions => 'NOT NULL',},
  234:               { name => 'action',
  235:                 type => 'VARCHAR(10)',
  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',
  242:                 type => 'MEDIUMINT UNSIGNED',
  243:                 restrictions => 'NOT NULL',},
  244:               { name => 'action_values',
  245:                 type => 'MEDIUMTEXT', },
  246:               ], 
  247:       'PRIMARY KEY' => ['time','student_id','res_id','idx'],
  248:       'KEY' => [{columns => ['student_id']},
  249:                 {columns => ['time']},],
  250: };
  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:                       
  258: 
  259: ##
  260: ## End of table definitions
  261: ##
  262: 
  263: # 
  264: $logthis->('Connectiong to mysql');
  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.";
  269:     $logthis->("Unable to connect to MySQL database.");
  270:     exit 3;
  271: }
  272: 
  273: $logthis->('SQL connection is up');
  274: 
  275: if ($drop) { &drop_tables(); $logthis->('dropped tables'); }
  276: 
  277: if (-s $sql_filename) {
  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) {
  283:         foreach my $table (@Activity_Table,@ID_Tables) {
  284:             if ($tablename eq  $table->{'id'}) {
  285:                 $Found{$tablename}++;
  286:             }
  287:         }
  288:     }
  289:     foreach my $table (@Activity_Table,@ID_Tables) {    
  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: 
  299: ##
  300: ## Ensure the tables we need exist
  301: # create_tables does not complain if the tables already exist
  302: $logthis->('creating tables');
  303: if (! &create_tables()) {
  304:     warn "Unable to create tables";
  305:     $logthis->('Unable to create tables');
  306:     exit 4;
  307: }
  308: 
  309: ##
  310: ## Read the ids used for various tables
  311: $logthis->('reading id tables');
  312: &read_id_tables();
  313: $logthis->('finished reading id tables');
  314: 
  315: ##
  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);
  324:     if (! defined($result)) {
  325:         # Something went wrong along the way...
  326:         $logthis->('process_courselog returned undef');
  327:         exit 5;
  328:     } elsif ($result > 0) {
  329:         $time_this->();
  330:         $logthis->('process_courselog returned '.$result.' backup up tables');
  331:         &backup_tables($sql_filename);
  332:         $time_this->('write backup tables');
  333:     }
  334: }
  335: close($error_fh);
  336: 
  337: ##
  338: ## Clean up the filesystem
  339: &Apache::lonmysql::disconnect_from_db();
  340: unlink($newfilename) if (-e $newfilename && ! $nocleanup);
  341: 
  342: ##
  343: ## Print timing data
  344: $logthis->('printing timing data');
  345: if ($time_run) {
  346:     my $elapsed_time = Time::HiRes::time - $initial_time;
  347:     print "Overall time: ".$elapsed_time.$/;
  348:     print &outputtimes();
  349:     $logthis->("Overall time: ".$elapsed_time);
  350:     $logthis->(&outputtimes());
  351: }
  352: 
  353: if ($log) {
  354:     close LOGFILE;
  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 {
  369:     my ($inputfile,$error_fh) = @_;
  370:     if (! open(IN,$inputfile)) {
  371:         warn "Unable to open '$inputfile' for reading";
  372:         $logthis->("Unable to open '$inputfile' for reading");
  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 
  403:         if (! defined($host)) { $host = 'unknown'; }
  404:         my $machine_id = &get_id($machine_table,'machine',$host);
  405:         my $prevchunk = 'none';
  406:         foreach my $chunk (split(/\&\&\&/,$log)) {
  407:             my $warningflag = '';
  408:             $time_this->();
  409: 	    my ($time,$res,$uname,$udom,$action,@values)= split(/:/,$chunk);
  410:             my $student = $uname.':'.$udom;
  411:             if (! defined($res) || $res =~ /^\s*$/) {
  412:                 $res = '/adm/roles';
  413:                 $action = 'LOGIN';
  414:             }
  415:             if ($res =~ m|^/prtspool/|) {
  416:                 $res = '/prtspool/';
  417:             }
  418:             if (! defined($action) || $action eq '') {
  419:                 $action = 'VIEW';
  420:             }
  421:             if ($action !~ /^(LOGIN|VIEW|POST|CSTORE|STORE)$/) {
  422:                 $warningflag .= 'action';
  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.
  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:             #
  452:             $time_this->('split_and_error_check');
  453:             my $student_id = &get_id($student_table,'student',$student);
  454:             my $res_id     = &get_id($res_table,'resource',$res);
  455: #            my $action_id  = &get_id($action_table,'action',$action);
  456:             my $sql_time   = &Apache::lonmysql::sqltime($time);
  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:             }
  464: #            if (! defined($action_id) || $action_id eq '') { 
  465: #                $warningflag.='action_id'; 
  466: #            }
  467:             if ($warningflag ne '') {
  468:                 print $error_fh 'full log entry:'.$log.$/;
  469:                 print $error_fh 'error on chunk:'.$chunk.$/;
  470:                 $logthis->('warningflag ('.$warningflag.') on chunk '.
  471:                            $/.$chunk.$/.'prevchunk = '.$/.$prevchunk);
  472:                 $prevchunk .= $chunk;
  473:                 next; # skip this chunk
  474:             }
  475:             #
  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,
  482:                        "'".$action."'",
  483: #                       $action_id,
  484:                        qq{''},        # idx
  485:                        $machine_id,
  486:                        $values];
  487:             push(@RowData,$row);
  488:             $time_this->('push_row');
  489:             $prevchunk = $chunk;
  490:             #
  491:         }
  492:         $time_this->();
  493:         if ((scalar(@RowData) > 0) && ($linecount % 100 == 0)) {
  494:             my $result = &Apache::lonmysql::bulk_store_rows($activity_table,
  495:                                                             undef,
  496:                                                             \@RowData);
  497:             # $logthis->('result = '.$result);
  498:             $time_this->('bulk_store_rows');
  499:             if (! defined($result)) {
  500:                 my $error = &Apache::lonmysql::get_error();
  501:                 warn "Error occured during insert.".$error;
  502:                 $logthis->('error = '.$error);
  503:             }
  504:             undef(@RowData);
  505:         }
  506:     }
  507:     if (@RowData) {
  508:         $time_this->();
  509:         $logthis->('storing '.$linecount);
  510:         my $result = &Apache::lonmysql::bulk_store_rows($activity_table,
  511:                                                         undef,
  512:                                                         \@RowData);
  513:         $logthis->('result = '.$result);
  514:         $time_this->('bulk_store_rows');
  515:         if (! defined($result)) {
  516:             my $error = &Apache::lonmysql::get_error();
  517:             warn "Error occured during insert.".$error;
  518:             $logthis->('error = '.$error);
  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: 
  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: 
  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:                              
  585:     foreach my $table (@ID_Tables,@Activity_Table) {
  586:         my $tablename = $table->{'id'};
  587:         $command .= $tablename.' ';
  588:     }
  589:     $command .= '>'.$sql_filename;
  590:     $logthis->($command);
  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';
  602:     $logthis->('loading previously saved sql table'.$/.$command);
  603:     system($command);
  604:     $logthis->('finished loading old data');
  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 {
  630:     foreach my $table (@ID_Tables,@Activity_Table) {
  631:         my $table_id = &Apache::lonmysql::create_table($table);
  632: #        print STDERR "Unable to create table ".$table->{'id'}.$/;
  633: #        print STDERR join($/,&Apache::lonmysql::build_table_creation_request($table)).$/;
  634:         if (! defined($table_id)) {
  635:             warn "Unable to create table ".$table->{'id'}.$/;
  636:             warn join($/,&Apache::lonmysql::build_table_creation_request($table)).$/;
  637:             return 0;
  638:         }
  639:     }
  640:     return 1;
  641: }
  642: 
  643: sub drop_tables {
  644:     foreach my $table (@ID_Tables,@Activity_Table) {
  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 {
  661:     foreach my $table (@ID_Tables) {
  662:         my @Data = &Apache::lonmysql::get_rows($table->{'id'});
  663:         my $count = 0;
  664:         foreach my $row (@Data) {
  665:             $IDs{$table->{'id'}}->{$row->[1]} = $row->[0];
  666:         }
  667:     }
  668:     return;
  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 {
  689:             $logthis->("Unable to retrieve id for $table $fieldname $value");
  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>