File:  [LON-CAPA] / loncom / metadata_database / parse_activity_log.pl
Revision 1.24: download - view: text, annotated - select for diffs
Sat Apr 8 07:10:10 2006 UTC (18 years ago) by albertel
Branches: MAIN
CVS tags: version_2_9_X, version_2_9_99_0, version_2_9_1, version_2_9_0, version_2_8_X, version_2_8_99_1, version_2_8_99_0, version_2_8_2, version_2_8_1, version_2_8_0, version_2_7_X, version_2_7_99_1, version_2_7_99_0, version_2_7_1, version_2_7_0, version_2_6_X, version_2_6_99_1, version_2_6_99_0, version_2_6_3, version_2_6_2, version_2_6_1, version_2_6_0, version_2_5_X, version_2_5_99_1, version_2_5_99_0, version_2_5_2, version_2_5_1, version_2_5_0, version_2_4_X, version_2_4_99_0, version_2_4_2, version_2_4_1, version_2_4_0, version_2_3_X, version_2_3_99_0, version_2_3_2, version_2_3_1, version_2_3_0, version_2_2_X, version_2_2_99_1, version_2_2_99_0, version_2_2_2, version_2_2_1, version_2_2_0, version_2_1_99_3, version_2_1_99_2, version_2_1_99_1, version_2_1_99_0, version_2_11_0_RC3, version_2_11_0_RC2, version_2_11_0_RC1, version_2_11_0, version_2_10_X, version_2_10_1, version_2_10_0_RC2, version_2_10_0_RC1, version_2_10_0, loncapaMITrelate_1, language_hyphenation_merge, language_hyphenation, bz6209-base, bz6209, bz5969, bz2851, PRINT_INCOMPLETE_base, PRINT_INCOMPLETE, HEAD, GCI_3, GCI_2, GCI_1, BZ5971-printing-apage, BZ5434-fox, BZ4492-merge, BZ4492-feature_horizontal_radioresponse
-removing non-functional use Apache2::compat
- removing extraneous uses

    1: #!/usr/bin/perl
    2: #
    3: # The LearningOnline Network
    4: #
    5: # $Id: parse_activity_log.pl,v 1.24 2006/04/08 07:10:10 albertel 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     Unable to open log file
   38: #   6     Unable to get lock on activity log
   39: #
   40: 
   41: #
   42: # Notes:
   43: #
   44: # Logging is done via the $logthis variable, which may be the result of 
   45: # overcleverness.  log via $logthis->('logtext');  Those are parentheses,
   46: # not curly braces.  If the -log command line parameter is set, the $logthis
   47: # routine is set to a routine which writes to a file.  If the command line
   48: # parameter is not set $logthis is set to &nothing, which does what you
   49: # would expect.
   50: #
   51: use strict;
   52: use DBI;
   53: use lib '/home/httpd/lib/perl/';
   54: use LONCAPA::Configuration();
   55: use Apache::lonmysql();
   56: use Time::HiRes();
   57: use Getopt::Long();
   58: use IO::File;
   59: use File::Copy;
   60: use Fcntl qw(:flock);
   61: use HTML::TokeParser;
   62: 
   63: #
   64: # Determine parameters
   65: my ($help,$course,$domain,$drop_when_done,$srcfile,$logfile,$time_run,$nocleanup,$log,$backup,$xmlfile);
   66: &Getopt::Long::GetOptions( "course=s"  => \$course,
   67:                            "domain=s"  => \$domain,
   68:                            "backup"    => \$backup,
   69:                            "help"      => \$help,
   70:                            "logfile=s" => \$logfile,
   71:                            "srcfile=s" => \$srcfile,
   72:                            "justloadxml=s" => \$xmlfile,
   73:                            "timerun"   => \$time_run,
   74:                            "nocleanup" => \$nocleanup,
   75:                            "dropwhendone" => \$drop_when_done,
   76:                            "log"       => \$log);
   77: if (! defined($course) || $help) {
   78:     print<<USAGE;
   79: parse_activity_log.pl
   80: 
   81: Process a lon-capa activity log into a database.
   82: Parameters:
   83:    course             Required
   84:    domain             optional
   85:    backup             optional   if present, backup the activity log file
   86:                                  before processing it
   87:    dropwhendone       optional   if present, drop all course 
   88:                                  specific activity log tables after processing.
   89:    srcfile            optional   Specify the file to parse, including path
   90:    time               optional   if present, print out timing data
   91:    nocleanup          optional   if present, do not remove old files
   92:    log                optional   if present, prepare log file of activity
   93:    logfile            optional   specifies the logfile to use
   94: Examples:
   95:   $0 -course=123456abcdef -domain=msu
   96:   $0 -course=123456abcdef -srcfile=activity.log
   97:   $0 -course-123456abcdef -log -logfile=/tmp/logfile -dropwhendone
   98: USAGE
   99:     exit;
  100: }
  101: 
  102: ##
  103: ## Set up timing code
  104: my $time_this = \&nothing;
  105: if ($time_run) {
  106:     $time_this = \&time_action;
  107: }
  108: my $initial_time = Time::HiRes::time;
  109: 
  110: ##
  111: ## Read in configuration parameters
  112: ##
  113: my %perlvar = %{&LONCAPA::Configuration::read_conf('loncapa.conf')};
  114: 
  115: if (! defined($domain) || $domain eq '') {
  116:     $domain = $perlvar{'lonDefDomain'};
  117: }
  118: &update_process_name($course.'@'.$domain);
  119: 
  120: ##
  121: ## Set up logging code
  122: my $logthis = \&nothing;
  123: 
  124: if ($log) {
  125:     if (! $logfile) {
  126:         $logfile = $perlvar{'lonDaemons'}.'/tmp/parse_activity_log.log.'.time;
  127:     }
  128:     print STDERR "$0: logging to $logfile".$/;
  129:     if (! open(LOGFILE,">$logfile")) {
  130:         warn("Unable to open $logfile for writing.  Run aborted.");
  131:         &clean_up_and_exit(5);
  132:     } else {
  133:         $logthis = \&log_to_file;
  134:     }
  135: }
  136: 
  137: 
  138: ##
  139: ## Determine filenames
  140: ##
  141: my $sourcefilename;   # activity log data
  142: my $newfilename;      # $sourcefilename will be renamed to this
  143: my $error_filename;   # Errors in parsing the activity log will be written here
  144: my $chunk_filename;   # where we save data we are not going to write to db
  145: if ($srcfile) {
  146:     $sourcefilename = $srcfile;
  147: } else {
  148:     $sourcefilename = &get_filename($course,$domain);
  149: }
  150: my $sql_filename = $sourcefilename;
  151: $sql_filename =~ s|[^/]*$|activity.log.sql|;
  152: my $gz_sql_filename = $sql_filename.'.gz';
  153: #
  154: $chunk_filename = $sourcefilename.".unprocessed_chunks";
  155: #
  156: my $xml_filename = $sourcefilename;
  157: my $gz_xml_filename = $xml_filename.'.gz';
  158: if (defined($xmlfile)) {
  159:     $xml_filename = $xmlfile;
  160:     if ($xml_filename =~ /\.gz$/) {
  161:         $gz_xml_filename = $xml_filename;
  162:     } else {
  163:         $gz_xml_filename = $xml_filename.'.gz';
  164:     }
  165: } else {
  166:     my $xml_filename = $sourcefilename;
  167:     $xml_filename =~ s|[^/]*$|activity.log.xml|;
  168:     $gz_xml_filename = $xml_filename.'.gz';
  169: }
  170: #
  171: $error_filename = $sourcefilename;
  172: $error_filename =~ s|[^/]*$|activity.log.errors|;
  173: $logthis->('Beginning logging '.time);
  174: 
  175: #
  176: # Wait for a lock on the lockfile to avoid collisions
  177: my $lockfilename = $sourcefilename.'.lock';
  178: $newfilename = $sourcefilename.'.processing';
  179: if (! defined($xmlfile)) {
  180:     open(LOCKFILE,'>'.$lockfilename);
  181:     if (!flock(LOCKFILE,LOCK_EX|LOCK_NB)) {
  182:         warn("Unable to lock $lockfilename.  Aborting".$/);
  183:         # don't call clean_up_and_exit another instance is running and
  184:         # we don't want to 'cleanup' their files
  185:         exit 6;
  186:     }
  187: 
  188:     if (! -e $newfilename && -e $sourcefilename) {
  189:         $logthis->('renaming '.$sourcefilename.' to '.$newfilename);
  190:         rename($sourcefilename,$newfilename);
  191:         Copy($newfilename,$newfilename.'.'.time) if ($backup);
  192:         $logthis->("renamed $sourcefilename to $newfilename");
  193:     } elsif (! -e $newfilename) {
  194:         utime(undef,undef,$newfilename);
  195:     }
  196: }
  197: 
  198: ##
  199: ## Table definitions
  200: ##
  201: my %tables = &table_names($course,$domain);
  202: my $student_table_def = 
  203: { id => $tables{'student'},
  204:   permanent => 'no',
  205:   columns => [
  206:               { name => 'student_id',
  207:                 type => 'MEDIUMINT UNSIGNED',
  208:                 restrictions => 'NOT NULL',
  209:                 auto_inc => 'yes', },
  210:               { name => 'student',
  211:                 type => 'VARCHAR(100) BINARY',
  212:                 restrictions => 'NOT NULL', },
  213:               ],
  214:       'PRIMARY KEY' => ['student_id',],
  215:           };
  216: 
  217: my $res_table_def = 
  218: { id => $tables{'res'},
  219:   permanent => 'no',
  220:   columns => [{ name => 'res_id',
  221:                 type => 'MEDIUMINT UNSIGNED',
  222:                 restrictions => 'NOT NULL',
  223:                 auto_inc     => 'yes', },
  224:               { name => 'resource',
  225:                 type => 'MEDIUMTEXT',
  226:                 restrictions => 'NOT NULL'},
  227:               ],
  228:   'PRIMARY KEY' => ['res_id'],
  229: };
  230: 
  231: #my $action_table_def =
  232: #{ id => $action_table,
  233: #  permanent => 'no',
  234: #  columns => [{ name => 'action_id',
  235: #                type => 'MEDIUMINT UNSIGNED',
  236: #                restrictions => 'NOT NULL',
  237: #                auto_inc     => 'yes', },
  238: #              { name => 'action',
  239: #                type => 'VARCHAR(100)',
  240: #                restrictions => 'NOT NULL'},
  241: #              ],
  242: #  'PRIMARY KEY' => ['action_id',], 
  243: #};
  244: 
  245: my $machine_table_def =
  246: { id => $tables{'machine'},
  247:   permanent => 'no',
  248:   columns => [{ name => 'machine_id',
  249:                 type => 'MEDIUMINT UNSIGNED',
  250:                 restrictions => 'NOT NULL',
  251:                 auto_inc     => 'yes', },
  252:               { name => 'machine',
  253:                 type => 'VARCHAR(100)',
  254:                 restrictions => 'NOT NULL'},
  255:               ],
  256:   'PRIMARY KEY' => ['machine_id',],
  257:  };
  258: 
  259: my $activity_table_def = 
  260: { id => $tables{'activity'},
  261:   permanent => 'no',
  262:   columns => [
  263:               { name => 'res_id',
  264:                 type => 'MEDIUMINT UNSIGNED',
  265:                 restrictions => 'NOT NULL',},
  266:               { name => 'time',
  267:                 type => 'DATETIME',
  268:                 restrictions => 'NOT NULL',},
  269:               { name => 'student_id',
  270:                 type => 'MEDIUMINT UNSIGNED',
  271:                 restrictions => 'NOT NULL',},
  272:               { name => 'action',
  273:                 type => 'VARCHAR(10)',
  274:                 restrictions => 'NOT NULL',},
  275:               { name => 'idx',                # This is here in case a student
  276:                 type => 'MEDIUMINT UNSIGNED', # has multiple submissions during
  277:                 restrictions => 'NOT NULL',   # one second.  It happens, trust
  278:                 auto_inc     => 'yes', },     # me.
  279:               { name => 'machine_id',
  280:                 type => 'MEDIUMINT UNSIGNED',
  281:                 restrictions => 'NOT NULL',},
  282:               { name => 'action_values',
  283:                 type => 'MEDIUMTEXT', },
  284:               ], 
  285:       'PRIMARY KEY' => ['time','student_id','res_id','idx'],
  286:       'KEY' => [{columns => ['student_id']},
  287:                 {columns => ['time']},],
  288: };
  289: 
  290: my @Activity_Table = ($activity_table_def);
  291: my @ID_Tables = ($student_table_def,$res_table_def,$machine_table_def);
  292:                
  293: ##
  294: ## End of table definitions
  295: ##
  296: $logthis->('tables = '.join(',',keys(%tables)));
  297: 
  298: $logthis->('Connectiong to mysql');
  299: &Apache::lonmysql::set_mysql_user_and_password('www',
  300:                                                $perlvar{'lonSqlAccess'});
  301: if (!&Apache::lonmysql::verify_sql_connection()) {
  302:     warn "Unable to connect to MySQL database.";
  303:     $logthis->("Unable to connect to MySQL database.");
  304:     &clean_up_and_exit(3);
  305: }
  306: $logthis->('SQL connection is up');
  307: 
  308: &update_process_name($course.'@'.$domain." loading existing data");
  309: my $missing_table = &check_for_missing_tables(values(%tables));
  310: if (-s $gz_sql_filename && ! -s $gz_xml_filename) {
  311:     my $backup_modification_time = (stat($gz_sql_filename))[9];
  312:     $logthis->($gz_sql_filename.' was last modified '.
  313:                localtime($backup_modification_time).
  314:                '('.$backup_modification_time.')');
  315:     if ($missing_table) {
  316:         # If the backup happened prior to the last table modification,
  317:         # we need to save the tables.
  318:         if (&latest_table_modification_time() > $backup_modification_time) {
  319:             # Save the current tables in case we need them another time.
  320:             $logthis->('Backing existing tables up');
  321:             &backup_tables_as_xml($gz_xml_filename.'.save_'.time,\%tables);
  322:         }
  323:         $time_this->();
  324:         &load_backup_sql_tables($gz_sql_filename);
  325:         &backup_tables_as_xml($gz_xml_filename,\%tables);
  326:         $time_this->('load backup tables');
  327:     }
  328: } elsif (-s $gz_xml_filename) {
  329:     my $backup_modification_time = (stat($gz_xml_filename))[9];
  330:     $logthis->($gz_xml_filename.' was last modified '.
  331:                localtime($backup_modification_time).
  332:                '('.$backup_modification_time.')');
  333:     if ($missing_table) {
  334:         my $table_modification_time = $backup_modification_time;
  335:         # If the backup happened prior to the last table modification,
  336:         # we need to save the tables.
  337:         if (&latest_table_modification_time() > $backup_modification_time) {
  338:             # Save the current tables in case we need them another time.
  339:             $logthis->('Backing existing tables up');
  340:             &backup_tables_as_xml($gz_xml_filename.'.save_'.time,\%tables);
  341:         }
  342:         $time_this->();
  343:         # We have to make our own tables for the xml format
  344:         &drop_tables();
  345:         &create_tables();
  346:         &load_backup_xml_tables($gz_xml_filename,\%tables);
  347:         $time_this->('load backup tables');
  348:     }    
  349: }
  350: 
  351: if (defined($xmlfile)) {
  352:     &clean_up_and_exit(0);
  353: }
  354: 
  355: ##
  356: ## Ensure the tables we need exist
  357: # create_tables does not complain if the tables already exist
  358: $logthis->('creating tables');
  359: if (! &create_tables()) {
  360:     warn "Unable to create tables";
  361:     $logthis->('Unable to create tables');
  362:     &clean_up_and_exit(4);
  363: }
  364: 
  365: ##
  366: ## Read the ids used for various tables
  367: $logthis->('reading id tables');
  368: &read_id_tables();
  369: $logthis->('finished reading id tables');
  370: 
  371: ##
  372: ## Set up the errors file
  373: my $error_fh = IO::File->new(">>$error_filename");
  374: 
  375: ##
  376: ## Parse the course log
  377: $logthis->('processing course log');
  378: &update_process_name($course.'@'.$domain." processing new data");
  379: if (-s $newfilename) {
  380:     my $result = &process_courselog($newfilename,$error_fh,\%tables);
  381:     &update_process_name($course.'@'.$domain." backing up new data");
  382:     if (! defined($result)) {
  383:         # Something went wrong along the way...
  384:         $logthis->('process_courselog returned undef');
  385:         &clean_up_and_exit(5);
  386:     } elsif ($result > 0) {
  387:         $time_this->();
  388:         $logthis->('process_courselog returned '.$result.'.'.$/.
  389:                    'Backing up tables');
  390:         &backup_tables_as_xml($gz_xml_filename,\%tables);
  391:         $time_this->('write backup tables');
  392:     }
  393:     if ($drop_when_done) { &drop_tables(); $logthis->('dropped tables'); }
  394: }
  395: close($error_fh);
  396: 
  397: ##
  398: ## Clean up the filesystem
  399: &Apache::lonmysql::disconnect_from_db();
  400: unlink($newfilename) if (-e $newfilename && ! $nocleanup);
  401: 
  402: ##
  403: ## Print timing data
  404: $logthis->('printing timing data');
  405: if ($time_run) {
  406:     my $elapsed_time = Time::HiRes::time - $initial_time;
  407:     print "Overall time: ".$elapsed_time.$/;
  408:     print &outputtimes();
  409:     $logthis->("Overall time: ".$elapsed_time);
  410:     $logthis->(&outputtimes());
  411: }
  412: 
  413: &clean_up_and_exit(0);
  414: 
  415: ########################################################
  416: ########################################################
  417: 
  418: sub clean_up_and_exit {
  419:     my ($exit_code) = @_;
  420:     # Close files
  421:     close(LOCKFILE);
  422:     close(LOGFILE);
  423:     # Remove zero length files
  424:     foreach my $file ($lockfilename, $error_filename,$logfile) {
  425:         if (defined($file) && -z $file) { 
  426:             unlink($file); 
  427:         }
  428:     }
  429: 
  430:     exit $exit_code;
  431: }
  432: 
  433: ########################################################
  434: ########################################################
  435: sub table_names {
  436:     my ($course,$domain) = @_;
  437:     my $prefix = $course.'_'.$domain.'_';
  438:     #
  439:     my %tables = 
  440:         ( student =>&Apache::lonmysql::fix_table_name($prefix.'students'),
  441:           res     =>&Apache::lonmysql::fix_table_name($prefix.'resource'),
  442:           machine =>&Apache::lonmysql::fix_table_name($prefix.'machine_table'),
  443:           activity=>&Apache::lonmysql::fix_table_name($prefix.'activity'),
  444:           );
  445:     return %tables;
  446: }
  447: 
  448: ########################################################
  449: ########################################################
  450: ##
  451: ##                 Process Course Log
  452: ##
  453: ########################################################
  454: ########################################################
  455: #
  456: # Returns the number of lines in the activity.log file that were processed.
  457: sub process_courselog {
  458:     my ($inputfile,$error_fh,$tables) = @_;
  459:     if (! open(IN,$inputfile)) {
  460:         warn "Unable to open '$inputfile' for reading";
  461:         $logthis->("Unable to open '$inputfile' for reading");
  462:         return undef;
  463:     }
  464:     my ($linecount,$insertcount);
  465:     my $dbh = &Apache::lonmysql::get_dbh();
  466:     #
  467:     &store_entry();
  468:     while (my $line=<IN>){
  469:         # last if ($linecount > 1000);
  470:         #
  471:         # Bulk storage variables
  472:         $time_this->();
  473:         chomp($line);
  474:         $linecount++;
  475:         # print $linecount++.$/;
  476:         my ($timestamp,$host,$log)=split(/\:/,$line,3);
  477:         #
  478:         # $log has the actual log entries; currently still escaped, and
  479:         # %26(timestamp)%3a(url)%3a(user)%3a(domain)
  480:         # then additionally
  481:         # %3aPOST%3a(name)%3d(value)%3a(name)%3d(value)
  482:         # or
  483:         # %3aCSTORE%3a(name)%3d(value)%26(name)%3d(value)
  484:         #
  485:         # get delimiter between timestamped entries to be &&&
  486:         $log=~s/\%26(\d{9,10})\%3a/\&\&\&$1\%3a/g;
  487:         $log = &unescape($log);
  488:         # now go over all log entries 
  489:         if (! defined($host)) { $host = 'unknown'; }
  490:         my $prevchunk = 'none';
  491:         foreach my $chunk (split(/\&\&\&/,$log)) {
  492:             if (length($chunk) > 20000) {
  493:                 # avoid putting too much data into the database
  494:                 # (usually an uploaded file or something similar)
  495:                 if (! &savechunk(\$chunk,$timestamp,$host)) {
  496:                     close(IN);
  497:                     return undef;
  498:                 }
  499:                 next;
  500:             }
  501:             my $warningflag = '';
  502: 	    my ($time,$res,$uname,$udom,$action,@values)= split(/:/,$chunk);
  503:             #
  504:             if (! defined($res) || $res =~ /^\s*$/) {
  505:                 $res = '/adm/roles';
  506:                 $action = 'LOGIN';
  507:             }
  508:             if ($res =~ m|^/prtspool/|) {
  509:                 $res = '/prtspool/';
  510:             }
  511:             if (! defined($action) || $action eq '') {
  512:                 $action = 'VIEW';
  513:             }
  514:             if ($action !~ /^(LOGIN|VIEW|POST|CSTORE|STORE)$/) {
  515:                 $warningflag .= 'action';
  516:                 print $error_fh 'full log entry:'.$log.$/;
  517:                 print $error_fh 'error on chunk (saving)'.$/;
  518:                 if (! &savechunk(\$chunk,$timestamp,$host)) {
  519:                     close(IN);
  520:                     return undef;
  521:                 }
  522:                 $logthis->('(action) Unable to parse chunk'.$/.
  523:                          'got '.
  524:                          'time = '.$time.$/.
  525:                          'res  = '.$res.$/.
  526:                          'uname= '.$uname.$/.
  527:                          'udom = '.$udom.$/.
  528:                          'action='.$action.$/.
  529:                          '@values = '.join('&',@values));
  530:                 next; #skip it if we cannot understand what is happening.
  531:             }
  532:             #
  533:             my %data = (student  => $uname.':'.$udom,
  534:                         resource => $res,
  535:                         machine  => $host,
  536:                         action   => $action,
  537:                         time => &Apache::lonmysql::sqltime($time));
  538:             if ($action eq 'POST') {
  539:                 $data{'action_values'} =
  540:                     $dbh->quote(join('&',map { &escape($_); } @values));
  541:             } else {
  542:                 $data{'action_values'} = $dbh->quote(join('&',@values));
  543:             }
  544:             my $error = &store_entry($dbh,$tables,\%data);
  545:             if ($error) {
  546:                 $logthis->('error store_entry:'.$error." on %data");
  547:             }
  548:             $prevchunk = $chunk;
  549:         }
  550:     }
  551:     my $result = &store_entry($dbh,$tables);
  552:     if (! defined($result)) {
  553:         my $error = &Apache::lonmysql::get_error();
  554:         warn "Error occured during insert.".$error;
  555:         $logthis->('error = '.$error);
  556:     }
  557:     close IN;
  558:     return $linecount;
  559:     ##
  560:     ##
  561:     sub savechunk {
  562:         my ($chunkref,$timestamp,$host) = @_;
  563:         my $chunk = &escape(${$chunkref});
  564:         if (! open(CHUNKFILE,">>$chunk_filename") ||
  565:             ! print CHUNKFILE $timestamp.':'.$host.':'.$chunk.$/) {
  566:             # abort
  567:             close(CHUNKFILE);
  568:             return 0;
  569:         }
  570:         close(CHUNKFILE);
  571:         return 1;
  572:     }
  573: }
  574: 
  575: 
  576: ##
  577: ## default value for $logthis and $time_this
  578: sub nothing {
  579:     return;
  580: }
  581: 
  582: ##
  583: ## Logging routine (look for $log)
  584: ##
  585: sub log_to_file {
  586:     my ($input)=@_;
  587:     print LOGFILE $input.$/;
  588: }
  589: 
  590: ##
  591: ## Timing routines
  592: ##
  593: {
  594:     my %Timing;
  595:     my $starttime;
  596: 
  597: sub time_action {
  598:     my ($key) = @_;
  599:     if (defined($key)) {
  600:         $Timing{$key}+=Time::HiRes::time-$starttime;
  601:         $Timing{'count_'.$key}++;
  602:     }
  603:     $starttime = Time::HiRes::time;
  604: }
  605: 
  606: sub outputtimes {
  607:     my $Str;
  608:     if ($time_run) {
  609:         $Str = "Timing Data:".$/;
  610:         while (my($k,$v) = each(%Timing)) {
  611:             next if ($k =~ /^count_/);
  612:             my $count = $Timing{'count_'.$k};
  613:             $Str .= 
  614:                 '  '.sprintf("%25.25s",$k).
  615:                 '  '.sprintf('% 8d',$count).
  616:                 '  '.sprintf('%12.5f',$v).$/;
  617:         }
  618:     }
  619:     return $Str;
  620: }
  621: 
  622: }
  623: 
  624: sub latest_table_modification_time {
  625:     my $latest_time;
  626:     foreach my $table (@Activity_Table,@ID_Tables) {    
  627:         my %tabledata = &Apache::lonmysql::table_information($table->{'id'});
  628:         next if (! scalar(keys(%tabledata))); # table does not exist
  629:         if (! defined($latest_time) ||
  630:             $latest_time < $tabledata{'Update_time'}) {
  631:             $latest_time = $tabledata{'Update_time'};
  632:         }
  633:     }
  634:     return $latest_time;
  635: }
  636: 
  637: sub check_for_missing_tables {
  638:     my @wanted_tables = @_;
  639:     # Check for missing tables
  640:     my @Current_Tables = &Apache::lonmysql::tables_in_db();
  641:     my %Found;
  642:     foreach my $tablename (@Current_Tables) {
  643:         foreach my $table (@wanted_tables) {
  644:             if ($tablename eq  $table) {
  645:                 $Found{$tablename}++;
  646:             }
  647:         }
  648:     }
  649:     $logthis->('Found tables '.join(',',keys(%Found)));
  650:     my $missing_a_table = 0;
  651:     foreach my $table (@wanted_tables) {
  652:         if (! $Found{$table}) {
  653:             $logthis->('Missing table '.$table);
  654:             $missing_a_table = 1;
  655:             last;
  656:         }
  657:     }
  658:     return $missing_a_table;
  659: }
  660: 
  661: ##
  662: ## Use mysqldump to store backups of the tables
  663: ##
  664: sub backup_tables_as_sql {
  665:     my ($gz_sql_filename) = @_;
  666:     my $command = qq{mysqldump --quote-names --opt loncapa };
  667:     foreach my $table (@ID_Tables,@Activity_Table) {
  668:         my $tablename = $table->{'id'};
  669:         $tablename =~ s/\`//g;
  670:         $command .= $tablename.' ';
  671:     }
  672:     $command .= '| gzip >'.$gz_sql_filename;
  673:     $logthis->($command);
  674:     system($command);
  675: }
  676: 
  677: ##
  678: ## Load in mysqldumped files
  679: ##
  680: sub load_backup_sql_tables {
  681:     my ($gz_sql_filename) = @_;
  682:     if (-s $gz_sql_filename) {
  683:         $logthis->('loading data from gzipped sql file');
  684:         my $command='gzip -dc '.$gz_sql_filename.' | mysql --database=loncapa';
  685:         system($command);
  686:         $logthis->('finished loading gzipped data');;
  687:     } else {
  688:         return undef;
  689:     }
  690: }
  691: 
  692: ##
  693: ## 
  694: ##
  695: sub update_process_name {
  696:     my ($text) = @_;
  697:     $0 = 'parse_activity_log.pl: '.$text;
  698: }
  699: 
  700: sub get_filename {
  701:     my ($course,$domain) = @_;
  702:     my ($a,$b,$c,undef) = split('',$course,4);
  703:     return "$perlvar{'lonUsersDir'}/$domain/$a/$b/$c/$course/activity.log";
  704: }
  705: 
  706: sub create_tables {
  707:     foreach my $table (@ID_Tables,@Activity_Table) {
  708:         my $table_id = &Apache::lonmysql::create_table($table);
  709:         if (! defined($table_id)) {
  710:             warn "Unable to create table ".$table->{'id'}.$/;
  711:             $logthis->('Unable to create table '.$table->{'id'});
  712:             $logthis->(join($/,&Apache::lonmysql::build_table_creation_request($table)));
  713:             return 0;
  714:         }
  715:     }
  716:     return 1;
  717: }
  718: 
  719: sub drop_tables {
  720:     foreach my $table (@ID_Tables,@Activity_Table) {
  721:         my $table_id = $table->{'id'};
  722:         &Apache::lonmysql::drop_table($table_id);
  723:     }
  724: }
  725: 
  726: #################################################################
  727: #################################################################
  728: ##
  729: ## Database item id code
  730: ##
  731: #################################################################
  732: #################################################################
  733: { # Scoping for ID lookup code
  734:     my %IDs;
  735: 
  736: sub read_id_tables {
  737:     foreach my $table (@ID_Tables) {
  738:         my @Data = &Apache::lonmysql::get_rows($table->{'id'});
  739:         my $count = 0;
  740:         foreach my $row (@Data) {
  741:             $IDs{$table->{'id'}}->{$row->[1]} = $row->[0];
  742:         }
  743:     }
  744:     return;
  745: }
  746: 
  747: sub get_id {
  748:     my ($table,$fieldname,$value) = @_;
  749:     if (exists($IDs{$table}->{$value}) && $IDs{$table}->{$value} =~ /^\d+$/) {
  750:         return $IDs{$table}->{$value};
  751:     } else {
  752:         # insert into the table - if the item already exists, that is
  753:         # okay.
  754:         my $result = &Apache::lonmysql::store_row($table,[undef,$value]);
  755:         if (! defined($result)) {
  756:             warn("Got error on id insert for $value\n".
  757:                  &Apache::lonmysql::get_error());
  758:         }
  759:         # get the id
  760:         my $id = &Apache::lonmysql::get_dbh()->{'mysql_insertid'};
  761:         if (defined($id)) {
  762:             $IDs{$table}->{$value}=$id;
  763:         } else {
  764:             $logthis->("Unable to retrieve id for $table $fieldname $value");
  765:             return undef;
  766:         }
  767:     }
  768: }
  769: 
  770: } # End of ID scoping
  771: 
  772: ###############################################################
  773: ###############################################################
  774: ##
  775: ##   Save as XML
  776: ##
  777: ###############################################################
  778: ###############################################################
  779: sub backup_tables_as_xml {
  780:     my ($filename,$tables) = @_;
  781:     open(XMLFILE,"|gzip - > $filename") || return ('error:unable to write '.$filename);
  782:     my $query = qq{
  783:         SELECT B.resource,
  784:                A.time,
  785:                A.idx,
  786:                C.student,
  787:                A.action,
  788:                E.machine,
  789:                A.action_values 
  790:             FROM $tables->{'activity'} AS A
  791:             LEFT JOIN $tables->{'res'}      AS B ON B.res_id=A.res_id 
  792:             LEFT JOIN $tables->{'student'}  AS C ON C.student_id=A.student_id 
  793:             LEFT JOIN $tables->{'machine'}  AS E ON E.machine_id=A.machine_id
  794:             ORDER BY A.time DESC
  795:         };
  796:     $query =~ s/\s+/ /g;
  797:     my $dbh = &Apache::lonmysql::get_dbh();
  798:     my $sth = $dbh->prepare($query);
  799:     if (! $sth->execute()) {
  800:         $logthis->('<font color="blue">'.
  801:                    'WARNING: Could not retrieve from database:'.
  802:                    $sth->errstr().'</font>');
  803:         return undef;
  804:     } else {
  805:         my ($res,$sqltime,$idx,$student,$action,$machine,$action_values);
  806:         if ($sth->bind_columns(\$res,\$sqltime,\$idx,\$student,\$action,
  807:                                \$machine,\$action_values)) {
  808:             
  809:             while ($sth->fetch) {
  810:                 print XMLFILE '<row>'.
  811:                     qq{<resource>$res</resource>}.
  812:                     qq{<time>$sqltime</time>}.
  813:                     qq{<idx>$idx</idx>}.
  814:                     qq{<student>$student</student>}.
  815:                     qq{<action>$action</action>}.
  816:                     qq{<machine>$machine</machine>}.
  817:                     qq{<action_values>$action_values</action_values>}.
  818:                     '</row>'.$/;
  819:             }
  820:         } else {
  821:             warn "Unable to bind to columns.\n";
  822:             return undef;
  823:         }
  824:     }
  825:     close XMLFILE;
  826:     return;
  827: }
  828: 
  829: ###############################################################
  830: ###############################################################
  831: ##
  832: ##   load as xml
  833: ##
  834: ###############################################################
  835: ###############################################################
  836: {
  837:     my @fields = ('resource','time',
  838:                   'student','action','idx','machine','action_values');
  839:     my %ids = ();
  840: sub load_backup_xml_tables {
  841:     my ($filename,$tables) = @_;
  842:     my $dbh = &Apache::lonmysql::get_dbh();
  843:     my $xmlfh;
  844:     open($xmlfh,"cat $filename | gzip -d - |");
  845:     if (! defined($xmlfh)) {
  846:         return ('error:unable to read '.$filename);
  847:     }
  848:     #
  849:     %ids = (resource=> {"\0count"=>1},
  850:             student=> {"\0count"=>1},
  851:             machine=> {"\0count"=>1});
  852:     #
  853:     my %data;
  854:     while (my $inputline = <$xmlfh>) {
  855:         my ($resource,$time,undef,$student,$action,$machine,$action_values) = 
  856:             ($inputline =~ m{<row>
  857:                                  <resource>(.*)</resource>
  858:                                  <time>(.*)</time>
  859:                                  <idx>(.*)</idx>
  860:                                  <student>(.*)</student>
  861:                                  <action>(.*)</action>
  862:                                  <machine>(.*)</machine>
  863:                                  <action_values>(.*)</action_values>
  864:                                  </row>$
  865:                              }x
  866:              );
  867:         my $resource_id = &xml_get_id('resource',$resource);
  868:         my $student_id  = &xml_get_id('student',$student);
  869:         my $machine_id  = &xml_get_id('machine',$machine);
  870:         &xml_store_activity_row(map { defined($_)?$dbh->quote($_):'' 
  871:                                   } ($resource_id,
  872:                                      $time,
  873:                                      $student_id,
  874:                                      $action,
  875:                                      'NULL',
  876:                                      $machine_id,
  877:                                      $action_values));
  878:     }
  879:     &xml_store_activity_row();
  880:     close($xmlfh);
  881:     # Store id tables
  882:     while (my ($id_name,$id_data) = each(%ids)) {
  883:         if ($id_name eq 'resource') { $id_name = 'res'; }
  884:         delete($id_data->{"\0count"});
  885:         &xml_store_id_table($id_name,$id_data);
  886:     }
  887:     return;
  888: }
  889: 
  890: sub xml_get_id {
  891:     my ($table,$element) = @_;
  892:     if (! exists($ids{$table}->{$element})) {
  893:         $ids{$table}->{$element} = $ids{$table}->{"\0count"}++;
  894:     }
  895:     return $ids{$table}->{$element};
  896: }
  897: 
  898: {
  899:     my @data_rows;
  900: sub xml_store_activity_row {
  901:     my @data = @_;
  902:     if (scalar(@data)) {
  903:         push(@data_rows,[@data]);
  904:     }
  905:     if (! scalar(@data) || scalar(@data_rows) > 500) {
  906:         if (! &Apache::lonmysql::bulk_store_rows($tables{'activity'},
  907:                                                  scalar(@{$data_rows[0]}),
  908:                                                  \@data_rows)) {
  909:             $logthis->("Error:".&Apache::lonmysql::get_error());
  910:             warn("Error:".&Apache::lonmysql::get_error());
  911:         } else {
  912:             undef(@data_rows);
  913:         }
  914:     }
  915:     return;
  916: }
  917: 
  918: }
  919: 
  920: sub xml_store_id_table {
  921:     my ($table,$tabledata) =@_;
  922:     my $dbh = &Apache::lonmysql::get_dbh();
  923:     if (! &Apache::lonmysql::bulk_store_rows
  924:         ($tables{$table},2,
  925:          [map{[$tabledata->{$_},$dbh->quote($_)]} keys(%$tabledata)])) {
  926:         $logthis->("Error:".&Apache::lonmysql::get_error());
  927:         warn "Error:".&Apache::lonmysql::get_error().$/;
  928:     }
  929: }
  930: 
  931: } # End of load xml scoping
  932: 
  933: #######################################################################
  934: #######################################################################
  935: ##
  936: ## store_entry - accumulate data to be inserted into the database
  937: ##
  938: ## Pass no values in to clear accumulator
  939: ## Pass ($dbh,\%tables) to initiate storage of values
  940: ## Pass ($dbh,\%tables,\%data) to use normally
  941: ##
  942: #######################################################################
  943: #######################################################################
  944: {
  945:     my @rows;
  946: 
  947: sub store_entry {
  948:     my $max_row_count = 100;
  949:     if (! @_) {
  950:         undef(@rows);
  951:         return '';
  952:     }
  953:     my ($dbh,$tables,$data) = @_;
  954:     return if (! defined($tables));
  955:     if (defined($data)) {
  956:         my $error;
  957:         foreach my $field ('student','resource','action','time') {
  958:             if (! defined($data->{$field}) || $data->{$field} eq ':' ||
  959:                 $data->{$field}=~ /^\s*$/) {
  960:                 $error.=$field.',';
  961:             }
  962:         }
  963:         if ($error) { $error=~s/,$//; return $error; }
  964:         #
  965:         my $student_id = &get_id($tables->{'student'},'student',
  966:                                  $data->{'student'});
  967:         my $res_id     = &get_id($tables->{'res'},
  968:                                  'resource',$data->{'resource'});
  969:         my $machine_id = &get_id($tables->{'machine'},
  970:                                  'machine',$data->{'machine'});
  971:         my $idx = $data->{'idx'}; if (! $idx) { $idx = "''"; }
  972:         #
  973:         push(@rows,[$res_id,
  974:                     qq{'$data->{'time'}'},
  975:                     $student_id,
  976:                     qq{'$data->{'action'}'},
  977:                     $idx,
  978:                     $machine_id,
  979:                     $data->{'action_values'}]);
  980:     }
  981:     if (defined($tables) &&
  982:         ( (! defined($data) && scalar(@rows)) || scalar(@rows)>$max_row_count)
  983:         ){
  984:         # Store the rows
  985:         my $result =
  986:             &Apache::lonmysql::bulk_store_rows($tables->{'activity'},
  987:                                                undef,
  988:                                                \@rows);
  989:         if (! defined($result)) {
  990:             my $error = &Apache::lonmysql::get_error();
  991:             warn "Error occured during insert.".$error;
  992:             return $error;
  993:         }
  994:         undef(@rows);
  995:         return $result if (! defined($data));
  996:     }
  997:     return '';
  998: }
  999: 
 1000: } # end of scope for &store_entry
 1001: 
 1002: ###############################################################
 1003: ###############################################################
 1004: ##
 1005: ##   The usual suspects
 1006: ##
 1007: ###############################################################
 1008: ###############################################################
 1009: sub escape {
 1010:     my $str=shift;
 1011:     $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
 1012:     return $str;
 1013: }
 1014: 
 1015: sub unescape {
 1016:     my $str=shift;
 1017:     $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
 1018:     return $str;
 1019: }

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