Skip to content

Commit

Permalink
Extract getting modules from files.
Browse files Browse the repository at this point in the history 
Bring it all together into one method for getting the modules.
  • Loading branch information
@schwern
schwern committed Feb 19, 2015
1 parent ecb4d4a commit cace0e5
Show file tree
Hide file tree
Showing 2 changed files with 94 additions and 80 deletions.
93 changes: 92 additions & 1 deletion lib/MetaCPAN/Model/Release.pm
View file
Expand Up @@ -11,9 +11,11 @@ use Log::Contextual qw( :log :dlog );
use MetaCPAN::Model::Archive;
use MetaCPAN::Types qw(ArrayRef AbsFile Str);
use MetaCPAN::Util ();
use Module::Metadata 1.000012 (); # Improved package detection.
use Moose;
use MooseX::StrictConstructor;
use Path::Class ();
use Parse::PMFile;
use Try::Tiny;

with 'MetaCPAN::Role::Logger';
Expand Down Expand Up @@ -86,6 +88,21 @@ has metadata => (
builder => '_build_metadata',
);

has modules => (
is => 'ro',
isa => ArrayRef,
lazy => 1,
default => sub {
my $self = shift;
if ( keys %{ $self->metadata->provides } ) {
return $self->_modules_from_meta;
}
else {
return $self->_modules_from_files;
}
},
);

has version => (
is => 'rw',
isa => Str,
Expand Down Expand Up @@ -348,7 +365,7 @@ sub _is_broken_file {
return 0;
}

sub add_modules_from_meta {
sub _modules_from_meta {
my $self = shift;

my @modules;
Expand Down Expand Up @@ -377,5 +394,79 @@ sub add_modules_from_meta {
return \@modules;
}

sub _modules_from_files {
my $self = shift;

my @modules;

my @perl_files = grep { $_->name =~ m{(?:\.pm|\.pm\.PL)\z} }
grep { $_->indexed } @{ $self->files };
foreach my $file (@perl_files) {
if ( $file->name =~ m{\.PL\z} ) {
my $parser = Parse::PMFile->new( $self->metadata->as_struct );

# FIXME: Should there be a timeout on this
# (like there is below for Module::Metadata)?
my $info = $parser->parse( $file->local_path );
next if !$info;

foreach my $module_name ( keys %{$info} ) {
$file->add_module(
{
name => $module_name,
defined $info->{$module_name}->{version}
? ( version => $info->{$module_name}->{version} )
: (),
}
);
}
push @modules, $file;
}
else {
eval {
local $SIG{'ALRM'} = sub {
log_error {'Call to Module::Metadata timed out '};
die;
};
alarm(5);
my $info;
{
local $SIG{__WARN__} = sub { };
$info = Module::Metadata->new_from_file(
$file->local_path );
}

# Ignore packages that people cannot claim.
# https://github.com/andk/pause/blob/master/lib/PAUSE/pmfile.pm#L236
for my $pkg ( grep { $_ ne 'main' && $_ ne 'DB' }
$info->packages_inside )
{
my $version = $info->version($pkg);
$file->add_module(
{
name => $pkg,
defined $version

# Stringify if it's a version object, otherwise fall back to stupid stringification
# Changes in Module::Metadata were causing inconsistencies in the return value,
# we are just trying to survive.
? (
version => ref $version eq 'version'
? $version->stringify
: ( $version . q{} )
)
: ()
}
);
}
push( @modules, $file );
alarm(0);
};
}
}

return \@modules;
}

__PACKAGE__->meta->make_immutable();
1;
81 changes: 2 additions & 79 deletions lib/MetaCPAN/Script/Release.pm
View file
Expand Up @@ -18,9 +18,7 @@ use MetaCPAN::Script::Latest;
use MetaCPAN::Model::Release;
use MetaCPAN::Types qw( Dir );
use MetaCPAN::Util ();
use Module::Metadata 1.000012 (); # Improved package detection.
use Moose;
use Parse::PMFile;
use Path::Class qw(file dir);
use PerlIO::gzip;
use Try::Tiny;
Expand Down Expand Up @@ -207,86 +205,11 @@ sub import_archive {
= [ @{ $associated_pod{$documentation} || [] }, $_ ];
}

# find modules
my $modules;
my $meta = $model->metadata;
if ( keys %{ $meta->provides } ) {
$modules = $model->add_modules_from_meta;
}
else {
my @perl_files = grep { $_->name =~ m{(?:\.pm|\.pm\.PL)\z} }
grep { $_->indexed } @$files;
foreach my $file (@perl_files) {

if ( $file->name =~ m{\.PL\z} ) {

my $parser = Parse::PMFile->new( $meta->as_struct );

# FIXME: Should there be a timeout on this
# (like there is below for Module::Metadata)?
my $info = $parser->parse( $file->local_path );
next if !$info;

foreach my $module_name ( keys %{$info} ) {
$file->add_module(
{
name => $module_name,
defined $info->{$module_name}->{version}
? ( version => $info->{$module_name}->{version} )
: (),
}
);
}
push @$modules, $file;
}

else {

eval {
local $SIG{'ALRM'} = sub {
log_error {'Call to Module::Metadata timed out '};
die;
};
alarm(5);
my $info;
{
local $SIG{__WARN__} = sub { };
$info = Module::Metadata->new_from_file(
$file->local_path );
}

# Ignore packages that people cannot claim.
# https://github.com/andk/pause/blob/master/lib/PAUSE/pmfile.pm#L236
for my $pkg ( grep { $_ ne 'main' && $_ ne 'DB' }
$info->packages_inside )
{
my $version = $info->version($pkg);
$file->add_module(
{
name => $pkg,
defined $version

# Stringify if it's a version object, otherwise fall back to stupid stringification
# Changes in Module::Metadata were causing inconsistencies in the return value,
# we are just trying to survive.
? (
version => ref $version eq "version"
? $version->stringify
: ( $version . '' )
)
: ()
}
);
}
push( @$modules, $file );
alarm(0);
};
}
}
}
my $modules = $model->modules;
log_debug { 'Indexing ', scalar @$modules, ' modules' };
my $document = $model->document;
my $perms = $self->perms;
my $meta = $model->metadata;
my @release_unauthorized;
my @provides;
foreach my $file (@$modules) {
Expand Down

0 comments on commit cace0e5

Please sign in to comment.