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


line stmt bran cond sub pod time code
1             package Minilla::Profile::Base;
2 1     1   1685 use strict;
  1         3  
  1         30  
3 1     1   6 use warnings;
  1         2  
  1         24  
4 1     1   5 use utf8;
  1         3  
  1         5  
5 1     1   26 use File::Spec::Functions qw(catfile);
  1         2  
  1         51  
6 1     1   6 use File::Path qw(mkpath);
  1         4  
  1         63  
7 1     1   7 use File::Basename qw(dirname);
  1         4  
  1         43  
8 1     1   5 use Data::Section::Simple;
  1         3  
  1         49  
9 1     1   7 use Time::Piece;
  1         3  
  1         9  
10              
11 1     1   94 use Minilla::Util qw(spew_raw);
  1         3  
  1         41  
12 1     1   5 use Minilla::Logger;
  1         3  
  1         56  
13              
14 1     1   6 use Moo;
  1         5  
  1         5  
15              
16             has [qw(dist path module)] => (
17             is => 'ro',
18             required => 1,
19             );
20              
21             has 'version' => (
22             is => 'ro',
23             default => sub { '0.01' },
24             );
25              
26             has suffix => (
27             is => 'lazy',
28             required => 1,
29             );
30              
31             has [qw(email author)] => (
32             is => 'lazy',
33             required => 1,
34             );
35              
36 1     1   445 no Moo;
  1         2  
  1         4  
37              
38             sub _build_author {
39 0     0     my $self = shift;
40              
41 0   0       my $name ||= `git config user.name`;
42 0           $name =~ s/\n$//;
43              
44 0 0         unless ($name) {
45 0           errorf("You need to set user.name in git config.\nRun: git config user.name 'Your name'\n");
46             }
47              
48 0           $name;
49             }
50              
51             sub _build_email {
52 0     0     my $self = shift;
53              
54 0   0       my $email ||= `git config user.email`;
55 0           $email =~ s/\n$//;
56              
57 0 0         unless ($email) {
58 0           errorf("You need to set user.email in git config.\nRun: git config user.email 'name\@example.com'\n");
59             }
60              
61 0           $email;
62             }
63              
64             sub _build_suffix {
65 0     0     my $self = shift;
66 0           my $suffix = $self->path;
67 0           $suffix =~ s!^.+/!!;
68 0           $suffix =~ s!\.pm!!;
69 0           $suffix;
70             }
71              
72             sub new_from_project {
73 0     0 0   my ($class, $project) = @_;
74              
75 0           my $path = $project->main_module_path;
76 0           $path =~ s!^lib/!!;
77 0 0         my $self = $class->new(
78             dist => $project->dist_name,
79             author => $project->authors ? $project->authors->[0] : 'Unknown Author',
80             version => $project->version,
81             path => $path,
82             module => $project->name,
83             );
84 0           return $self;
85             }
86              
87             sub date {
88 0     0 0   gmtime->strftime('%Y-%m-%dT%H:%M:%SZ');
89             }
90              
91 0     0 0   sub end { '__END__' }
92              
93 0     0 0   sub module_pm_src { '' }
94              
95             sub render {
96 0     0 0   my ($self, $tmplname, $dst) = @_;
97 0   0       my $path = $dst || $tmplname;
98              
99 0           infof("Writing %s\n", $path);
100 0           mkpath(dirname($path));
101              
102 0   0       for my $pkg (@{mro::get_linear_isa(ref $self || $self)}) {
  0            
103 0           my $content = Data::Section::Simple->new($pkg)->get_data_section($tmplname);
104 0 0         next unless defined $content;
105 0           $content =~ s!<%\s*\$([a-z_]+)\s*%>!
106 0           $self->$1()
107             !ge;
108 0           spew_raw($path, $content);
109 0           return;
110             }
111 0           errorf("Cannot find template for %s\n", $tmplname);
112             }
113              
114             sub write_file {
115 0     0 0   my ($self, $path, $content) = @_;
116              
117 0           infof("Writing %s\n", $path);
118 0           mkpath(dirname($path));
119 0           spew_raw($path, $content);
120             }
121              
122              
123             1;
124             __DATA__