view release on metacpan or  search on metacpan

lib/App/cpan2arch.pm  view on Meta::CPAN

use v5.42.0;

use strict;
use warnings;
no source::encoding;  # Avoid dying on v5.42.0 (non-ASCII char in POD).

use Object::Pad 0.825;

package App::cpan2arch;  # For toolchain compatibility.
class App::cpan2arch
  :does(App::cpan2arch::GetMetadata)
  :does(App::cpan2arch::MergePrereqs)
  :does(App::cpan2arch::CheckPackages)
  :does(App::cpan2arch::WritePkgbuild);

use File::Basename qw< basename >;
use version;

our $VERSION = 'v1.1.2';

field %_env :reader :writer = (
    user_agent       => "App::cpan2arch/$VERSION",
    cache_mcpan_path => '/tmp/mcpan_cache',
    cache_arch_path  => '/tmp/arch_cache',
    cache_expiration => '1d',
);
field $_prog :reader = basename($0);
field %_opts :reader;
field %_args :reader;

method init (@argv)
{
    _exit( $self->_process_env->_process_opts( \@argv ) );

    return $self;
}

method run ()
{
    $self->_psub;

    # Non-interactive TTY must not display this.
    print STDERR "Generating PKGBUILD...\n" if -t STDOUT;

    _exit( $self->get_metadata );
    _exit( $self->merge_prereqs );
    _exit( $self->check_packages );
    _exit( $self->generate_pkgbuild->write_pkgbuild );

    return 0;
}

# Process environment variables.
method _process_env ()
{
    $_env{packager}         = $ENV{PACKAGER} // 'Your Name <email@domain.tld>';
    $_env{user_agent}       = $ENV{C2A_USER_AGENT}       if defined $ENV{C2A_USER_AGENT};
    $_env{cache_mcpan_path} = $ENV{C2A_CACHE_MCPAN_PATH} if defined $ENV{C2A_CACHE_MCPAN_PATH};
    $_env{cache_arch_path}  = $ENV{C2A_CACHE_ARCH_PATH}  if defined $ENV{C2A_CACHE_ARCH_PATH};
    $_env{cache_expiration} = $ENV{C2A_CACHE_EXPIRATION} if defined $ENV{C2A_CACHE_EXPIRATION};
    $_env{cache_ignore}     = $ENV{C2A_CACHE_IGNORE} ? true : false;
    $_env{debug}            = $ENV{C2A_DEBUG}        ? true : false;

    try {
        if ( $_env{debug} ) {
            require Data::Printer;
            Data::Printer->VERSION('1.002001');
        }
    }
    catch ($e) {
        warn $e;
        warn "$_prog: Data::Printer is required to display debug information\n";

        exit 1;
    }

    $self->_psub;
    $self->_pdump( '%_env', \%_env, "\n" );

    return $self;
}

# Process options and its arguments.
method _process_opts ( $argv = undef )
{
    $self->_psub;

    return 0 unless defined $argv;

    # Transform Getopt::Long error warns.
    local $SIG{__WARN__} = sub {
        chomp( my $msg = shift );

        $msg =~ tr{"}{'};
        $msg = lcfirst $msg;

        warn "$_prog: $msg\n";
    };

    # Bash completion
    try {
        require Getopt::Long::More;

        Getopt::Long::More->VERSION('0.007');
        Getopt::Long::More->import( qw< GetOptionsFromArray > );

        Getopt::Long::More::Configure(
            qw<
                default
                gnu_getopt
                no_ignore_case
            >
        );
    }
    catch ($e) {
        # Use Getopt::Long as fallback.
        require Getopt::Long;