Annotation of loncom/metadata_database/parse_activity_log.pl, revision 1.19

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

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