package Module::Use; require 5.005; use Tie::Hash; #use Tie::StdHash; use Carp; use strict; use vars qw($VERSION %noargs %counts %config $_object @ISA); @ISA = qw(Tie::StdHash); $VERSION = 0.05_01; @noargs{ qw(Counting) } = ( ); sub FETCH { $counts{$_[1]}++ if defined $_[0] -> {$_[1]}; warn "Fetching $_[1]\n"; $_[0] -> {$_[1]}; } sub STORE { $counts{$_[1]}++; warn "Storing $_[1]\n"; $_[0] -> {$_[1]} = $_[2]; } sub import { my($self, @config) = @_; croak "@{[ref $self]} not intended to be instanced" if ref $self; my $op; while(@config) { $op = shift @config; if(exists $noargs{$op}) { $config{$op} = 1; } else { $config{$op} = shift @config; } } # load logging module - defines Module::Use::log if(defined $config{Logger}) { eval qq{require Module::Use::$config{Logger}}; croak "Unable to load logger: $@" if $@; } if($ENV{'MOD_PERL'}) { $config{log_at_end} = 0; } else { $config{log_at_end} = 1; } if($config{"Counting"}) { tie %INC, $self; $_object = tied %INC; } else { $_object = bless { }, $self; } my($modules) = $_object -> query_modules(); eval "require $_" for @{$modules}; } sub query_modules { my($self) = shift; return unless $self -> can('_query_modules'); my $hash = $self -> _query_modules(); my @keys = keys %{$hash}; my $total = 0; local($_); # JIC $total += $hash->{$_} for @keys; my $p = 0; if($self -> {Percentage}) { $p = $self -> {Percentage} * $total / 100.; } if($self -> {Count}) { if($p < $self -> {Count}) { $p = $self -> {Count}; } } my $l; if($self -> {Limit}) { $l = $self -> {Limit}; } else { $l = scalar(@keys); } @keys = sort { $hash->{$a} <=> $hash->{$b} } @keys; $#keys = $l-1 if $l; @keys = grep { $hash->{$_} > $p } @keys if $p; # could do a binary search at this point @keys = map s{\.pm$}{}, map s{/}{::}, @keys; return \@keys; } sub _process_INC { if($config{"Counting"}) { return grep { $_ !~ m{^Module/Use(/|\.pm)?} && $_ !~ m{^[a-z/]} } keys %counts; } else { return grep { $_ !~ m{^Module/Use(/|\.pm)?} && $_ !~ m{^[a-z/]} } keys %INC; } } sub handler { no strict qw(subs); $_object -> log(_process_INC()) if $_object -> can("log"); return Apache::Constants::OK; } END { # now log %INC $_object -> log(_process_INC()) if $config{log_at_end} && $_object -> can("log"); } 1; __END__ =head1 NAME Module::Use =head1 SYNOPSIS =over 0 =item Perl use Module::Use (Counting, Logger => "Debug"); =item mod_perl use Module::Use (Counting, Logger => "Debug"); PerlChildExitHandler Module::Use PerlCleanupHandler Module::Use PerlLogHandler Module::Use =back =head1 DESCRIPTION Module::Use will record the modules used over the course of the Perl interpreter's lifetime. If the logging module is able, the old logs are read and frequently used modules are automatically loaded. Note that no symbols are imported into packages. Under mod_perl, only one Perl*Handler should be selected, depending on when and how often logging should take place. =head1 OPTIONS The following options are available when Cing this module. =over 4 =item Count This is the number of times a module has been used for it to be automatically loaded. =item Counting This indicates that the number of times a module is Cd should be tracked. This option takes no arguments. N.B.: This will tie %INC. This may not work. Don't use if it doesn't. =item Decay This number is subtracted from the count of all modules that are in the data store but were not loaded. =item Grow This number is added to the count of all modules that were loaded. =item Limit Do not automatically load more than this many modules. =item Logger This is the logging module to use. Configuration is specific to the module chosen. Please see the documentation for the module. The module name is C with C replaced with the value of this option. =item Percentage The percentage of total module loads is used in the same manner as the C. If both C and C are given, the one with the greater counts is used. =back =head1 SEE ALSO L, L, Section 17.7 of _mod_perl Developer's Cookbook_. =head1 AUTHOR James G. Smith =head1 COPYRIGHT Copyright (C) 2002 Texas A&M University. All Rights Reserved. Released under the same license as Perl itself.