@@ -3,11 +3,9 @@ package Dancer2::CLI::Gen;
33
44use Moo;
55use HTTP::Tiny;
6+ use Path::Tiny;
7+ use Data::Printer;
68use JSON::MaybeXS;
7- use File::Find;
8- use File::Path ' mkpath' ;
9- use File::Spec::Functions qw( catdir catfile ) ;
10- use File::Basename qw/ dirname basename/ ;
119use Dancer2::Template::Simple;
1210use Module::Runtime qw( use_module is_module_name ) ;
1311use CLI::Osprey
@@ -33,9 +31,12 @@ option directory => (
3331 default => sub { my $self = shift ; return $self -> application; },
3432);
3533
36- option path => (
34+ # This was causing conflict with Path::Tiny's path(), so renaming to avoid
35+ # the overhead of making Path::Tiny an object.
36+ option app_path => (
3737 is => ' ro' ,
3838 short => ' p' ,
39+ option => ' path' ,
3940 doc => ' application path (default: current directory)' ,
4041 format => ' s' ,
4142 format_doc => ' directory' ,
@@ -68,7 +69,7 @@ option skel => (
6869 required => 0,
6970 default => sub{
7071 my $self = shift ;
71- catdir ( $self -> parent_command-> _dist_dir, ' skel' );
72+ path ( $self -> parent_command-> _dist_dir ) -> child( ' skel' );
7273 },
7374);
7475
@@ -81,7 +82,7 @@ Invalid application name. Application names must not contain single colons,
8182dots, hyphens or start with a number.
8283 } ) unless is_module_name( $self -> application );
8384
84- my $path = $self -> path ;
85+ my $path = $self -> app_path ;
8586 -d $path or $self -> osprey_usage( 1, " path: directory '$path ' does not exist" );
8687 -w $path or $self -> osprey_usage( 1, " path: directory '$path ' is not writeable" );
8788
@@ -96,16 +97,16 @@ sub run {
9697
9798 my $app_name = $self -> application;
9899 my $app_file = $self -> _get_app_file( $app_name );
99- my $app_path = $self -> _get_app_path( $self -> path , $app_name );
100+ my $app_path = $self -> _get_app_path( $self -> app_path , $app_name );
100101
101102 if ( my $dir = $self -> directory ) {
102- $app_path = catdir ( $self -> path, $dir );
103+ $app_path = path ( $self -> app_path) -> child( $dir );
103104 }
104105
105106 my $files_to_copy = $self -> _build_file_list( $self -> skel, $app_path );
106107 foreach my $pair ( @$files_to_copy ) {
107108 if ( $pair -> [0] =~ m / lib\/ AppFile.pm$ / ) {
108- $pair -> [1] = catfile ( $app_path , $app_file );
109+ $pair -> [1] = path ( $app_path ) -> child( $app_file );
109110 last ;
110111 }
111112 }
@@ -169,22 +170,19 @@ Happy Dancing!
169170# skel creation routines
170171sub _build_file_list {
171172 my ( $self , $from , $to ) = @_ ;
172- $from =~ s { /+$} {} ;
173- my $len = length ($from ) + 1;
173+ $from =~ s { /+$} {} ;
174174
175175 my @result ;
176- my $wanted = sub {
177- return unless -f ;
178- my $file = substr ( $_ , $len );
179-
180- # ignore .git and git/*
181- my $is_git = $file =~ m { ^\. git(/|$) }
182- and return ;
183-
184- push @result , [ $_ , catfile( $to , $file ) ];
185- };
186-
187- find({ wanted => $wanted , no_chdir => 1 }, $from );
176+ my $iter = path( $from )-> iterator({ recurse => 1 });
177+ while ( my $file = $iter -> () ) {
178+ warn " File not found: $file " unless -e $file ; # Paranoia
179+ next if $file -> basename =~ m { ^\. git(/|$) } ;
180+ next if $file -> is_dir;
181+
182+ # TODO: There has to be a more Path::Tiny way of this, no?
183+ my $filename = substr ( $file , length ( $from ) + 1 );
184+ push @result , [ $file , path( $to )-> child( $filename )];
185+ }
188186 return \@result ;
189187}
190188
@@ -200,15 +198,15 @@ sub _copy_templates {
200198 next unless ( $res eq ' y' ) or ( $res eq ' a' );
201199 }
202200
203- my $to_dir = dirname ( $to );
204- if ( ! -d $to_dir ) {
201+ my $to_dir = path ( $to )-> parent ;
202+ if ( ! $to_dir -> is_dir ) {
205203 print " + $to_dir \n " ;
206- mkpath $to_dir or die " could not mkpath $to_dir : $! " ;
204+ $to_dir -> mkpath or die " could not mkpath $to_dir : $! " ;
207205 }
208206
209- my $to_file = basename( $to ) ;
210- my $ex = ($to_file =~ s / ^\+ // );
211- $to = catfile( $to_dir , $to_file ) if $ex ;
207+ my $to_file = path( $to ) -> basename ;
208+ my $ex = ( $to_file =~ s / ^\+ // );
209+ $to = path( $to_dir ) -> child( $to_file ) if $ex ; # BUGGED
212210
213211 print " + $to \n " ;
214212 my $content ;
@@ -220,10 +218,10 @@ sub _copy_templates {
220218 }
221219
222220 if ( $from !~ m /\. (ico|jpg|png|css|eot|map|swp|ttf|svg|woff|woff2|js)$ / ) {
223- $content = _process_template($content , $vars );
221+ $content = $self -> _process_template($content , $vars );
224222 }
225223
226- open ( my $fh , ' >:raw' , $to ) or die " unable to open file `$to ' for writing: $! " ;
224+ open ( my $fh , ' >:raw' , $to ) or die " unable to open file `$to ` for writing: $! " ;
227225 print $fh $content ;
228226 close $fh ;
229227
@@ -236,13 +234,13 @@ sub _copy_templates {
236234sub _create_manifest {
237235 my ( $self , $files , $dir ) = @_ ;
238236
239- my $manifest_name = catfile ( $dir , ' MANIFEST' );
237+ my $manifest_name = path ( $dir ) -> child( ' MANIFEST' );
240238 open ( my $manifest , ' >' , $manifest_name ) or die $! ;
241239 print $manifest " MANIFEST\n " ;
242240
243241 foreach my $file ( @{ $files } ) {
244- my $filename = substr $file -> [1], length ( $dir ) + 1;
245- my $basename = basename $filename ;
242+ my $filename = substr $file -> [1], length ( $dir ) + 1; # TODO: Path::Tiny way?
243+ my $basename = path( $filename ) -> basename ;
246244 my $clean_basename = $basename ;
247245 $clean_basename =~ s / ^\+ // ;
248246 $filename =~ s /\Q $basename\E / $clean_basename / ;
@@ -255,7 +253,7 @@ sub _create_manifest {
255253sub _add_to_manifest_skip {
256254 my ( $self , $dir ) = @_ ;
257255
258- my $filename = catfile ( $dir , ' MANIFEST.SKIP' );
256+ my $filename = path ( $dir ) -> child( ' MANIFEST.SKIP' );
259257 open my $fh , ' >>' , $filename or die $! ;
260258 print {$fh } " ^$dir -\n " ;
261259 close $fh ;
@@ -274,13 +272,13 @@ sub _process_template {
274272# need them later.
275273sub _get_app_path {
276274 my ( $self , $path , $appname ) = @_ ;
277- return catdir ( $path , $self -> _get_dashed_name( $appname ));
275+ return path ( $path ) -> child( $self -> _get_dashed_name( $appname ));
278276}
279277
280278sub _get_app_file {
281279 my ( $self , $appname ) = @_ ;
282280 $appname =~ s { ::} { /} g ;
283- return catfile ( ' lib' , " $appname .pm" );
281+ return path ( ' lib' ) -> child( " $appname .pm" );
284282}
285283
286284sub _get_perl_interpreter {
0 commit comments