1package Minilla::Profile::Base; 2use strict; 3use warnings; 4use utf8; 5use File::Spec::Functions qw(catfile); 6use File::Path qw(mkpath); 7use File::Basename qw(dirname); 8use Data::Section::Simple; 9use Time::Piece; 10 11use Minilla::Util qw(spew_raw); 12use Minilla::Logger; 13 14use Moo; 15 16has [qw(dist path module)] => ( 17 is => 'ro', 18 required => 1, 19); 20 21has 'version' => ( 22 is => 'ro', 23 default => sub { '0.01' }, 24); 25 26has suffix => ( 27 is => 'lazy', 28 required => 1, 29); 30 31has [qw(email author)] => ( 32 is => 'lazy', 33 required => 1, 34); 35 36no Moo; 37 38sub _build_author { 39 my $self = shift; 40 41 my $name ||= `git config user.name`; 42 $name =~ s/\n$//; 43 44 unless ($name) { 45 errorf("You need to set user.name in git config.\nRun: git config user.name 'Your name'\n"); 46 } 47 48 $name; 49} 50 51sub _build_email { 52 my $self = shift; 53 54 my $email ||= `git config user.email`; 55 $email =~ s/\n$//; 56 57 unless ($email) { 58 errorf("You need to set user.email in git config.\nRun: git config user.email 'name\@example.com'\n"); 59 } 60 61 $email; 62} 63 64sub _build_suffix { 65 my $self = shift; 66 my $suffix = $self->path; 67 $suffix =~ s!^.+/!!; 68 $suffix =~ s!\.pm!!; 69 $suffix; 70} 71 72sub new_from_project { 73 my ($class, $project) = @_; 74 75 my $path = $project->main_module_path; 76 $path =~ s!^lib/!!; 77 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 return $self; 85} 86 87sub date { 88 gmtime->strftime('%Y-%m-%dT%H:%M:%SZ'); 89} 90 91sub end { '__END__' } 92 93sub module_pm_src { '' } 94 95sub render { 96 my ($self, $tmplname, $dst) = @_; 97 my $path = $dst || $tmplname; 98 99 infof("Writing %s\n", $path); 100 mkpath(dirname($path)); 101 102 for my $pkg (@{mro::get_linear_isa(ref $self || $self)}) { 103 my $content = Data::Section::Simple->new($pkg)->get_data_section($tmplname); 104 next unless defined $content; 105 $content =~ s!<%\s*\$([a-z_]+)\s*%>! 106 $self->$1() 107 !ge; 108 spew_raw($path, $content); 109 return; 110 } 111 errorf("Cannot find template for %s\n", $tmplname); 112} 113 114sub write_file { 115 my ($self, $path, $content) = @_; 116 117 infof("Writing %s\n", $path); 118 mkpath(dirname($path)); 119 spew_raw($path, $content); 120} 121 122 1231; 124__DATA__ 125 126@@ t/00_compile.t 127use strict; 128use Test::More 0.98; 129 130use_ok $_ for qw( 131 <% $module %> 132); 133 134done_testing; 135 136@@ Module.pm 137package <% $module %>; 138use 5.008001; 139use strict; 140use warnings; 141 142our $VERSION = "<% $version %>"; 143 144<% $module_pm_src %> 145 1461; 147<% $end %> 148 149=encoding utf-8 150 151=head1 NAME 152 153<% $module %> - It's new $module 154 155=head1 SYNOPSIS 156 157 use <% $module %>; 158 159=head1 DESCRIPTION 160 161<% $module %> is ... 162 163=head1 LICENSE 164 165Copyright (C) <% $author %>. 166 167This library is free software; you can redistribute it and/or modify 168it under the same terms as Perl itself. 169 170=head1 AUTHOR 171 172<% $author %> E<lt><% $email %>E<gt> 173 174=cut 175 176@@ .travis.yml 177language: perl 178sudo: false 179perl: 180 - "5.12" 181 - "5.14" 182 - "5.16" 183 - "5.18" 184 - "5.20" 185 - "5.22" 186 - "5.24" 187 - "5.26" 188 189@@ Changes 190Revision history for Perl extension <% $dist %> 191 192{{$NEXT}} 193 194 - original version 195 196@@ .gitignore 197/.build/ 198/_build/ 199/Build 200/Build.bat 201/blib 202/Makefile 203/pm_to_blib 204 205/carton.lock 206/.carton/ 207/local/ 208 209nytprof.out 210nytprof/ 211 212cover_db/ 213 214*.bak 215*.old 216*~ 217*.swp 218*.o 219*.obj 220 221!LICENSE 222 223/_build_params 224 225MYMETA.* 226 227/<% $dist %>-* 228