File Coverage

blib/lib/Boxer/File/WithSkeleton.pm
Criterion Covered Total %
statement 61 61 100.0
branch n/a
condition n/a
subroutine 18 18 100.0
pod 0 2 0.0
total 79 81 97.5


line stmt bran cond sub pod time code
1             package Boxer::File::WithSkeleton;
2              
3             =encoding UTF-8
4              
5             =cut
6              
7 3     3   37 use v5.20;
  3         10  
8 3     3   16 use utf8;
  3         5  
  3         16  
9 3     3   88 use Role::Commons -all;
  3         6  
  3         20  
10 3     3   5783 use feature 'signatures';
  3         8  
  3         256  
11 3     3   21 use namespace::autoclean 0.16;
  3         57  
  3         21  
12              
13 3     3   247 use Path::Tiny;
  3         6  
  3         171  
14 3     3   1464 use Template::Tiny;
  3         3933  
  3         112  
15 3     3   20 use File::ShareDir qw(dist_dir);
  3         6  
  3         157  
16              
17 3     3   19 use Moo;
  3         6  
  3         23  
18 3     3   1082 use MooX::StrictConstructor;
  3         8  
  3         35  
19              
20 3     3   2768 use Types::Standard qw(Maybe);
  3         5  
  3         42  
21 3     3   2125 use Types::TypeTiny qw(HashLike);
  3         5  
  3         18  
22 3     3   673 use Types::Path::Tiny qw(Dir File Path);
  3         7  
  3         30  
23 3     3   1914 use Boxer::Types qw(SkelDir Basename);
  3         5  
  3         27  
24              
25 3     3   1449 use strictures 2;
  3         26  
  3         122  
26 3     3   626 no warnings "experimental::signatures";
  3         6  
  3         1966  
27              
28             =head1 VERSION
29              
30             Version v1.4.2
31              
32             =cut
33              
34             our $VERSION = "v1.4.2";
35              
36             # permit callers to sloppily pass undefined values
37 8         17 sub BUILDARGS ( $class, %args )
38 8     8 0 7237 {
  8         27  
  8         12  
39 8         51 delete @args{ grep !defined( $args{$_} ), keys %args };
40 8         150 return {%args};
41             }
42              
43             has basename => (
44             is => 'ro',
45             isa => Basename,
46             );
47              
48             has file => (
49             is => 'lazy',
50             isa => Basename,
51              
52             default => sub ($self) {
53             if ( $self->basename ) {
54             return $self->basename;
55             }
56             elsif ( $self->skeleton_suffix ) {
57             return $self->skeleton_path->basename( $self->skeleton_suffix );
58             }
59             },
60             );
61              
62             has file_path => (
63             is => 'lazy',
64             isa => Path,
65             required => 1,
66             default => sub ($self) {
67             if ( $self->file_dir and $self->file ) {
68             return $self->file_dir->child( $self->file );
69             }
70             },
71             );
72              
73             has file_dir => (
74             is => 'lazy',
75             isa => Dir,
76             default => sub { path('.') },
77             );
78              
79             has skeleton => (
80             is => 'lazy',
81             isa => Basename,
82             default => sub ($self) {
83             if ( $self->basename
84             and $self->skeleton_dir
85             and $self->skeleton_suffix )
86             {
87             return $self->skeleton_dir->child(
88             $self->basename . $self->skeleton_suffix )->basename;
89             }
90             },
91             );
92              
93             has skeleton_path => (
94             is => 'lazy',
95             isa => File,
96             required => 1,
97             default => sub ($self) {
98             if ( $self->skeleton_dir and $self->skeleton ) {
99             return $self->skeleton_dir->child( $self->skeleton );
100             }
101             },
102             );
103              
104             has skeleton_dir => (
105             is => 'lazy',
106             isa => SkelDir,
107             default => sub { path( dist_dir('Boxer'), 'skel' ) },
108             );
109              
110             has skeleton_suffix => (
111             is => 'ro',
112             isa => Basename,
113             default => '.in',
114             );
115              
116 8         14 sub create ( $self, $vars )
117 8     8 0 14 {
  8         14  
  8         12  
118 8         58 my $template = Template::Tiny->new(
119             TRIM => 1,
120             );
121              
122 8         60 my $content = '';
123 8         200 $template->process(
124             \$self->skeleton_path->slurp,
125             $vars,
126             \$content
127             );
128 8         16918 $self->file_path->spew( $content . "\n" );
129             }
130              
131             =head1 AUTHOR
132              
133             Jonas Smedegaard C<< <dr@jones.dk> >>.
134              
135             =cut
136              
137             our $AUTHORITY = 'cpan:JONASS';
138              
139             =head1 COPYRIGHT AND LICENCE
140              
141             Copyright © 2013-2016 Jonas Smedegaard
142              
143             This is free software; you can redistribute it and/or modify it under
144             the same terms as the Perl 5 programming language system itself.
145              
146             =head1 DISCLAIMER OF WARRANTIES
147              
148             THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
149             WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
150             MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
151              
152             =cut
153              
154             1;