File Coverage

blib/lib/App/Scaffolder/Template.pm

Criterion	Covered	Total	%
statement	92	102	90.2
branch	26	38	68.4
condition	16	35	45.7
subroutine	15	15	100.0
pod	8	8	100.0
total	157	198	79.2

package App::Scaffolder::Template;
{
  $App::Scaffolder::Template::VERSION = '0.002000';
}

# ABSTRACT: Represent a template for App::Scaffolder

use strict;
use warnings;

use Carp;
use Scalar::Util qw(blessed);
use Path::Class::File;
use File::Spec;


sub new {
	my ($class, $arg_ref) = @_;

	my $name = $arg_ref->{name};
	if (! defined $name || $name eq '') {
		croak("Required 'name' parameter not passed");
	}

	my $path = $arg_ref->{path};
	unless (defined $path && ref $path eq 'ARRAY') {
		croak("Required 'path' parameter not passed or not an array reference");
	}

	my $self = {
		name => $name,
		path => $path,
	};

	return bless($self, $class);
}



sub add_path_entry {
	my ($self, $dir) = @_;

	unless (blessed $dir && $dir->isa('Path::Class::Dir')) {
		croak("Required 'dir' parameter not passed or not a 'Path::Class::Dir' instance");
	}
	push @{$self->{path}}, $dir;
	return;
}



sub get_path {
	my ($self) = @_;
	return $self->{path};
}



sub get_name {
	my ($self) = @_;
	return $self->{name};
}



sub process {
	my ($self, $arg_ref) = @_;

	unless (defined $arg_ref && ref $arg_ref eq 'HASH') {
		croak("No parameters passed or not a hash reference");
	}
	my $target = $arg_ref->{target};
	unless (blessed $target && $target->isa('Path::Class::Dir')) {
		croak("Required 'target' parameter not passed or not a 'Path::Class::Dir' instance");
	}
	my $variables = $arg_ref->{variables};
	unless (defined $variables && ref $variables eq 'HASH') {
		croak("Required 'variables' parameter not passed or not a hash reference");
	}

	my @created_files;
	for my $file (values %{$self->get_template_files()}) {
		my $rel_target = $self->replace_file_path_variables(
			$file->{rel_target},
			$variables
		);
		my $target_dir = $target->subdir($rel_target->parent());
		unless (-d $target_dir) {
			$target_dir->mkpath()
				or confess("Unable to create target directory $target_dir");
		}

		my $output_file = $target_dir->file(
			$rel_target->basename()
		);
		if (-e $output_file && ! $arg_ref->{overwrite}) {
			croak(
				"File " . $output_file . " exists - need to pass 'overwrite' "
					. "parameter to overwrite files"
			);
		}
		$output_file->openw()->write($self->get_content_for(
			$file->{source}, $variables
		));
		push @created_files, $output_file;
	}

	return @created_files;
}



sub get_content_for {
	my ($self, $file, $variables) = @_;

	unless (blessed $file && $file->isa('Path::Class::File')) {
		croak("Required 'file' parameter not passed or not a 'Path::Class::File' instance");
	}
	$variables ||= {};

	my $content = '';
	if ($file =~ m{\.tt$}x) {
		require Template;
		my $template = Template->new({
			ABSOLUTE => 1,
		});
		$template->process($file->stringify(), $variables, \$content)
			or confess $template->error();
	}
	else {
		$content = $file->slurp();
	}
	return $content;
}



sub replace_file_path_variables {
	my ($self, $path, $variables) = @_;

	unless (blessed $path && $path->isa('Path::Class::File')) {
		croak("Required 'path' parameter not passed or not a 'Path::Class::File' instance");
	}

	if (! defined $variables || ref $variables ne 'HASH') {
		croak("Required 'variables' parameter not passed or not a hash reference");
	}

	my $orig_path = $path;
	my @orig_parts = File::Spec->splitdir($orig_path);

	while ($path =~ m{___([^_/\\]+)___}x) {
		if (defined $variables->{$1}) {
			$path =~ s{___([^_/\\]+)___}{$variables->{$1}}gx;
			$path = Path::Class::File->new($path);
		}
		else {
			croak("Unreplaceable filename variable $1 found");
		}
	}
	my @parts = File::Spec->splitdir($path);
	if (scalar @parts > scalar File::Spec->no_upwards(@parts)
			|| scalar @parts < scalar @orig_parts) {
		croak("Potential directory traversal detected in path '$path'");
	}
	return $path;
}



sub get_template_files {
	my ($self) = @_;
	my $file = {};
	for my $path_entry (map {$_->absolute()} @{$self->get_path()}) {
		$path_entry->recurse(callback => sub {
			my ($child) = @_;
			unless ($child->is_dir()) {
				my $rel_path = $child->relative($path_entry);
				my $key = $rel_path->stringify();
				if ($key =~ s{\.tt$}{}x) {
					my ($filename) = $rel_path->basename() =~ m{(.*)\.tt}x;
					$rel_path = $rel_path->parent()->file($filename)->cleanup();
				}
				unless (exists $file->{$key}) {
					$file->{$key} = {
						rel_target => $rel_path,
						source     => $child,
					};
				}
			}
		});
	}
	return $file;
}


1;

__END__