File Coverage

blib/lib/only/install.pm

Criterion	Covered	Total	%
statement	104	113	92.0
branch	32	58	55.1
condition	6	12	50.0
subroutine	13	13	100.0
pod	0	6	0.0
total	155	202	76.7

package only::install;
$VERSION = '0.26';
@EXPORT_OK = qw(install);
use strict;
use 5.006001;
use base 'Exporter';
use only;
use File::Spec;
use Config;
use Carp;

sub install {
    my %args = @_;
    check_env();
    my ($dist_name, $dist_ver) = get_meta();
    my $versionlib = $args{versionlib} || &only::config::versionlib;
    my $version = $args{version} || $dist_ver;
    if ($version !~ /^\d+(\.\d+)?$/) {
        croak <
Install failed. '$version' is an invalid version string. Must be numeric.
END
    }

    my $lib  = File::Spec->catdir(qw(blib lib));
    mkdir($lib, 0777) unless -d $lib;
    my $arch = File::Spec->catdir(qw(blib arch));
    mkdir($arch, 0777) unless -d $arch;

    my $install_lib  = File::Spec->catdir(
        $versionlib,
        $version,
    );
    my $install_arch = File::Spec->catdir(
        $versionlib,
        $Config{archname},
        $version,
    );
    my $install_map = {
        $lib  => $install_lib,
        $arch => $install_arch,
        read  => '',
    };

    {   # 5.6.1 has a warning bug. :(
        local $^W = 0;
        require ExtUtils::Install;
    }
    ExtUtils::Install::install($install_map, 1, 0);

    my @lib_pm_files = map trim_dir($_), find_pm($lib);
    my @arch_pm_files = map trim_dir($_), find_pm($arch);
    my $meta = <
# This meta file created by/for only.pm
meta_version: $only::VERSION
install_version: $version
distribution_name: $dist_name
distribution_version: $dist_ver
distribution_modules:
END
    for my $file (sort(@lib_pm_files, @arch_pm_files)) {
        my $pm_file = join '/', File::Spec->splitdir($file);
        $meta .= "  - $pm_file\n";
    }
    install_meta($meta, $install_lib, $_) for @lib_pm_files;
    install_meta($meta, $install_arch, $_) for @arch_pm_files;
}

sub install_meta {
    my ($meta, $base, $module) = @_;
    my $meta_file = File::Spec->catfile($base, $module);
    $meta_file =~ s/\.pm$/\.yaml/
      or croak;
    my $old_meta = '';
    if (-f $meta_file) {
        open META, $meta_file
          or croak "Can't open $meta_file for input\n";
        $old_meta = do {local $/; };
        close META;
    }
    if ($meta eq $old_meta) {
        print "Skipping $meta_file (unchanged)\n";
    }
    else {
        print "Installing $meta_file\n";
        open META, '>', $meta_file
          or croak "Can't open $meta_file for output\n";
        print META $meta;
        close META;
    }
}

sub trim_dir {
    my ($path) = @_;
    my ($vol, $dir, $file) = File::Spec->splitpath($path);
    my @dirs = File::Spec->splitdir($dir);
    pop @dirs unless $dirs[-1];
    splice(@dirs, 0, 2);
    $dir = scalar(@dirs) ? File::Spec->catdir(@dirs) : '';
    $dir ? File::Spec->catfile($dir, $file) : $file
}

sub find_pm {
    my ($path, $base) = (@_, '');
    croak unless $path;
    my (@pm_files);
    $path = File::Spec->catdir($base, $path) if $base;
    local *DIR;
    opendir(DIR, $path)
      or croak "Can't open directory '$path':\n$!";
    while (my $file = readdir(DIR)) {
        next if $file =~ /^\./;
        my $file_path = File::Spec->catfile($path, $file);
        my $dir_path = File::Spec->catdir($path, $file);
        if ($file =~ /^\w+\.pm$/) {
            push @pm_files, $file_path;
        }
        elsif (-d $dir_path) {
            push @pm_files, find_pm($file, $path);
        }
    }
    return @pm_files;
}

sub check_env {
    my $lib  = File::Spec->catdir(qw(blib lib));
    my $arch = File::Spec->catdir(qw(blib arch));
    return 1 if -d 'blib' and (-d $lib or -d $arch);
    if (-f 'Build.PL') {
        croak <
First you need to run:

  perl Build.PL
  ./Build
  ./Build test    # (optional)

END
    }
    elsif (-f 'Makefile.PL') {
        croak <
First you need to run:

  perl Makefile.PL
  make
  make test       # (optional)

END
    }
    else {
        croak <
You don't appear to be inside a directory fit to install a Perl module.
See 'perldoc only' for more information.
END
    }
}

sub get_meta {
    my $dist_name = '';
    my $dist_ver = '';
    if (-f 'META.yml') {
        open META, "META.yml"
          or croak "Can't open META.yml for input:\n$!\n";
        local $/;
        my $meta = ;
        close META;
        if ($meta =~ /^name\s*:\s+(\S+)$/m) {
            $dist_name = $1;
        }
        if ($meta =~ /^version\s*:\s+(\S+)$/m) {
            $dist_ver = $1;
        }
    }
    else {
        if (-f 'Makefile') {
            open MAKEFILE, "Makefile"
              or croak "Can't open Makefile for input:\n$!\n";
            local $/;
            my $makefile = ;
            close MAKEFILE;
            if ($makefile =~ /^DISTNAME\s*=\s*(\S+)$/m) {
                $dist_name = $1;
            }
            if ($makefile =~ /^VERSION\s*=\s*(\S+)$/m) {
                $dist_ver = $1;
            }
        }
    }
    croak <
Can't determine the version for this install. Please specify manually:

    perl -Monly=install - version=1.23

END
    return ($dist_name, $dist_ver);
}

1;

__END__