r71909 - in /branches/upstream/libmodule-extract-use-perl/current: Changes META.yml README lib/Use.pm t/get_modules.t t/test_manifest
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Wed Mar 23 11:01:38 UTC 2011
Author: jawnsy-guest
Date: Wed Mar 23 11:01:04 2011
New Revision: 71909
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=71909
Log:
[svn-upgrade] new version libmodule-extract-use-perl (0.18)
Modified:
branches/upstream/libmodule-extract-use-perl/current/Changes
branches/upstream/libmodule-extract-use-perl/current/META.yml
branches/upstream/libmodule-extract-use-perl/current/README
branches/upstream/libmodule-extract-use-perl/current/lib/Use.pm
branches/upstream/libmodule-extract-use-perl/current/t/get_modules.t
branches/upstream/libmodule-extract-use-perl/current/t/test_manifest
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=71909&op=diff
==============================================================================
--- branches/upstream/libmodule-extract-use-perl/current/Changes (original)
+++ branches/upstream/libmodule-extract-use-perl/current/Changes Wed Mar 23 11:01:04 2011
@@ -1,8 +1,8 @@
# Changes for Module::Extract::Use
-0.17 - Sat Aug 8 04:18:30 2009
- * Removed failing test checking for empty files. PPI now
- handles those. :(
+0.18 - Mon Mar 21 22:15:34 2011
+ Implemented get_modules_with_details to extract the
+ version and import lists for a use().
0.16 - Wed Jun 10 00:21:12 2009
* Small distro cleanups and new META_MERGE hotness. No need
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=71909&op=diff
==============================================================================
--- branches/upstream/libmodule-extract-use-perl/current/META.yml (original)
+++ branches/upstream/libmodule-extract-use-perl/current/META.yml Wed Mar 23 11:01:04 2011
@@ -1,12 +1,14 @@
--- #YAML:1.0
name: Module-Extract-Use
-version: 0.17
+version: 0.18
abstract: Extract the modules that a modules uses
author:
- brian d foy <bdfoy at cpan.org>
license: perl
distribution_type: module
configure_requires:
+ ExtUtils::MakeMaker: 0
+build_requires:
ExtUtils::MakeMaker: 0
requires:
perl: 5.006
@@ -19,7 +21,7 @@
directory:
- t
- inc
-generated_by: ExtUtils::MakeMaker version 6.48
+generated_by: ExtUtils::MakeMaker version 6.55_02
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
Modified: branches/upstream/libmodule-extract-use-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmodule-extract-use-perl/current/README?rev=71909&op=diff
==============================================================================
--- branches/upstream/libmodule-extract-use-perl/current/README (original)
+++ branches/upstream/libmodule-extract-use-perl/current/README Wed Mar 23 11:01:04 2011
@@ -17,7 +17,7 @@
This module is Github
- http://github.com/briandfoy/module--extract--use/tree/master
+ http://github.com/briandfoy/module-extract-use/tree/master
Enjoy,
Modified: branches/upstream/libmodule-extract-use-perl/current/lib/Use.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmodule-extract-use-perl/current/lib/Use.pm?rev=71909&op=diff
==============================================================================
--- branches/upstream/libmodule-extract-use-perl/current/lib/Use.pm (original)
+++ branches/upstream/libmodule-extract-use-perl/current/lib/Use.pm Wed Mar 23 11:01:04 2011
@@ -7,7 +7,7 @@
use subs qw();
use vars qw($VERSION);
-$VERSION = '0.17';
+$VERSION = '0.18';
=head1 NAME
@@ -18,16 +18,22 @@
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">.
+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
@@ -35,19 +41,18 @@
=item new
-Makes an object. The object doesn't do anything just yet, but you
-need it to call the methods.
-
-=cut
-
-sub 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;
}
@@ -57,8 +62,7 @@
=cut
-sub init
- {
+sub init {
$_[0]->_clear_error;
}
@@ -76,10 +80,46 @@
sub get_modules {
my( $self, $file ) = @_;
- $_[0]->_clear_error;
-
- unless( -e $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;
}
@@ -87,23 +127,52 @@
require PPI;
my $Document = eval { PPI::Document->new( $file ) };
- unless( $Document )
- {
+ unless( $Document ) {
$self->_set_error( ref( $self ) . ": Could not parse file [$file]" );
return;
}
-
- my $modules = $Document->find(
+
+ my $modules = $Document->find(
sub {
- $_[1]->isa( 'PPI::Statement::Include' ) &&
+ $_[1]->isa( 'PPI::Statement::Include' ) &&
( $_[1]->type eq 'use' || $_[1]->type eq 'require' )
}
);
-
+
my %Seen;
- my @modules = grep { ! $Seen{$_}++ } eval { map { $_->module } @$modules };
-
- @modules;
+ 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
@@ -113,7 +182,7 @@
=cut
sub _set_error { $_[0]->{error} = $_[1]; }
-
+
sub _clear_error { $_[0]->{error} = '' }
sub error { $_[0]->{error} }
@@ -122,8 +191,11 @@
=head1 TO DO
-* Make it recursive, so it scans the source for any module that
-it finds.
+=over 4
+
+=item * Make it recursive, so it scans the source for any module that it finds.
+
+=back
=head1 SEE ALSO
@@ -131,9 +203,7 @@
=head1 SOURCE AVAILABILITY
-The source code is in Github:
-
- git://github.com/briandfoy/module--extract--use.git
+The source code is in Github: git://github.com/briandfoy/module-extract-use.git
=head1 AUTHOR
@@ -141,7 +211,7 @@
=head1 COPYRIGHT AND LICENSE
-Copyright (c) 2008-2009, brian d foy, All Rights Reserved.
+Copyright (c) 2008-2011, brian d foy, All Rights Reserved.
You may redistribute this under the same terms as Perl itself.
Modified: branches/upstream/libmodule-extract-use-perl/current/t/get_modules.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmodule-extract-use-perl/current/t/get_modules.t?rev=71909&op=diff
==============================================================================
--- branches/upstream/libmodule-extract-use-perl/current/t/get_modules.t (original)
+++ branches/upstream/libmodule-extract-use-perl/current/t/get_modules.t Wed Mar 23 11:01:04 2011
@@ -1,7 +1,7 @@
#!/usr/bin/perl
use strict;
-use Test::More tests => 13;
+use Test::More tests => 16;
use File::Basename;
use File::Spec::Functions qw(catfile);
@@ -30,11 +30,14 @@
ok( -e $test, "Test file is there" );
my %modules = map { $_, 1 } $extor->get_modules( $test );
+ok( ! $extor->error, "No error for parseable file [$test]");
-foreach my $module ( qw(Test::More File::Basename) )
- {
+foreach my $module ( qw(Test::More File::Basename File::Spec::Functions strict) ) {
ok( exists $modules{$module}, "Found $module" );
- ok( ! $extor->error, "No error for parseable file [$module]")
+ }
+
+foreach my $module ( qw(Foo Bar::Baz) ) {
+ ok( ! exists $modules{$module}, "Didn't find $module" );
}
}
Modified: branches/upstream/libmodule-extract-use-perl/current/t/test_manifest
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmodule-extract-use-perl/current/t/test_manifest?rev=71909&op=diff
==============================================================================
--- branches/upstream/libmodule-extract-use-perl/current/t/test_manifest (original)
+++ branches/upstream/libmodule-extract-use-perl/current/t/test_manifest Wed Mar 23 11:01:04 2011
@@ -2,3 +2,5 @@
pod.t
pod_coverage.t
get_modules.t
+imports.t
+versions.t
More information about the Pkg-perl-cvs-commits
mailing list