view release on metacpan or  search on metacpan

lib/Module/Starter/PBP.pm  view on Meta::CPAN

    die "Can't find directory that holds Module::Starter::PBP templates\n",
        "(no 'template_dir: <directory path>' in config file)\n"
        if not defined $self->{template_dir};

    die "Can't access Module::Starter::PBP template directory\n",
        "(perhaps 'template_dir: $self->{template_dir}' is wrong in config file?)\n"
        if not -d $self->{template_dir};

    my $abs_file_path = "$self->{template_dir}/$rel_file_path";

    die "The Module::Starter::PBP template: $rel_file_path\n",
        "isn't in the template directory ($self->{template_dir})\n\n"
        if not -e $abs_file_path;

    die "The Module::Starter::PBP template: $rel_file_path\n",
        "isn't readable in the template directory ($self->{template_dir})\n\n"
        if not -r $abs_file_path;

    open my $fh, '<', $abs_file_path or croak $!;
    local $/;
    my $text = <$fh>;

    $text =~ s{<([A-Z ]+)>}
              { $context_ref->{$1}
                || die "Unknown placeholder <$1> in $rel_file_path\n"
              }xmseg;

    return $text;
}

sub import {
    my $class = shift;
    my ($setup, @other_args) = @_;

    # If this is not a setup request,
    # refer the import request up the hierarchy...
    if (@other_args || !$setup || $setup ne 'setup') {
        return $class->SUPER::import(@_);
    }

    # Otherwise, gather the necessary tools...
    use ExtUtils::Command qw( mkpath );
    use File::Spec;
    local $| = 1;

    # Locate the home directory...
    if (!defined $ENV{HOME}) {
        print 'Please enter the full path of your home directory: ';
        $ENV{HOME} = <>;
        chomp $ENV{HOME};
        croak 'Not a valid directory. Aborting.'
            if !-d $ENV{HOME};
    }

    # Create the directories...
    my $template_dir
        = File::Spec->catdir( $ENV{HOME}, '.module-starter', 'PBP' );
    if ( not -d $template_dir ) {
        print {*STDERR} "Creating $template_dir...";
        local @ARGV = $template_dir;
        mkpath;
        print {*STDERR} "done.\n";
    }

    my $template_test_dir
        = File::Spec->catdir( $ENV{HOME}, '.module-starter', 'PBP', 't' );
    if ( not -d $template_test_dir ) {
        print {*STDERR} "Creating $template_test_dir...";
        local @ARGV = $template_test_dir;
        mkpath;
        print {*STDERR} "done.\n";
    }

    # Create or update the config file (making a backup, of course)...
    my $config_file
        = File::Spec->catfile( $ENV{HOME}, '.module-starter', 'config' );

    my @config_info;

    if ( -e $config_file ) {
        print {*STDERR} "Backing up $config_file...";
        my $backup
            = File::Spec->catfile( $ENV{HOME}, '.module-starter', 'config.bak' );
        rename($config_file, $backup);
        print {*STDERR} "done.\n";

        print {*STDERR} "Updating $config_file...";
        open my $fh, '<', $backup or die "$config_file: $!\n";
        @config_info
            = grep { not /\A (?: template_dir | plugins ) : /xms } <$fh>;
        close $fh or die "$config_file: $!\n";
    }
    else {
        print {*STDERR} "Creating $config_file...\n";

        my $author = _prompt_for('your full name');
        my $email  = _prompt_for('an email address');

        @config_info = (
            "author:  $author\n",
            "email:   $email\n",
            "builder: ExtUtils::MakeMaker Module::Build\n",
        );

        print {*STDERR} "Writing $config_file...\n";
    }

    push @config_info, (
        "plugins: Module::Starter::PBP\n",
        "template_dir: $template_dir\n",
    );

    open my $fh, '>', $config_file  or die "$config_file: $!\n";
    print {$fh} @config_info        or die "$config_file: $!\n";
    close $fh                       or die "$config_file: $!\n";
    print {*STDERR} "done.\n";

    print {*STDERR} "Installing templates...\n";
    # Then install the various files...
    my @files = (
        ['Build.PL'],
        ['Makefile.PL'],
        ['README'],
        ['Changes'],
        ['Module.pm'],
        ['t', 'pod-coverage.t'],
        ['t', 'pod.t'],
        ['t', 'perlcritic.t'],
    );