File Coverage

blib/lib/Dist/Zilla/Plugin/ShareEmbed.pm
Criterion Covered Total %
statement 26 69 37.6
branch 0 10 0.0
condition n/a
subroutine 9 15 60.0
pod 0 4 0.0
total 35 98 35.7


line stmt bran cond sub pod time code
1             package Dist::Zilla::Plugin::ShareEmbed 0.003;
2 1     1   13363 use 5.14.0;
  1         2  
3 1     1   3 use warnings;
  1         1  
  1         20  
4              
5 1     1   403 use File::pushd ();
  1         17030  
  1         29  
6 1     1   382 use MIME::Base64 ();
  1         1025  
  1         20  
7 1     1   446 use Moose;
  1         288512  
  1         7  
8 1     1   5176 use Path::Tiny ();
  1         7178  
  1         21  
9 1     1   404 use namespace::autoclean;
  1         5107  
  1         3  
10 1     1   42 use B ();
  1         1  
  1         152  
11              
12             with qw(
13             Dist::Zilla::Role::AfterBuild
14             Dist::Zilla::Role::FilePruner
15             );
16              
17             has module => (
18             is => 'rw',
19             isa => 'Str',
20             lazy => 1,
21             default => sub {
22             my $self = shift;
23             my $name = $self->zilla->name;
24             $name =~ s{-}{::}g;
25             "$name\::Share";
26             },
27             );
28              
29             has path => (
30             is => 'rw',
31             isa => 'Path::Tiny',
32             lazy => 1,
33             default => sub {
34             my $self = shift;
35             my $name = $self->zilla->name;
36             $name =~ s{-}{/}g;
37             Path::Tiny->new("lib/$name/Share.pm");
38             },
39             );
40              
41             if (exists $INC{"Dist/Zilla/Dist/Builder.pm"}) {
42             # XXX I don't know the best way to do this :)
43             package
44             Dist::Zilla::Dist::Builder;
45 1     1   4 no warnings 'redefine';
  1         0  
  1         392  
46             sub _build_share_dir_map {
47 0     0     return +{};
48             }
49             }
50              
51             sub has_share {
52 0     0 0   my $self = shift;
53 0           $self->zilla->root->child("share")->is_dir;
54             }
55              
56             sub after_build {
57 0     0 0   my $self = shift;
58 0 0         return unless $self->has_share;
59 0           $self->embed_share;
60             }
61              
62             sub prune_files {
63 0     0 0   my $self = shift;
64 0 0         return unless $self->has_share;
65              
66             # XXX This copy is needed.
67             # because $self->zilla->prune_file splices $self->zilla->files
68 0           my @file = @{ $self->zilla->files };
  0            
69              
70 0           for my $file (@file) {
71 0 0         if ($file->name =~ m{^share/}) {
72 0           $self->zilla->prune_file($file);
73             }
74             }
75 0           return;
76             }
77              
78             my $HEAD = <<'___';
79             use strict;
80             use warnings;
81             use MIME::Base64 ();
82              
83             my %file;
84              
85             ___
86              
87             my $FOOT = <<'___';
88             sub file {
89             my $class = shift;
90             @_ ? $file{$_[0]} : \%file;
91             }
92              
93             1;
94             ___
95              
96             sub embed_share {
97 0     0 0   my $self = shift;
98              
99 0           my $share = $self->zilla->root->child("share");
100 0           my %file;
101             {
102 0           my $guard = File::pushd::pushd("$share");
  0            
103             my $visit = sub {
104 0     0     my ($path, $state) = @_;
105 0 0         return if $path->is_dir;
106 0           my $content = $path->slurp_raw;
107 0           $file{ "$path" } = MIME::Base64::encode_base64($content);
108 0           };
109 0           Path::Tiny->new(".")->visit($visit, {recurse => 1});
110             }
111 0           my $path = $self->path;
112 0 0         $path->parent->mkpath unless $path->parent->is_dir;
113 0           $self->log("Embedding share/ to $path");
114 0           my $fh = $path->openw_raw;
115 0           print {$fh} "package " . $self->module . ";\n";
  0            
116 0           print {$fh} $HEAD;
  0            
117 0           for my $name (sort keys %file) {
118 0           my $quoted = B::perlstring($name);
119 0           print {$fh} "\$file{$quoted} = MIME::Base64::decode_base64(<<'___');\n";
  0            
120 0           print {$fh} $file{$name};
  0            
121 0           print {$fh} "___\n\n";
  0            
122             }
123 0           print {$fh} $FOOT;
  0            
124             }
125              
126             __PACKAGE__->meta->make_immutable;
127              
128             1;
129             __END__
130              
131             =encoding utf-8
132              
133             =for stopwords pm
134              
135             =head1 NAME
136              
137             Dist::Zilla::Plugin::ShareEmbed - Embed share files to .pm file
138              
139             =head1 SYNOPSIS
140              
141             In your dist.ini:
142              
143             [ShareEmbed]
144              
145             Then
146              
147             > dzil build
148              
149             > find lib -type f
150             lib/Your/Module.pm
151             lib/Your/Module/Share.pm <=== Created!
152              
153             =head1 DESCRIPTION
154              
155             Dist::Zilla::Plugin::ShareEmbed embeds share files to C<lib/Your/Module/Share.pm>,
156             so that you can use share files like:
157              
158             use Your::Module::Share;
159              
160             # returns content of share/foo/bar.txt
161             my $bar = Your::Module::Share->file("foo/bar.txt");
162              
163             # returns all contens of files in share directory
164             my $all = Your::Module::Share->file;
165              
166             This plugin may be useful when you intend to fatpack your modules.
167              
168             =head1 AUTHOR
169              
170             Shoichi Kaji <skaji@cpan.org>
171              
172             =head1 COPYRIGHT AND LICENSE
173              
174             Copyright 2016 Shoichi Kaji <skaji@cpan.org>
175              
176             This library is free software; you can redistribute it and/or modify
177             it under the same terms as Perl itself.
178              
179             =cut