Return to activity_to_accesscount.pl CVS log

Up to [LON-CAPA] / loncom / debugging_tools

Annotation of loncom/debugging_tools/activity_to_accesscount.pl, revision 1.3

1.1       matthew     1: #!/usr/bin/perl -w
                      2: #
                      3: use strict;
1.2       matthew     4: use GDBM_File;
1.1       matthew     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: 
1.3     ! matthew    12: sub escape {
        !            13:     my $str=shift;
        !            14:     $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
        !            15:     return $str;
        !            16: }
        !            17: 
1.1       matthew    18: my %resourceaccess;
                     19: 
                     20: sub main {
                     21:     my $file=$ARGV[0];
1.3     ! matthew    22:     my $target = $ARGV[1];
        !            23:     my ($owner) = ($target =~ m:.*/(.*)/nohist_accesscount.db:);
        !            24:     print STDERR "source: $file\ntarget: $target\nowner: $owner\n";
1.2       matthew    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:     #
1.1       matthew    40:     my $line;
                     41:     open FILEID,'<'.$file;
                     42:     my @allaccess;
1.2       matthew    43:     print STDERR "Access by resource after $accesstime\n\n";
1.1       matthew    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);
1.2       matthew    65:             next if ($date =~ /\D/ || $date < $accesstime);
1.1       matthew    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);
1.2       matthew    71: 	    if (!$resource || $resource eq '') {
1.1       matthew    72:                 next; 
                     73:             }
                     74:             $resource = &unescape($resource);
1.3     ! matthew    75:             if ($resource !~ m:/$owner/:) {
1.1       matthew    76:                 next;
                     77:             }
                     78:             if ($resource =~ /___\d+___/) {
                     79:                 (undef,$resource) = split(/___\d+___/,$resource);
                     80:             }
                     81:             next if ($resource =~ m:^/(res/adm|adm)/:);
1.2       matthew    82:             $resource =~ s:^/?res/::;
1.1       matthew    83:             $resourceaccess{$resource}++;            
                     84: 	}
                     85:     }
1.2       matthew    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:     #
1.1       matthew    92:     while (my ($resource,$count) = each(%resourceaccess)) {
1.3     ! matthew    93:         $resource = &escape($resource);
1.2       matthew    94:         if (exists($accessDB{$resource})) {
                     95:             $accessDB{$resource}+=$count;
                     96:         } else {
                     97:             $accessDB{$resource} = $count;
                     98:         }
1.1       matthew    99:         print sprintf("%10.0f",$count).':'.$resource."\n";
                    100:     }
1.2       matthew   101:     $accessDB{'tabulated '.$file} = $starttime;
                    102:     untie(%accessDB);
1.1       matthew   103: }
                    104: 
                    105: main;