File:
[LON-CAPA] /
loncom /
debugging_tools /
activity_to_accesscount.pl
Revision
1.3:
download - view:
text,
annotated -
select for diffs
Fri Nov 14 20:42:34 2003 UTC (20 years, 10 months ago) by
matthew
Branches:
MAIN
CVS tags:
version_2_1_X,
version_2_1_3,
version_2_1_2,
version_2_1_1,
version_2_1_0,
version_2_0_X,
version_2_0_99_1,
version_2_0_2,
version_2_0_1,
version_2_0_0,
version_1_99_3,
version_1_99_2,
version_1_99_1_tmcc,
version_1_99_1,
version_1_99_0_tmcc,
version_1_99_0,
version_1_3_X,
version_1_3_3,
version_1_3_2,
version_1_3_1,
version_1_3_0,
version_1_2_X,
version_1_2_99_1,
version_1_2_99_0,
version_1_2_1,
version_1_2_0,
version_1_1_X,
version_1_1_99_5,
version_1_1_99_4,
version_1_1_99_3,
version_1_1_99_2,
version_1_1_99_1,
version_1_1_99_0,
version_1_1_3,
version_1_1_2,
version_1_1_1,
version_1_1_0,
version_1_0_99_3,
version_1_0_99_2,
version_1_0_99_1,
version_1_0_99,
HEAD
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;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>