File:
[LON-CAPA] /
loncom /
debugging_tools /
activity_to_accesscount.pl
Revision
1.4:
download - view:
text,
annotated -
select for diffs
Tue Jun 27 15:01:14 2006 UTC (18 years, 1 month ago) by
albertel
Branches:
MAIN
CVS tags:
version_2_9_X,
version_2_9_99_0,
version_2_9_1,
version_2_9_0,
version_2_8_X,
version_2_8_99_1,
version_2_8_99_0,
version_2_8_2,
version_2_8_1,
version_2_8_0,
version_2_7_X,
version_2_7_99_1,
version_2_7_99_0,
version_2_7_1,
version_2_7_0,
version_2_6_X,
version_2_6_99_1,
version_2_6_99_0,
version_2_6_3,
version_2_6_2,
version_2_6_1,
version_2_6_0,
version_2_5_X,
version_2_5_99_1,
version_2_5_99_0,
version_2_5_2,
version_2_5_1,
version_2_5_0,
version_2_4_X,
version_2_4_99_0,
version_2_4_2,
version_2_4_1,
version_2_4_0,
version_2_3_X,
version_2_3_99_0,
version_2_3_2,
version_2_3_1,
version_2_3_0,
version_2_2_X,
version_2_2_99_1,
version_2_2_99_0,
version_2_2_2,
version_2_2_1,
version_2_2_0,
version_2_1_99_3,
version_2_1_99_2,
version_2_1_99_1,
version_2_1_99_0,
version_2_12_X,
version_2_11_X,
version_2_11_5_msu,
version_2_11_5,
version_2_11_4_uiuc,
version_2_11_4_msu,
version_2_11_4,
version_2_11_3_uiuc,
version_2_11_3_msu,
version_2_11_3,
version_2_11_2_uiuc,
version_2_11_2_msu,
version_2_11_2_educog,
version_2_11_2,
version_2_11_1,
version_2_11_0_RC3,
version_2_11_0_RC2,
version_2_11_0_RC1,
version_2_11_0,
version_2_10_X,
version_2_10_1,
version_2_10_0_RC2,
version_2_10_0_RC1,
version_2_10_0,
loncapaMITrelate_1,
language_hyphenation_merge,
language_hyphenation,
bz6209-base,
bz6209,
bz5969,
bz2851,
PRINT_INCOMPLETE_base,
PRINT_INCOMPLETE,
HEAD,
GCI_3,
GCI_2,
GCI_1,
BZ5971-printing-apage,
BZ5434-fox,
BZ4492-merge,
BZ4492-feature_horizontal_radioresponse,
BZ4492-feature_Support_horizontal_radioresponse,
BZ4492-Support_horizontal_radioresponse
- morph to LONCAPA.pm
1: #!/usr/bin/perl -w
2: #
3: use strict;
4: use GDBM_File;
5: use lib '/home/httpd/lib/perl/';
6: use LONCAPA;
7:
8: my %resourceaccess;
9:
10: sub main {
11: my $file=$ARGV[0];
12: my $target = $ARGV[1];
13: my ($owner) = ($target =~ m:.*/(.*)/nohist_accesscount.db:);
14: print STDERR "source: $file\ntarget: $target\nowner: $owner\n";
15: my $accesstime = 0;
16: my $starttime = time;
17: if (-e $target) {
18: my $accessDB = &LONCAPA::locking_hash_tie($target,&GDBM_READER());
19: if (! $accessDB) {
20: warn "Unable to tie to $target";
21: return;
22: }
23: #
24: if (exists($accessDB->{'tabulated '.$file})) {
25: $accesstime = $accessDB->{'tabulated '.$file};
26: }
27: &LONCAPA::locking_hash_untie($accessDB);
28: }
29: #
30: my $line;
31: open FILEID,'<'.$file;
32: my @allaccess;
33: print STDERR "Access by resource after $accesstime\n\n";
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);
55: next if ($date =~ /\D/ || $date < $accesstime);
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);
61: if (!$resource || $resource eq '') {
62: next;
63: }
64: $resource = &unescape($resource);
65: if ($resource !~ m:/$owner/:) {
66: next;
67: }
68: if ($resource =~ /___\d+___/) {
69: (undef,$resource) = split(/___\d+___/,$resource);
70: }
71: next if ($resource =~ m:^/(res/adm|adm)/:);
72: $resource =~ s:^/?res/::;
73: $resourceaccess{$resource}++;
74: }
75: }
76: print STDERR 'done. Updating '.$target.$/;
77:
78: my $accessDB = &LONCAPA::locking_hash_tie($target,&GDBM_WRCREAT());
79: if (! $accessDB) {
80: warn "Unable to open $target to store data".$/;
81: return;
82: }
83: #
84: while (my ($resource,$count) = each(%resourceaccess)) {
85: $resource = &escape($resource);
86: if (exists($accessDB->{$resource})) {
87: $accessDB->{$resource}+=$count;
88: } else {
89: $accessDB->{$resource} = $count;
90: }
91: print sprintf("%10.0f",$count).':'.$resource."\n";
92: }
93: $accessDB->{'tabulated '.$file} = $starttime;
94: &LONCAPA::locking_hash_untie($accessDB);
95: }
96:
97: main;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>