File Coverage

blib/lib/Minilla/Profile/Base.pm

Criterion	Covered	Total	%
statement	36	78	46.1
branch	0	8	0.0
condition	0	12	0.0
subroutine	12	21	57.1
pod	0	6	0.0
total	48	125	38.4

package Minilla::Profile::Base;
use strict;
use warnings;
use utf8;
use File::Spec::Functions qw(catfile);
use File::Path qw(mkpath);
use File::Basename qw(dirname);
use Data::Section::Simple;
use Time::Piece;

use Minilla::Util qw(spew_raw);
use Minilla::Logger;

use Moo;

has [qw(dist path module)] => (
    is       => 'ro',
    required => 1,
);

has 'version' => (
    is       => 'ro',
    default  => sub { '0.01' },
);

has suffix => (
    is => 'lazy',
    required => 1,
);

has [qw(email author)] => (
    is => 'lazy',
    required => 1,
);

no Moo;

sub _build_author {
    my $self = shift;

    my $name ||= `git config user.name`;
    $name =~ s/\n$//;

    unless ($name) {
        errorf("You need to set user.name in git config.\nRun: git config user.name 'Your name'\n");
    }

    $name;
}

sub _build_email {
    my $self = shift;

    my $email ||= `git config user.email`;
    $email =~ s/\n$//;

    unless ($email) {
        errorf("You need to set user.email in git config.\nRun: git config user.email 'name\@example.com'\n");
    }

    $email;
}

sub _build_suffix {
    my $self = shift;
    my $suffix = $self->path;
    $suffix =~ s!^.+/!!;
    $suffix =~ s!\.pm!!;
    $suffix;
}

sub new_from_project {
    my ($class, $project) = @_;

    my $path = $project->main_module_path;
    $path =~ s!^lib/!!;
    my $self = $class->new(
        dist    => $project->dist_name,
        author  => $project->authors ? $project->authors->[0] : 'Unknown Author',
        version => $project->version,
        path    => $path,
        module  => $project->name,
    );
    return $self;
}

sub date {
    gmtime->strftime('%Y-%m-%dT%H:%M:%SZ');
}

sub end { '__END__' }

sub module_pm_src { '' }

sub render {
    my ($self, $tmplname, $dst) = @_;
    my $path = $dst || $tmplname;

    infof("Writing %s\n", $path);
    mkpath(dirname($path));

    for my $pkg (@{mro::get_linear_isa(ref $self || $self)}) {
        my $content = Data::Section::Simple->new($pkg)->get_data_section($tmplname);
        next unless defined $content;
        $content =~ s!<%\s*\$([a-z_]+)\s*%>!
            $self->$1()
        !ge;
        spew_raw($path, $content);
        return;
    }
    errorf("Cannot find template for %s\n", $tmplname);
}

sub write_file {
    my ($self, $path, $content) = @_;

    infof("Writing %s\n", $path);
    mkpath(dirname($path));
    spew_raw($path, $content);
}


1;
__DATA__