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 C