File Coverage

blib/lib/Git/CPAN/Patch/Release.pm

Criterion	Covered	Total	%
statement	27	29	93.1
branch			n/a
condition			n/a
subroutine	9	10	90.0
pod	0	1	0.0
total	36	40	90.0

package Git::CPAN::Patch::Release;
our $AUTHORITY = 'cpan:YANICK';
$Git::CPAN::Patch::Release::VERSION = '2.3.1';
use strict;
use warnings;
use Method::Signatures::Simple;
use File::chdir;
use Archive::Any;
use Path::Tiny;
use File::Temp qw/ tempdir tempfile /;
use version;

use Moose;

has tmpdir => (
  is => 'ro',
  isa => 'Path::Tiny',
  lazy => 1,
  default => sub {
    return Path::Tiny->tempdir();
  }
);

has author_name => (
    is => 'ro',
    isa => 'Str',
    lazy => 1,
    default => sub {
        my $self = shift;

        if ( $self->meta_info ) {
            my $author = $self->meta_info->{metadata}{author};
            $author = $author->[0] if ref $author;

            if ( !$author or  $author eq 'unknown' ) {
                $author = $self->meta_info->{author};
            }

            return $author =~ /^\s*(.*?)\s*</ ? $1 : $author if $author;
        }

        return $self->author_cpan || 'unknown';
    },
);

has author_cpan => (
    is => 'ro',
    isa => 'Maybe[Str]',
    lazy => 1,
    default => sub {
        my $author = eval{$_[0]->meta_info->{author}};
        $author = ref $author ? $author->[0] : $author;
        $author = uc($1) if $author =~ /<?(\S+)\@cpan\.org/i;
        return $author;
    },
);

has author_email => (
    is => 'ro',
    isa => 'Maybe[Str]',
    predicate => 'has_author_email',
    lazy => 1,
    default => sub {
        my $self = shift;

        if ( $self->meta_info ) {
            my $author = $self->meta_info->{metadata}{author} || $self->meta_info->{author};
            $author = $author->[0] if ref $author;
            return $1 if $author =~ /<(.*?)>\s*$/;
        }
        return $self->author_cpan . '@cpan.org';
    },
);

sub author_sig {
    my $self = shift;

    return sprintf "%s <%s>", $self->author_name, $self->author_email;
}

has download_url => (
    is => 'ro',
    isa => 'Str',
    lazy => 1,
    default => sub {
        my $self = shift;
        return $self->meta_info && $self->meta_info->{download_url};
    },
);

has date => (
    is => 'ro',
    isa => 'Maybe[Str]',
    lazy => 1,
    default => sub {
        my $self = shift;
        return $self->meta_info && $self->meta_info->{date};
    },
);

has version => (
    is => 'ro',
    isa => 'Str',
);

has tarball => (
    is => 'ro',
    isa => 'Str',
    lazy => 1,
    default => sub {
        my $self = shift;
        if ( $self->download_url ) {

            my( undef, $file ) = tempfile();
            $file .= ".tar.gz";

            if ( $self->download_url =~ /^(?:ht|f)tp/ ) {
                require LWP::Simple;
                LWP::Simple::getstore( $self->download_url => $file )
                    or die "could not retrieve ", $self->download_url, "\n";
            }
            else {
                require File::Copy;

                File::Copy::copy( $self->download_url => $file );
            }

            return $file;
        }

        return undef;
    },
);

has extracted_dir => (
    is => 'ro',
    lazy => 1,
    default => method {

        my $archive = Archive::Any->new( $self->tarball );
        my $tmpdir = $self->tmpdir;
        $archive->extract( $tmpdir );

        return $tmpdir if $archive->is_impolite;

        my $dir;
        opendir $dir, $tmpdir;
        my( $sub ) = grep { !/^\.\.?$/ } readdir $dir;

        return join '/', $tmpdir, $sub;
    },
);

has cpan_parse => (
    is => 'ro',
    predicate => 'has_cpan_parse',
    lazy => 1,
    default => method {
        require CPAN::ParseDistribution;
        CPAN::ParseDistribution->new( $self->tarball );
    },
);

has metacpan => (
    is => 'ro',
    lazy => 1,
    default => sub {
        require MetaCPAN::Client;
        MetaCPAN::Client->new;
    }
);

has meta_info => (
    is => 'ro',
    lazy => 1,
    predicate => 'has_meta_info',
    default => method {
        require MetaCPAN::Client;

        if( my $release = $self->metacpan->release({ all =>
                    [
                        { distribution => $self->dist_name },
                        { version => $self->dist_version },
                    ]
                }) ) {
                $release = $release->next;
                return $release->data if $release;
            }

        # TODO check on cpan if the info is not there

        require CPAN::Meta;

        my( $result ) = map { CPAN::Meta->load_file($_) }
                        grep { $_->exists }
                        map { path( $self->extracted_dir )->child( "META.$_" ) } qw/ json yml /;

        return $result;

    },
);

has dist_version => (
    is => 'ro',
    lazy => 1,
    default => method {
            $self->has_meta_info
                ? $self->meta_info->{version}
                : $self->cpan_parse->distversion
    },
);

has dist_name => (
    is => 'ro',
    lazy => 1,
    default => method {
        $self->has_meta_info
            ? $self->meta_info->{distribution} || $self->meta_info->{name}
            : $self->cpan_parse->dist
            ;
    },
);

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Git::CPAN::Patch::Release

=head1 VERSION

version 2.3.1

=head1 AUTHOR

Yanick Champoux <[e-mail]>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2017 by Yanick Champoux.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut