Return to activity_to_accesscount.pl CVS log

Up to [LON-CAPA] / loncom / debugging_tools

Store the filenames escaped.
Take the target assesscount db file on the command line.

    1: #!/usr/bin/perl -w
    2: #
    3: use strict;
    4: use GDBM_File;
    5: 
    6: sub unescape {
    7:     my $str=shift;
    8:     $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
    9:     return $str;
   10: }
   11: 
   12: sub escape {
   13:     my $str=shift;
   14:     $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
   15:     return $str;
   16: }
   17: 
   18: my %resourceaccess;
   19: 
   20: sub main {
   21:     my $file=$ARGV[0];
   22:     my $target = $ARGV[1];
   23:     my ($owner) = ($target =~ m:.*/(.*)/nohist_accesscount.db:);
   24:     print STDERR "source: $file\ntarget: $target\nowner: $owner\n";
   25:     my %accessDB;
   26:     my $accesstime = 0;
   27:     my $starttime = time;
   28:     if (-e $target) {
   29:         if (! tie(%accessDB,'GDBM_File',$target,&GDBM_READER,0640)) {
   30:             warn "Unable to tie to $target";
   31:             return;
   32:         }
   33:         #
   34:         if (exists($accessDB{'tabulated '.$file})) {
   35:             $accesstime = $accessDB{'tabulated '.$file};
   36:         }
   37:         untie(%accessDB);
   38:     }
   39:     #
   40:     my $line;
   41:     open FILEID,'<'.$file;
   42:     my @allaccess;
   43:     print STDERR "Access by resource after $accesstime\n\n";
   44:     my $numlines = 0;
   45:     while ($line=<FILEID>) {
   46:         $numlines++;
   47:         if (int($numlines / 1000)*1000 == $numlines) {
   48:             if (int($numlines / 10000)*10000 == $numlines) {
   49:                 print STDERR '*';
   50:             } else {
   51:                 print STDERR '.';
   52:             }
   53:             if (int($numlines / 50000)*50000 == $numlines) {
   54:                 print STDERR $/;
   55:             }
   56:         }
   57:         next if ($line eq '' || $line !~ /:/);
   58:         chomp($line);
   59:         my ($time,$machine,$what)=split(':',$line);
   60: 	$what=&unescape($what);
   61:         my @accesses = split(/(\d{10}):/,$what);
   62:         shift(@accesses);
   63: 	while (@accesses) {
   64:             my $date = shift(@accesses);
   65:             next if ($date =~ /\D/ || $date < $accesstime);
   66:             my $access = shift(@accesses);
   67:             next if (! defined($access) || $access eq '' || 
   68:                      ! defined($date)   || $date   eq '');
   69:             $access =~ s/(\&$|^:)//g;
   70:             my ($resource,$who,$domain,$post,@posts)=split(':',$access);
   71: 	    if (!$resource || $resource eq '') {
   72:                 next; 
   73:             }
   74:             $resource = &unescape($resource);
   75:             if ($resource !~ m:/$owner/:) {
   76:                 next;
   77:             }
   78:             if ($resource =~ /___\d+___/) {
   79:                 (undef,$resource) = split(/___\d+___/,$resource);
   80:             }
   81:             next if ($resource =~ m:^/(res/adm|adm)/:);
   82:             $resource =~ s:^/?res/::;
   83:             $resourceaccess{$resource}++;            
   84: 	}
   85:     }
   86:     print STDERR 'done.  Updating '.$target.$/;
   87:     if (! tie(%accessDB,'GDBM_File',$target,&GDBM_WRCREAT,0640)) {
   88:         warn "Unable to open $target to store data".$/;
   89:         return;
   90:     }
   91:     #
   92:     while (my ($resource,$count) = each(%resourceaccess)) {
   93:         $resource = &escape($resource);
   94:         if (exists($accessDB{$resource})) {
   95:             $accessDB{$resource}+=$count;
   96:         } else {
   97:             $accessDB{$resource} = $count;
   98:         }
   99:         print sprintf("%10.0f",$count).':'.$resource."\n";
  100:     }
  101:     $accessDB{'tabulated '.$file} = $starttime;
  102:     untie(%accessDB);
  103: }
  104: 
  105: main;