File:  [LON-CAPA] / loncom / metadata_database / parse_activity_log.pl
Revision 1.6: download - view: text, annotated - select for diffs
Thu Dec 16 15:03:29 2004 UTC (19 years, 6 months ago) by matthew
Branches: MAIN
CVS tags: HEAD
Gzip activity log backup files.

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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>