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.4

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