Commit caefae6d authored by Peter Pentchev's avatar Peter Pentchev

[svn-inject] Installing original source of libmodule-extractuse-perl

use strict;
use 5.008;
use Module::Build;
use File::Spec::Functions;
my $build = Module::Build->new(
module_name => 'Module::ExtractUse',
license => 'perl',
requires => {
'perl' => '5.008',
build_requires=> {
# Changes for Module::ExtractUse
- autogenerate the grammer during ./Build
- take a look at 'use parent'
0.23 2008-04-26 22:14:28
- fixed bug regarding 'use utf8' which was interpreted as 'utf'
0.22 2007-11-16
- added 'use warnings' again to the Grammer... grr, stupid grammer
0.21 2007-11-14
- fixed Bug reported by hanekomu via IRC:
Modules::ExtractUse breaks if it is used with UNIVERSAL::require
so I renamed the grammer tokens 'use' and 'require'. No API changes,
but if you use the grammer directly, you'll have to adapt to the new
names ('token_use' and 'token_reqire')
0.20 2007-11-07
- resolved RT #30414 by applying the patch submitted by
David Landgren
- rearranged code to better fit my current Perl style
- added 'use warnings' to Module::ExtractUse::Grammer for that
extra kwalitee point
0.19 2007-04-21
- resolved RT #22953 reported by David R Throop
documentation error in SYNOPSIS
- resolved RT #24066 reported by Jose Pedro Oliveira
license clarification
- some doc cleanup
- added more Test modules to build_requires
- no actual code changes where done in this release
0.18 2006-06-19
- resolved [ #19302] reported by
(thanks for the hint!)
we can now handle stuff like:
my $ver=1.22;
eval "use Test::Pod $ver;"
- moved Test::* prereq into build_requires
0.17 2005-11-07
- switched to new Changes format
- updated dependencies (Pod::Strip instead of Pod::Simple)
0.16 2005-09-01
- added test provided by BRICAS (thanks a lot)
- removed bug reported by BRICAS
- updated docs and various stuff
- find uses in eval
0.15 2004-10-01
- use Pod::Strip instead of Pod::Simple subclass hack
- added accessor method C<files>
- updated docs
- added t/pod.t and t/pod_coverage.t
- adapted test suite to new data structure / accessors
- resolved ticket #7013 "Parser should remember previously
scanned modules" (Michael G. Schwern) by shuffling various data
structures around
- switched to Module::Build
0.11 2004-07-20
- resolved ticket #7012 "uses preceded by a comment can be
ignored" by applying the patch by Michael G. Schwern. Thanks!
0.10 2003-06-08
- accelerated the parsing:
- Parse a statement instead of a whole module
- Befor parsing, check with a regex if the statement
contains 'use' or 'require'
- Enhanced grammer (thanks to $::RD_TRACE)
0.5 2003-04-18
- added precompilation of grammar to Makefile.PL
- changed @found to @::found
- init @::found in start-rule instead via startup-action
0.3 2003-03-31
- sort of working
name: Module-ExtractUse
version: 0.23
- 'Thomas Klausner <>'
abstract: Find out what modules are used
license: perl
Parse::RecDescent: 1.94
Pod::Strip: 1.00
perl: 5.008
Test::Deep: 0.087
Test::More: 0
Test::NoWarnings: 0
Test::Pod: 0
Test::Pod::Coverage: 0
UNIVERSAL::require: 0
file: lib/Module/
version: 0.23
file: lib/Module/ExtractUse/
file: lib/Module/ExtractUse/
generated_by: Module::Build version 0.280801
version: 1.2
# Note: this file was auto-generated by Module::Build::Compat version 0.2808_01
require 5.008;
unless (eval "use Module::Build::Compat 0.02; 1" ) {
print "This module requires Module::Build to install itself.\n";
require ExtUtils::MakeMaker;
my $yn = ExtUtils::MakeMaker::prompt
(' Install Module::Build now from CPAN?', 'y');
unless ($yn =~ /^y/i) {
die " *** Cannot install without Module::Build. Exiting ...\n";
require Cwd;
require File::Spec;
require CPAN;
# Save this 'cause CPAN will chdir all over the place.
my $cwd = Cwd::cwd();
CPAN::Shell->expand("Module", "Module::Build::Compat")->uptodate
or die "Couldn't install Module::Build, giving up.\n";
chdir $cwd or die "Cannot chdir() back to $cwd: $!";
eval "use Module::Build::Compat 0.02; 1" or die $@;
Module::Build::Compat->run_build_pl(args => \@ARGV);
require Module::Build;
Module::Build::Compat->write_makefile(build_class => 'Module::Build');
Module/ExtractUse version 0.04
Module::ExtractUse is basically a Parse::RecDescent grammar to parse
Perl code. It tries very hard to find all modules (whether pragmas,
Core, or from CPAN) used by the parsed code.
To install this module type the following:
perl Makefile.PL
make test
make install
This module requires these other modules and libraries:
Test::More (only for the testsuite)
Copyright (C) 2003 Thomas Klausner
# TODO for Module::ExtractUse
# $Rev$
# $Date$
# for release 0.17
#!/usr/bin/perl -w
use strict;
use CPANPLUS::Backend;
use File::Find;
use Module::ExtractUse;
my $cp=new CPANPLUS::Backend;
my $filter=shift @ARGV || '^Class::DBI$';
my $hide_own=1;
my $mod_search=$cp->search(type=>'module',
list => [$filter]);
my %seen;
foreach my $module (values %{$mod_search}) {
my $package=$module->package;
next unless $package;
next if $seen{$package}++;
print "*** CHECKING DISTRIBUTION $package\n";
$module->fetch || next;
my $extracted_to=$module->extract;
sub find_pms {
return unless /\.pm$/;
return if $File::Find::dir=~m|/t/|;
my $p=Module::ExtractUse->new;
my @used=$p->extract_use($_)->array;
print "\n$File::Find::dir $_\n * ";
print join("\n * ",@used),"\n";;
package Module::ExtractUse;
use strict;
use warnings;
use 5.008;
use Pod::Strip;
use Parse::RecDescent;
use Module::ExtractUse::Grammar;
use Carp;
use version; our $VERSION=version->new('0.23');
=head1 NAME
Module::ExtractUse - Find out what modules are used
use Module::ExtractUse;
# get a parser
my $p=Module::ExtractUse->new;
# parse from a file
# or parse from a ref to a string in memory
# use some reporting methods
my $used=$p->used; # $used is a HASHREF
print $p->used('strict') # true if code includes 'use strict'
my @used=$p->array;
my $used=$p->string;
Module::ExtractUse is basically a Parse::RecDescent grammar to parse
Perl code. It tries very hard to find all modules (whether pragmas,
Core, or from CPAN) used by the parsed code.
"Usage" is defined by either calling C<use> or C<require>.
=head2 Methods
=head3 new
my $p=Module::ExtractUse->new;
Returns a parser object
sub new {
my $class=shift;
return bless {
=head3 extract_use
Runs the parser.
C<$code_to_parse> can be either a SCALAR, in which case
Module::ExtractUse tries to open the file specified in
$code_to_parse. Or a reference to a SCALAR, in which case
Module::ExtractUse assumes the referenced scalar contains the source
The code will be stripped from POD (using Pod::Strip) and splitted on ";"
(semicolon). Each statement (i.e. the stuff between two semicolons) is
checked by a simple regular expression.
If the statement contains either 'use' or 'require', the statment is
handed over to the parser, who then tries to figure out, B<what> is
used or required. The results will be saved in a data structure that
you can examine afterwards.
You can call C<extract_use> several times on different files. It will
count how many files where examined and how often each module was used.
sub extract_use {
my $self=shift;
my $code_to_parse=shift;
my $podless;
my $pod_parser=Pod::Strip->new;
if (ref($code_to_parse) eq 'SCALAR') {
else {
# Strip obvious comments.
$podless =~ s/^\s*#.*$//mg;
# to keep parsing time short, split code in statements
# (I know that this is not very exact, patches welcome!)
my @statements=split(/;/,$podless);
foreach my $statement (@statements) {
$statement=~s/\n+/ /gs;
my $result;
# check for string eval in ' ', " " strings
if ($statement !~ s/eval\s+(['"])(.*?)\1/$2;/) {
# if that didn't work, try q and qq strings
if ($statement !~ s/eval\s+qq?(\S)(.*?)\1/$2;/) {
# finally try paired delims like qq< >, q( ), ...
my %pair = qw| ( ) [ ] { } < > |;
while (my ($l, $r) = map {quotemeta} each %pair) {
last if $statement =~ s/eval\s+qq?$l(.*?)$r/$1;/;
# now that we've got some code containing 'use' or 'require',
# parse it! (using different entry point to save some more
# time)
if ($statement=~/\buse/) {
eval {
my $parser=Module::ExtractUse::Grammar->new();
elsif ($statement=~/\brequire/) {
eval {
my $parser=Module::ExtractUse::Grammar->new();
next unless $result;
foreach (split(/ /,$result)) {
# increment file counter
return $self;
=head2 Accessor Methods
Those are various ways to get at the result of the parse.
Note that C<extract_use> returns the parser object, so you can say
print $p->extract_use($code_to_parse)->string;
=head3 used
my $used=$p->used; # $used is a HASHREF
print $p->used('strict') # true if code includes 'use strict'
If called without an argument, returns a reference to an hash of all
used modules. Keys are the names of the modules, values are the number
of times they were used.
If called with an argument, looks up the value of the argument in the
hash and returns the number of times it was found during parsing.
This is the prefered accessor.
sub used {
my $self=shift;
my $key=shift;
return $self->{found}{$key} if ($key);
return $self->{found};
=head3 string
print $p->string($seperator)
Returns a sorted string of all used modules, joined using the value of
C<$seperator> or using a blank space as a default;
Module names are sorted by ascii value (i.e by C<sort>)
sub string {
my $self=shift;
my $sep=shift || ' ';
return join($sep,sort keys(%{$self->{found}}));
=head3 array
my @array = $p->array;
Returns an array of all used modules.
sub array {
return keys(%{shift->{found}})
=head3 arrayref
my $arrayref = $p->arrayref;
Returns a reference to an array of all used modules. Surprise!
sub arrayref {
my @a=shift->array;
return \@a if @a;
=head3 files
Returns the number of files parsed by the parser object.
sub files {
return shift->{files};
# Internal Accessor Methods
sub _add {
my $self=shift;
my $found=shift;
sub _found {
return shift->{found}
sub _inc_files {
If - for some reasons - you need to alter the grammar, edit the file
F<grammar> and afterwards run:
perl -MParse::RecDescent - grammar Module::ExtractUse::Grammar
Make sure you're in the right directory, i.e. in F<.../Module/ExtractUse/>
=head1 EXPORTS
=head1 SEE ALSO
Parse::RecDescent, Module::ScanDeps, Module::Info, Module::CPANTS::Analyse
=head1 AUTHOR
Thomas Klausner <>
=head1 BUGS
Please report any bugs or feature requests to
C<>, or through the web interface at
L<>. I will be notified, and then you'll automatically
be notified of progress on your bug as I make changes.
=head1 LICENSE
Module::ExtractUse is Copyright (c) 2003-2008, Thomas Klausner.
You may use and distribute this module according to the same terms
that Perl is distributed under.
This diff is collapsed.
# Rules for use
token_use: /\buse\s/ use_stuff ';'
{ $return=$item{use_stuff} }
use_stuff: (base | pragma | version | module)
base: "base" import_list
pragma: /[a-z\d]+/ import_list
{ $return=$item[1]}
module: module_name module_more
{ $return=$item{module_name} }
module_name: /[\w:]+/
module_more: eos | version(?) var(?) import_list(?)
# Rules for require
token_require: /\brequire\s/ require_stuff ';'
{ $return=$item{require_stuff} }
require_stuff: (version | require_name | module)
require_name: <perl_quotelike>
{ my $name=$item[1][2];
return 1 if ($name=~/\.pl$/);
# General Rules
version: /[\d\._v]+/
eos: { $text=~/^[\s;]+$/ ? 1 : undef;}
var: /\$[\w+]/
import_list: /[(]?/
{ $return=$item[2];
$return.=" ".join(" ",@{$item[3]}) if $item[3];
list_item: <perl_quotelike> { $return=$item[1][2] }
/\w+/ { $return=$item[1] }
comma_list_item: comma list_item
{ $return=$item{list_item} }
comma: (',' | '=>')
#!/usr/bin/perl -w
use strict;
use Test::More tests=>2;
#!/usr/bin/perl -w
use strict;
use Test::More;
use Test::Deep;
use Test::NoWarnings;
use Module::ExtractUse;
my @tests=
['use Some::Module2;',[qw(Some::Module2)]],
["yadda yadda useless stuff;".'use Some::Module3 qw/$VERSION @EXPORT @EXPORT_OK/;',[qw(Some::Module3)]],
['use base qw(Class::DBI4 Foo::Bar5);',[qw(Class::DBI4 Foo::Bar5)]],
['if ($foo) { use Foo::Bar6; }',[qw(Foo::Bar6)]],
['use constant dl_ext => ".$Config{dlext}";',[qw(constant)]],
['use strict;',[qw(strict)]],
['use Foo8 qw/asdfsdf/;',[qw(Foo8)]],
['abuse Stuff;',undef],
['package Module::ScanDeps;',undef],
['if ($foo) { require "Bar7"; }',[qw(Bar7)]],
['require "some/";',undef],
['require "Foo/Bar.pm9";',[qw(Foo::Bar9)]],
['require Foo10;',['Foo10']],
["use Some::Module11;use Some::Other::Module12;",[qw(Some::Module11 Some::Other::Module12)]],
["use Some::Module;\nuse Some::Other::Module;",[qw(Some::Module Some::Other::Module)]],
['use vars qw/$VERSION @EXPORT @EXPORT_OK/;',[qw(vars)]],
['unless ref $obj; # use ref as $obj',undef],
['$self->_carp("$name trigger deprecated: use before_$name or after_$name instead");',undef],
["use base 'Exporter1';",['Exporter1']],
['use base ("Class::DBI2");',['Class::DBI2']],
['use base "Class::DBI3";',['Class::DBI3']],
['use base qw/Class::DBI4 Foo::Bar5/;',[qw(Class::DBI4 Foo::Bar5)]],
['use base ("Class::DBI6","Foo::Bar7");',[qw(Class::DBI6 Foo::Bar7)]],
['use base "Class::DBI8","Foo::Bar9";',[qw(Class::DBI8 Foo::Bar9)]],
['eval "use Test::Pod 1.06";',['Test::Pod']],
[q{#!/usr/bin/perl -w
use strict;
use Test::More;
eval "use Test::Pod 1.06";
eval 'use Test::Pod::Coverage 1.06;';
plan skip_all => "Test::Pod 1.06 required for testing POD" if $@;
all_pod_files_ok();},[qw(strict Test::More Test::Pod Test::Pod::Coverage)]],
plan tests => (scalar @tests)+1;
foreach my $t (@tests) {
my ($code,$expected)=@$t;
my $p=Module::ExtractUse->new;
my $used=$p->extract_use(\$code)->arrayref;
if (ref($expected) eq 'ARRAY') {
} elsif (!defined $expected) {
} else {
#!/usr/bin/perl -w
use strict;
use Test::More tests=>5;
use Test::Deep;
use Test::NoWarnings;