r72832 - in /branches/upstream/libmodule-extract-use-perl/current: ./ corpus/ examples/ lib/ lib/Module/ lib/Module/Extract/ t/
jotamjr-guest at users.alioth.debian.org
jotamjr-guest at users.alioth.debian.org
Wed Apr 20 02:43:39 UTC 2011
Author: jotamjr-guest
Date: Wed Apr 20 02:43:12 2011
New Revision: 72832
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=72832
Log:
[svn-upgrade] new version libmodule-extract-use-perl (1.01)
Added:
branches/upstream/libmodule-extract-use-perl/current/corpus/PackageImports.pm
branches/upstream/libmodule-extract-use-perl/current/corpus/PackageVersion.pm
branches/upstream/libmodule-extract-use-perl/current/lib/Module/
branches/upstream/libmodule-extract-use-perl/current/lib/Module/Extract/
branches/upstream/libmodule-extract-use-perl/current/lib/Module/Extract/Use.pm
branches/upstream/libmodule-extract-use-perl/current/t/imports.t (with props)
branches/upstream/libmodule-extract-use-perl/current/t/versions.t (with props)
Removed:
branches/upstream/libmodule-extract-use-perl/current/lib/Use.pm
Modified:
branches/upstream/libmodule-extract-use-perl/current/Changes
branches/upstream/libmodule-extract-use-perl/current/MANIFEST
branches/upstream/libmodule-extract-use-perl/current/META.yml
branches/upstream/libmodule-extract-use-perl/current/Makefile.PL
branches/upstream/libmodule-extract-use-perl/current/examples/extract_modules
Modified: branches/upstream/libmodule-extract-use-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmodule-extract-use-perl/current/Changes?rev=72832&op=diff
==============================================================================
--- branches/upstream/libmodule-extract-use-perl/current/Changes (original)
+++ branches/upstream/libmodule-extract-use-perl/current/Changes Wed Apr 20 02:43:12 2011
@@ -1,4 +1,9 @@
# Changes for Module::Extract::Use
+
+1.01 - Wed Mar 30 22:28:30 2011
+ * Promote to a stable version
+ * Some files moved around, and I updated the copyright statements
+ for downstream ease.
0.18 - Mon Mar 21 22:15:34 2011
Implemented get_modules_with_details to extract the
Modified: branches/upstream/libmodule-extract-use-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmodule-extract-use-perl/current/MANIFEST?rev=72832&op=diff
==============================================================================
--- branches/upstream/libmodule-extract-use-perl/current/MANIFEST (original)
+++ branches/upstream/libmodule-extract-use-perl/current/MANIFEST Wed Apr 20 02:43:12 2011
@@ -1,14 +1,18 @@
Changes
+corpus/PackageImports.pm
+corpus/PackageVersion.pm
corpus/Repeated.pm
examples/extract_modules
-lib/Use.pm
+lib/Module/Extract/Use.pm
LICENSE
Makefile.PL
MANIFEST This list of files
README
t/get_modules.t
+t/imports.t
t/load.t
t/pod.t
t/pod_coverage.t
t/test_manifest
+t/versions.t
META.yml Module meta-data (added by MakeMaker)
Modified: branches/upstream/libmodule-extract-use-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmodule-extract-use-perl/current/META.yml?rev=72832&op=diff
==============================================================================
--- branches/upstream/libmodule-extract-use-perl/current/META.yml (original)
+++ branches/upstream/libmodule-extract-use-perl/current/META.yml Wed Apr 20 02:43:12 2011
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Module-Extract-Use
-version: 0.18
+version: 1.01
abstract: Extract the modules that a modules uses
author:
- brian d foy <bdfoy at cpan.org>
Modified: branches/upstream/libmodule-extract-use-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmodule-extract-use-perl/current/Makefile.PL?rev=72832&op=diff
==============================================================================
--- branches/upstream/libmodule-extract-use-perl/current/Makefile.PL (original)
+++ branches/upstream/libmodule-extract-use-perl/current/Makefile.PL Wed Apr 20 02:43:12 2011
@@ -7,7 +7,7 @@
WriteMakefile(
'NAME' => 'Module::Extract::Use',
'ABSTRACT' => 'Extract the modules that a modules uses',
- 'VERSION_FROM' => 'lib/Use.pm',
+ 'VERSION_FROM' => 'lib/Module/Extract/Use.pm',
'LICENSE' => 'perl',
'AUTHOR' => 'brian d foy <bdfoy at cpan.org>',
@@ -15,10 +15,6 @@
'PPI' => '0',
'Test::More' => '0',
'Test::Output' => '0',
- },
-
- 'PM' => {
- 'lib/Use.pm' => '$(INST_LIBDIR)/Use.pm',
},
(
@@ -36,10 +32,6 @@
:
()
),
-
- 'MAN3PODS' => {
- 'lib/Use.pm' => '$(INST_MAN3DIR)/Module::Extract::Use.$(MAN3EXT)',
- },
clean => { FILES => q|Module-Extract-Use-*| },
Added: branches/upstream/libmodule-extract-use-perl/current/corpus/PackageImports.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmodule-extract-use-perl/current/corpus/PackageImports.pm?rev=72832&op=file
==============================================================================
--- branches/upstream/libmodule-extract-use-perl/current/corpus/PackageImports.pm (added)
+++ branches/upstream/libmodule-extract-use-perl/current/corpus/PackageImports.pm Wed Apr 20 02:43:12 2011
@@ -1,0 +1,14 @@
+use URI;
+use CGI qw(:standard);
+use LWP::Simple 1.23 qw(getstore);
+use File::Basename ('basename', 'dirname');
+use File::Spec::Functions qw(catfile rel2abs);
+use autodie ':open';
+use strict q'refs';
+use warnings q<redefine>;
+use Buster "brush";
+use Mimi qq{string};
+
+my $cat = 'Buster';
+
+1;
Added: branches/upstream/libmodule-extract-use-perl/current/corpus/PackageVersion.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmodule-extract-use-perl/current/corpus/PackageVersion.pm?rev=72832&op=file
==============================================================================
--- branches/upstream/libmodule-extract-use-perl/current/corpus/PackageVersion.pm (added)
+++ branches/upstream/libmodule-extract-use-perl/current/corpus/PackageVersion.pm Wed Apr 20 02:43:12 2011
@@ -1,0 +1,9 @@
+use HTTP::Size 1.23;
+use 5.013;
+
+use YAML::Syck 1.54 qw(LoadFile);
+use LWP::Simple 6.1 qw(getstore);
+
+my $cat = 'Buster';
+
+1;
Modified: branches/upstream/libmodule-extract-use-perl/current/examples/extract_modules
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmodule-extract-use-perl/current/examples/extract_modules?rev=72832&op=diff
==============================================================================
--- branches/upstream/libmodule-extract-use-perl/current/examples/extract_modules (original)
+++ branches/upstream/libmodule-extract-use-perl/current/examples/extract_modules Wed Apr 20 02:43:12 2011
@@ -35,8 +35,7 @@
=cut
# if no parameters are passed, give usage information
-unless( @ARGV )
- {
+unless( @ARGV ) {
pod2usage( msg => 'Please supply at least one filename to analyze' );
exit;
}
@@ -48,8 +47,7 @@
Module::ExtractUse extract_use
);
-foreach my $module ( @classes )
- {
+foreach my $module ( @classes ) {
eval "require $module";
next if $@;
( $object, $method ) = ( $module->new, $methods{$module} );
@@ -58,10 +56,8 @@
die "No usable file scanner module found; exiting...\n" unless defined $object;
-foreach my $file ( @ARGV )
- {
- unless ( -r $file )
- {
+foreach my $file ( @ARGV ) {
+ unless ( -r $file ) {
printf STDERR "Could not read $file\n";
next;
}
@@ -73,16 +69,14 @@
BEGIN {
my $corelist = eval { require Module::CoreList };
-sub dump_list
- {
+sub dump_list {
my( $file, @modules ) = @_;
printf "Modules required by %s:\n", $file;
my( $core, $extern ) = ( 0, 0 );
- foreach my $module ( @modules )
- {
+ foreach my $module ( @modules ) {
printf " - $module%s\n",
$corelist
?
@@ -108,7 +102,7 @@
=head1 COPYRIGHT & LICENSE
-Copyright 2009 by Jonathan Yu <frequency at cpan.org>
+Copyright 2009 by brian d foy <bdfoy at cpan.org>
You can use this script under the same terms as Perl itself.
Added: branches/upstream/libmodule-extract-use-perl/current/lib/Module/Extract/Use.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmodule-extract-use-perl/current/lib/Module/Extract/Use.pm?rev=72832&op=file
==============================================================================
--- branches/upstream/libmodule-extract-use-perl/current/lib/Module/Extract/Use.pm (added)
+++ branches/upstream/libmodule-extract-use-perl/current/lib/Module/Extract/Use.pm Wed Apr 20 02:43:12 2011
@@ -1,0 +1,222 @@
+package Module::Extract::Use;
+use strict;
+
+use warnings;
+no warnings;
+
+use subs qw();
+use vars qw($VERSION);
+
+$VERSION = '1.01';
+
+=head1 NAME
+
+Module::Extract::Use - Pull out the modules a module uses
+
+=head1 SYNOPSIS
+
+ use Module::Extract::Use;
+
+ my $extor = Module::Extract::Use->new;
+
+ my @modules = $extor->get_modules( $file );
+ if( $extor->error ) { ... }
+
+ my @details = $extor->get_modules_with_details( $file );
+ foreach my $detail ( @details ) {
+ printf "%s %s imports %s\n",
+ $detail->module, $detail->version,
+ join ' ', @{ $detail->imports }
+ }
+
+=head1 DESCRIPTION
+
+Extract the names of the modules used in a file using a static
+analysis. Since this module does not run code, it cannot find dynamic
+uses of modules, such as C<eval "require $class">.
+
+=cut
+
+=over 4
+
+=item new
+
+Makes an object. The object doesn't do anything just yet, but you need
+it to call the methods.
+
+=cut
+
+sub new {
+ my $class = shift;
+
+ my $self = bless {}, $class;
+
+ $self->init;
+
+ $self;
+ }
+
+=item init
+
+Set up the object. You shouldn't need to call this yourself.
+
+=cut
+
+sub init {
+ $_[0]->_clear_error;
+ }
+
+=item get_modules( FILE )
+
+Returns a list of namespaces explicity use-d in FILE. Returns undef if the
+file does not exist or if it can't parse the file.
+
+Each used namespace is only in the list even if it is used multiple times
+in the file. The order of the list does not correspond to anything so don't
+use the order to infer anything.
+
+=cut
+
+sub get_modules {
+ my( $self, $file ) = @_;
+
+ $self->_clear_error;
+
+ my $details = $self->get_modules_with_details( $file );
+ return unless defined $details;
+
+ my @modules =
+ map { $_->{module} }
+ @$details;
+ }
+
+=item get_modules_with_details( FILE )
+
+Returns a list of hash references, one reference for each namespace
+explicitly use-d in FILE. Each reference has keys for:
+
+ namespace - the namespace, always defined
+ version - defined if a module version was specified
+ imports - an array reference to the import list
+
+Each used namespace is only in the list even if it is used multiple
+times in the file. The order of the list does not correspond to
+anything so don't use the order to infer anything.
+
+=cut
+
+sub get_modules_with_details {
+ my( $self, $file ) = @_;
+
+ $self->_clear_error;
+
+ my $modules = $self->_get_ppi_for_file( $file );
+ return unless defined $modules;
+
+ $modules;
+ }
+
+sub _get_ppi_for_file {
+ my( $self, $file ) = @_;
+
+ unless( -e $file ) {
+ $self->_set_error( ref( $self ) . ": File [$file] does not exist!" );
+ return;
+ }
+
+ require PPI;
+
+ my $Document = eval { PPI::Document->new( $file ) };
+ unless( $Document ) {
+ $self->_set_error( ref( $self ) . ": Could not parse file [$file]" );
+ return;
+ }
+
+ my $modules = $Document->find(
+ sub {
+ $_[1]->isa( 'PPI::Statement::Include' ) &&
+ ( $_[1]->type eq 'use' || $_[1]->type eq 'require' )
+ }
+ );
+
+ return unless $modules;
+
+ my %Seen;
+ my @modules =
+ grep { ! $Seen{ $_->{module} }++ && $_->{module} }
+ map {
+ my $hash = {
+ pragma => $_->pragma,
+ module => $_->module,
+ imports => [ $self->_list_contents( $_->arguments ) ],
+ version => eval{ $_->module_version->literal || ( undef ) },
+ };
+ } @$modules;
+
+ return \@modules;
+ }
+
+sub _list_contents {
+ my( $self, $node ) = @_;
+
+ eval {
+ if( ! defined $node ) {
+ return;
+ }
+ elsif( $node->isa( 'PPI::Token::QuoteLike::Words' ) ) {
+ ( $node->literal )
+ }
+ elsif( $node->isa( 'PPI::Structure::List' ) ) {
+ my $nodes = $node->find( sub{ $_[1]->isa( 'PPI::Token::Quote' ) } );
+ map { $_->string } @$nodes;
+ }
+ elsif( $node->isa( 'PPI::Token::Quote' ) ) {
+ ( $node->string );
+ }
+ };
+
+ }
+
+=item error
+
+Return the error from the last call to C<get_modules>.
+
+=cut
+
+sub _set_error { $_[0]->{error} = $_[1]; }
+
+sub _clear_error { $_[0]->{error} = '' }
+
+sub error { $_[0]->{error} }
+
+=back
+
+=head1 TO DO
+
+=over 4
+
+=item * Make it recursive, so it scans the source for any module that it finds.
+
+=back
+
+=head1 SEE ALSO
+
+L<Module::ScanDeps>
+
+=head1 SOURCE AVAILABILITY
+
+The source code is in Github: git://github.com/briandfoy/module-extract-use.git
+
+=head1 AUTHOR
+
+brian d foy, C<< <bdfoy at cpan.org> >>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (c) 2008-2011, brian d foy, All Rights Reserved.
+
+You may redistribute this under the same terms as Perl itself.
+
+=cut
+
+1;
Added: branches/upstream/libmodule-extract-use-perl/current/t/imports.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmodule-extract-use-perl/current/t/imports.t?rev=72832&op=file
==============================================================================
--- branches/upstream/libmodule-extract-use-perl/current/t/imports.t (added)
+++ branches/upstream/libmodule-extract-use-perl/current/t/imports.t Wed Apr 20 02:43:12 2011
@@ -1,0 +1,114 @@
+#!/usr/bin/perl
+use strict;
+
+use Test::More tests => 6;
+use File::Basename;
+use File::Spec::Functions qw(catfile);
+
+my $class = "Module::Extract::Use";
+use_ok( $class );
+
+my $extor = $class->new;
+isa_ok( $extor, $class );
+can_ok( $extor, 'get_modules_with_details' );
+
+
+# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
+# Try it with a file that has repeated use lines
+# I should only get unique names
+{
+my $file = catfile( qw(corpus PackageImports.pm) );
+ok( -e $file, "Test file [$file] is there" );
+
+my $details = $extor->get_modules_with_details( $file );
+is( scalar @$details, 10, 'There are the right number of hits' );
+
+is_deeply( $details, expected(), 'The data structures match' );
+}
+
+
+sub expected {
+ return [
+ {
+ 'pragma' => '',
+ 'version' => undef,
+ 'imports' => [],
+ 'module' => 'URI'
+ },
+ {
+ 'pragma' => '',
+ 'version' => undef,
+ 'imports' => [
+ ':standard'
+ ],
+ 'module' => 'CGI'
+ },
+ {
+ 'pragma' => '',
+ 'version' => '1.23',
+ 'imports' => [
+ 'getstore'
+ ],
+ 'module' => 'LWP::Simple'
+ },
+ {
+ 'pragma' => '',
+ 'version' => undef,
+ 'imports' => [
+ 'basename',
+ 'dirname'
+ ],
+ 'module' => 'File::Basename'
+ },
+ {
+ 'pragma' => '',
+ 'version' => undef,
+ 'imports' => [
+ 'catfile',
+ 'rel2abs'
+ ],
+ 'module' => 'File::Spec::Functions'
+ },
+ {
+ 'pragma' => 'autodie',
+ 'version' => undef,
+ 'imports' => [
+ ':open'
+ ],
+ 'module' => 'autodie'
+ },
+ {
+ 'pragma' => 'strict',
+ 'version' => undef,
+ 'imports' => [
+ 'refs'
+ ],
+ 'module' => 'strict'
+ },
+ {
+ 'pragma' => 'warnings',
+ 'version' => undef,
+ 'imports' => [
+ 'redefine'
+ ],
+ 'module' => 'warnings'
+ },
+ {
+ 'pragma' => '',
+ 'version' => undef,
+ 'imports' => [
+ 'brush'
+ ],
+ 'module' => 'Buster'
+ },
+ {
+ 'pragma' => '',
+ 'version' => undef,
+ 'imports' => [
+ 'string'
+ ],
+ 'module' => 'Mimi'
+ }
+ ];
+
+ }
Propchange: branches/upstream/libmodule-extract-use-perl/current/t/imports.t
------------------------------------------------------------------------------
svn:executable = *
Added: branches/upstream/libmodule-extract-use-perl/current/t/versions.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmodule-extract-use-perl/current/t/versions.t?rev=72832&op=file
==============================================================================
--- branches/upstream/libmodule-extract-use-perl/current/t/versions.t (added)
+++ branches/upstream/libmodule-extract-use-perl/current/t/versions.t Wed Apr 20 02:43:12 2011
@@ -1,0 +1,53 @@
+#!/usr/bin/perl
+use strict;
+
+use Test::More tests => 6;
+use File::Basename;
+use File::Spec::Functions qw(catfile);
+
+my $class = "Module::Extract::Use";
+use_ok( $class );
+
+my $extor = $class->new;
+isa_ok( $extor, $class );
+can_ok( $extor, 'get_modules_with_details' );
+
+
+# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
+# Try it with a file that has repeated use lines
+# I should only get unique names
+{
+my $file = catfile( qw(corpus PackageVersion.pm) );
+ok( -e $file, "Test file [$file] is there" );
+
+my $details = $extor->get_modules_with_details( $file );
+is( scalar @$details, 3 );
+
+is_deeply( $details, expected() );
+print Dumper( $details ), "\n"; use Data::Dumper;
+}
+
+
+sub expected {
+ return [
+ {
+ 'pragma' => '',
+ 'version' => '1.23',
+ 'imports' => [],
+ 'module' => 'HTTP::Size'
+ },
+ {
+ 'pragma' => '',
+ 'version' => '1.54',
+ 'imports' => [ qw(LoadFile) ],
+ 'module' => 'YAML::Syck'
+ },
+ {
+ 'pragma' => '',
+ 'version' => '6.1',
+ 'imports' => [ qw(getstore) ],
+ 'module' => 'LWP::Simple'
+ }
+ ];
+
+ }
Propchange: branches/upstream/libmodule-extract-use-perl/current/t/versions.t
------------------------------------------------------------------------------
svn:executable = *
More information about the Pkg-perl-cvs-commits
mailing list