Return to seed_accesscount.pl CVS log

Up to [LON-CAPA] / loncom / debugging_tools

Annotation of loncom/debugging_tools/seed_accesscount.pl, revision 1.5

1.1       matthew     1: #!/usr/bin/perl -w
                      2: #
                      3: # The LearningOnline Network
                      4: #
1.5     ! albertel    5: # $Id: seed_accesscount.pl,v 1.4 2004/01/13 18:13:34 matthew Exp $
1.1       matthew     6: #
                      7: # Copyright Michigan State University Board of Trustees
                      8: #
                      9: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                     10: #
                     11: # LON-CAPA is free software; you can redistribute it and/or modify
                     12: # it under the terms of the GNU General Public License as published by
                     13: # the Free Software Foundation; either version 2 of the License, or
                     14: # (at your option) any later version.
                     15: #
                     16: # LON-CAPA is distributed in the hope that it will be useful,
                     17: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     18: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     19: # GNU General Public License for more details.
                     20: #
                     21: # You should have received a copy of the GNU General Public License
                     22: # along with LON-CAPA; if not, write to the Free Software
                     23: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     24: #
                     25: # /home/httpd/html/adm/gpl.txt
                     26: #
                     27: # http://www.lon-capa.org/
                     28: #
                     29: #################################################
                     30: use strict;
                     31: use Getopt::Long;
                     32: use GDBM_File;
1.5     ! albertel   33: use lib '/home/httpd/lib/perl/';
        !            34: use LONCAPA;
1.1       matthew    35: 
                     36: #
                     37: # Options
                     38: my ($verbose,$help) = (0);
                     39: GetOptions("v"    => \$verbose,
                     40:            "help" => \$help);
                     41: 
                     42: #
                     43: # Help them out if they ask for it
                     44: if ($help) {
                     45:     print <<END;
                     46: seed_accesscount.pl 
                     47: END
                     48:     exit;
                     49: }
                     50: 
                     51: #
                     52: # Loop through ARGV getting files.
                     53: $|=1;
                     54: while (my $resDBname = shift()) {
                     55:     my ($path) = ($resDBname =~ /^(.*)nohist_resevaldata.db$/);
                     56:     print STDERR $path.$/;
1.5     ! albertel   57:     my $resevalDB = &LONCAPA::locking_hash_tie($resDBname,&GDBM_READER());
        !            58:     if (! $resevalDB) {
1.1       matthew    59:         warn "Unable to tie to $resDBname";
                     60:         next;
                     61:     }
1.5     ! albertel   62:     &LONCAPA::push_locking_hash_tie();
1.1       matthew    63:     #
                     64:     my $accessDBname = $path.'nohist_accesscount.db';
1.5     ! albertel   65:     my $accessDB = &LONCAPA::locking_hash_tie($accessDBname,&GDBM_WRCREAT());
        !            66:     if (! $accessDB) {
1.1       matthew    67:         warn "Unable to tie to $accessDBname";
                     68:         next;
                     69:     }
                     70:     #
                     71:     my @Keys;
                     72:     my ($basekey,$value);
                     73:     #
                     74:     $! = 0;
1.5     ! albertel   75:     while (eval('($basekey,$value) = each(%{$resevalDB});')) {
1.1       matthew    76:         if ($!) {
                     77:             print STDERR $1.$/;
                     78:             $!=0;
                     79:         }
                     80:         my $key = &unescape($basekey);
                     81:         my $src;
                     82:         next if (! ((undef,$src) = ($key =~ /^(.*)___(.*)___count/)));
                     83:         my $value = &unescape($value);
1.2       matthew    84:         $src = &escape($src);
1.5     ! albertel   85:         if (exists($accessDB->{$src})) {
        !            86:             $accessDB->{$src}+=$value;
1.1       matthew    87:         } else {
1.5     ! albertel   88:             $accessDB->{$src}=$value;
1.1       matthew    89:         }
                     90:         push (@Keys,$basekey);
                     91:     }
                     92:     #
1.5     ! albertel   93:     &LONCAPA::locking_hash_untie($accessDB);
        !            94:     &LONCAPA::pop_locking_hash_tie();
        !            95:     &LONCAPA::locking_hash_untie($resevalDB);
1.4       matthew    96:     system("chown www:www $accessDBname");
1.1       matthew    97:     # remove the keys we saved.
                     98:     next if (! scalar(@Keys)); # skip it if we did not get anything...
1.5     ! albertel   99:     my $dbptr = &LONCAPA::locking_hash_tie($resDBname,&GDBM_READER());
        !           100:     if (! $dbptr ) {
1.1       matthew   101:         die "Unable to re-tie to $resDBname.  No deletes occured.";
                    102:     }
                    103:     foreach my $basekey (@Keys) {
1.5     ! albertel  104:         delete($resevalDB->{$basekey});
1.1       matthew   105:     }
1.3       matthew   106:     # Squish the file down
1.5     ! albertel  107:     &LONCAPA::locking_hash_untie($resevalDB);
1.4       matthew   108:     system("chown www:www $resDBname");
1.1       matthew   109: }
                    110: exit;
                    111: 
                    112: ######################################
1.2       matthew   113: