File Coverage

blib/lib/Dist/Iller/DocType.pm
Criterion Covered Total %
statement 77 99 77.7
branch 11 30 36.6
condition n/a
subroutine 22 23 95.6
pod 0 3 0.0
total 110 155 70.9


line stmt bran cond sub pod time code
1 2     2   1350 use 5.10.0;
  2         7  
2 2     2   13 use strict;
  2         4  
  2         47  
3 2     2   11 use warnings;
  2         4  
  2         112  
4              
5             package Dist::Iller::DocType;
6              
7             our $AUTHORITY = 'cpan:CSSON'; # AUTHORITY
8             # ABSTRACT: Role for document types that can be used in Dist::Iller configs
9             our $VERSION = '0.1409';
10              
11 2     2   12 use Moose::Role;
  2         4  
  2         19  
12 2     2   11192 use MooseX::AttributeShortcuts;
  2         5  
  2         15  
13 2     2   37290 use namespace::autoclean;
  2         4  
  2         16  
14 2     2   137 use Try::Tiny;
  2         5  
  2         120  
15 2     2   13 use Text::Diff;
  2         4  
  2         122  
16 2     2   15 use Types::Standard qw/ConsumerOf Str HashRef InstanceOf Maybe/;
  2         5  
  2         29  
17 2     2   2641 use Module::Load qw/load/;
  2         5  
  2         18  
18 2     2   167 use String::CamelCase qw/decamelize/;
  2         6  
  2         126  
19 2     2   16 use YAML::Tiny;
  2         4  
  2         110  
20 2     2   12 use Carp qw/croak/;
  2         4  
  2         109  
21 2     2   2052 use DateTime;
  2         907017  
  2         104  
22 2     2   19 use Path::Tiny;
  2         7  
  2         141  
23 2     2   13 use Safe::Isa qw/$_can/;
  2         5  
  2         231  
24 2     2   15 use Types::Path::Tiny qw/Path/;
  2         4  
  2         49  
25 2     2   1929 use PerlX::Maybe qw/maybe/;
  2         2645  
  2         14  
26              
27             requires qw/
28             filename
29             parse
30             phase
31             to_hash
32             to_string
33             comment_start
34             /;
35              
36             # this is set if we are parsing a ::Config class
37             has config_obj => (
38             is => 'ro',
39             isa => ConsumerOf['Dist::Iller::Config'],
40             predicate =>1,
41             );
42             has doctype => (
43             is => 'ro',
44             isa => Str,
45             init_arg => undef,
46             default => sub { decamelize( (split /::/, shift->meta->name)[-1] ); },
47             );
48             has included_configs => (
49             is => 'ro',
50             isa => HashRef,
51             init_arg => undef,
52             traits => ['Hash'],
53             default => sub { +{ } },
54             handles => {
55             set_included_config => 'set',
56             all_included_configs => 'kv',
57             has_included_configs => 'count',
58             },
59             );
60             has global => (
61             is => 'ro',
62             isa => Maybe[InstanceOf['Dist::Iller::DocType::Global']],
63             predicate => 1,
64             );
65              
66             around parse => sub {
67             my $next = shift;
68             my $self = shift;
69             my $yaml = shift;
70              
71             $self->parse_config($yaml->{'configs'});
72             $self->$next($yaml);
73              
74             return $self;
75             };
76             sub parse_config {
77 16     16 0 32 my $self = shift;
78 16         38 my $yaml = shift;
79              
80 16 100       50 return if !defined $yaml;
81              
82 3 50       15 if(ref $yaml eq 'ARRAY') {
83 0         0 warn 'Multiple configs found';
84 0         0 for my $doc (@{ $yaml }) {
  0         0  
85 0         0 $self->parse_config($doc);
86             }
87             }
88             else {
89 3         11 my $config_name = delete $yaml->{'+config'};
90 3         11 my $config_class = "Dist::Iller::Config::$config_name";
91              
92             try {
93 3     3   154 load "$config_class";
94             }
95             catch {
96 0     0   0 croak "Can't find $config_class ($_)";
97 3         30 };
98              
99             my $configobj = $config_class->new(
100 3 100       245 %{ $yaml },
  3 50       25  
101             maybe distribution_name => ($self->$_can('name') ? $self->name : undef),
102             maybe global => ($self->global ? $self->global : undef),
103             );
104 3         457 my $configdoc = $configobj->get_yaml_for($self->doctype);
105 3 50       173 return if !defined $configdoc;
106              
107 3         16 $self->parse($configdoc);
108 3         188 $self->set_included_config($config_class, $config_class->VERSION);
109             }
110             }
111              
112 3     3 0 14 sub to_yaml { YAML::Tiny->new(shift->to_hash)->[0] }
113              
114             around to_string => sub {
115             my $next = shift;
116             my $self = shift;
117              
118             my $string = $self->$next(@_);
119             return $string if !defined $self->comment_start;
120              
121             my $now = DateTime->now;
122              
123             my @intro = ();
124             push @intro => $self->comment_start . sprintf (' This file was auto-generated from iller.yaml by Dist::Iller on %s %s %s.', $now->ymd, $now->hms, $now->time_zone->name);
125             if($self->has_included_configs) {
126             push @intro => $self->comment_start . ' The following configs were used:';
127              
128             for my $config (sort { $a->[0] cmp $b->[0] } $self->all_included_configs) {
129             push @intro => $self->comment_start . qq{ * $config->[0]: $config->[1]};
130             }
131             }
132             push @intro => ('', '');
133              
134             return join ("\n", @intro) . $string;
135              
136             };
137              
138             sub generate_file {
139 6     6 0 15 my $self = shift;
140              
141 6 50       30 return if !$self->filename; # for doctype:global
142              
143 6 50       45 my $path = Path->check($self->filename) ? $self->filename : Path->coerce($self->filename);
144              
145 6         673 my $new_document = $self->to_string;
146 6 50       49 my $previous_document = $path->exists ? $path->slurp_utf8 : undef;
147              
148 6 50       288 if(!defined $previous_document) {
149 6         39 $path->spew_utf8($new_document);
150 6         7898 say "[Iller] Creates $path";
151 6         393 return;
152             }
153              
154 0           my $comment_start = $self->comment_start;
155 0           my $diff = diff \$previous_document, \$new_document, { STYLE => 'Unified' };
156 0           my $diff_count = 0;
157 0           my $skip_first = 1;
158 0           for my $row (split m{\r?\n}, $diff) {
159 0 0         next if $skip_first-- == 1;
160 0 0         next if $row =~ m{^ };
161 0 0         if($row =~ m{; authordep }) {
162 0           ++$diff_count;
163 0           next;
164             }
165 0 0         next if $row =~ m{^[-+]\s*?$comment_start};
166 0 0         next if $row =~ m{^[-+]\s*$};
167 0           ++$diff_count;
168             }
169              
170 0 0         if($diff_count) {
171 0           $path->spew_utf8($new_document);
172 0           say "[Iller] Generates $path";
173             }
174             else {
175 0           say "[Iller] No changes for $path";
176             }
177             }
178              
179             1;
180              
181             __END__
182              
183             =pod
184              
185             =encoding UTF-8
186              
187             =head1 NAME
188              
189             Dist::Iller::DocType - Role for document types that can be used in Dist::Iller configs
190              
191             =head1 VERSION
192              
193             Version 0.1409, released 2020-12-27.
194              
195             =head1 SOURCE
196              
197             L<https://github.com/Csson/p5-Dist-Iller>
198              
199             =head1 HOMEPAGE
200              
201             L<https://metacpan.org/release/Dist-Iller>
202              
203             =head1 AUTHOR
204              
205             Erik Carlsson <info@code301.com>
206              
207             =head1 COPYRIGHT AND LICENSE
208              
209             This software is copyright (c) 2016 by Erik Carlsson.
210              
211             This is free software; you can redistribute it and/or modify it under
212             the same terms as the Perl 5 programming language system itself.
213              
214             =cut