[BACK]Return to activity_to_accesscount.pl CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / debugging_tools
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, 6 months 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

#!/usr/bin/perl -w
#
use strict;
use GDBM_File;
use lib '/home/httpd/lib/perl/';
use LONCAPA;

my %resourceaccess;

sub main {
    my $file=$ARGV[0];
    my $target = $ARGV[1];
    my ($owner) = ($target =~ m:.*/(.*)/nohist_accesscount.db:);
    print STDERR "source: $file\ntarget: $target\nowner: $owner\n";
    my $accesstime = 0;
    my $starttime = time;
    if (-e $target) {
	my $accessDB = &LONCAPA::locking_hash_tie($target,&GDBM_READER());
	if (! $accessDB) {
            warn "Unable to tie to $target";
            return;
        }
        #
        if (exists($accessDB->{'tabulated '.$file})) {
            $accesstime = $accessDB->{'tabulated '.$file};
        }
	&LONCAPA::locking_hash_untie($accessDB);
    }
    #
    my $line;
    open FILEID,'<'.$file;
    my @allaccess;
    print STDERR "Access by resource after $accesstime\n\n";
    my $numlines = 0;
    while ($line=<FILEID>) {
        $numlines++;
        if (int($numlines / 1000)*1000 == $numlines) {
            if (int($numlines / 10000)*10000 == $numlines) {
                print STDERR '*';
            } else {
                print STDERR '.';
            }
            if (int($numlines / 50000)*50000 == $numlines) {
                print STDERR $/;
            }
        }
        next if ($line eq '' || $line !~ /:/);
        chomp($line);
        my ($time,$machine,$what)=split(':',$line);
	$what=&unescape($what);
        my @accesses = split(/(\d{10}):/,$what);
        shift(@accesses);
	while (@accesses) {
            my $date = shift(@accesses);
            next if ($date =~ /\D/ || $date < $accesstime);
            my $access = shift(@accesses);
            next if (! defined($access) || $access eq '' || 
                     ! defined($date)   || $date   eq '');
            $access =~ s/(\&$|^:)//g;
            my ($resource,$who,$domain,$post,@posts)=split(':',$access);
	    if (!$resource || $resource eq '') {
                next; 
            }
            $resource = &unescape($resource);
            if ($resource !~ m:/$owner/:) {
                next;
            }
            if ($resource =~ /___\d+___/) {
                (undef,$resource) = split(/___\d+___/,$resource);
            }
            next if ($resource =~ m:^/(res/adm|adm)/:);
            $resource =~ s:^/?res/::;
            $resourceaccess{$resource}++;            
	}
    }
    print STDERR 'done.  Updating '.$target.$/;

    my $accessDB = &LONCAPA::locking_hash_tie($target,&GDBM_WRCREAT());
    if (! $accessDB) {
        warn "Unable to open $target to store data".$/;
        return;
    }
    #
    while (my ($resource,$count) = each(%resourceaccess)) {
        $resource = &escape($resource);
        if (exists($accessDB->{$resource})) {
            $accessDB->{$resource}+=$count;
        } else {
            $accessDB->{$resource} = $count;
        }
        print sprintf("%10.0f",$count).':'.$resource."\n";
    }
    $accessDB->{'tabulated '.$file} = $starttime;
    &LONCAPA::locking_hash_untie($accessDB);
}

main;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>