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   34 use v5.20;
  3         10  
8 3     3   17 use utf8;
  3         13  
  3         15  
9 3     3   92 use Role::Commons -all;
  3         6  
  3         19  
10 3     3   5327 use feature 'signatures';
  3         5  
  3         257  
11 3     3   20 use namespace::autoclean 0.16;
  3         47  
  3         17  
12              
13 3     3   201 use Path::Tiny;
  3         7  
  3         134  
14 3     3   1324 use Template::Tiny;
  3         3434  
  3         96  
15 3     3   19 use File::ShareDir qw(dist_dir);
  3         6  
  3         125  
16              
17 3     3   22 use Moo;
  3         6  
  3         15  
18 3     3   971 use MooX::StrictConstructor;
  3         7  
  3         21  
19              
20 3     3   2541 use Types::Standard qw(Maybe);
  3         8  
  3         39  
21 3     3   1985 use Types::TypeTiny qw(HashLike);
  3         5  
  3         17  
22 3     3   618 use Types::Path::Tiny qw(Dir File Path);
  3         5  
  3         28  
23 3     3   1695 use Boxer::Types qw(SkelDir Basename);
  3         9  
  3         30  
24              
25 3     3   1224 use strictures 2;
  3         21  
  3         106  
26 3     3   524 no warnings "experimental::signatures";
  3         6  
  3         1695  
27              
28             =head1 VERSION
29              
30             Version v1.4.3
31              
32             =cut
33              
34             our $VERSION = "v1.4.3";
35              
36             # permit callers to sloppily pass undefined values
37 8         17 sub BUILDARGS ( $class, %args )
38 8     8 0 7140 {
  8         28  
  8         16  
39 8         44 delete @args{ grep !defined( $args{$_} ), keys %args };
40 8         137 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         16 sub create ( $self, $vars )
117 8     8 0 25 {
  8         11  
  8         11  
118 8         57 my $template = Template::Tiny->new(
119             TRIM => 1,
120             );
121              
122 8         57 my $content = '';
123 8         152 $template->process(
124             \$self->skeleton_path->slurp,
125             $vars,
126             \$content
127             );
128 8         15705 $self->file_path->spew( $content . "\n" );
129             }
130              
131             =head1 AUTHOR
132              
133             Jonas Smedegaard C<< >>.
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;