File Coverage

blib/lib/Dist/Zilla/Plugin/GenerateFile/ShareDir.pm

Criterion	Covered	Total	%
statement	40	40	100.0
branch	2	4	50.0
condition			n/a
subroutine	12	12	100.0
pod	0	2	0.0
total	54	58	93.1

use strict;
use warnings;
package Dist::Zilla::Plugin::GenerateFile::ShareDir;
BEGIN {
  $Dist::Zilla::Plugin::GenerateFile::ShareDir::AUTHORITY = 'cpan:ETHER';
}
# git description: v0.004-1-g7d7dbc7
$Dist::Zilla::Plugin::GenerateFile::ShareDir::VERSION = '0.005';
# ABSTRACT: Create files in the build, based on a template located in a dist sharedir
# vim: set ts=8 sw=4 tw=78 et :

use Moose;
with (
    'Dist::Zilla::Role::FileGatherer',
    'Dist::Zilla::Role::FileMunger',
    'Dist::Zilla::Role::TextTemplate',
);

use MooseX::SlurpyConstructor 1.2;
use Scalar::Util 'blessed';
use File::ShareDir 'dist_file';
use Path::Tiny 0.04;
use Encode;
use namespace::autoclean;

has dist => (
    is => 'ro', isa => 'Str',
    init_arg => '-dist',
    lazy => 1,
    default => sub { (my $dist = blessed(shift)) =~ s/::/-/g; $dist },
);

has filename => (
    init_arg => '-destination_filename',
    is => 'ro', isa => 'Str',
    required => 1,
);

has source_filename => (
    init_arg => '-source_filename',
    is => 'ro', isa => 'Str',
    lazy => 1,
    default => sub { shift->filename },
);

has encoding => (
    init_arg => '-encoding',
    is => 'ro', isa => 'Str',
    lazy => 1,
    default => 'UTF-8',
);

has _extra_args => (
    isa => 'HashRef[Str]',
    init_arg => undef,
    lazy => 1,
    default => sub { {} },
    traits => ['Hash'],
    handles => { _extra_args => 'elements' },
    slurpy => 1,
);

around BUILDARGS => sub
{
    my $orig = shift;
    my $class = shift;

    my $args = $class->$orig(@_);
    $args->{'-destination_filename'} = delete $args->{'-filename'} if exists $args->{'-filename'};

    return $args;
};

around dump_config => sub
{
    my ($orig, $self) = @_;
    my $config = $self->$orig;

    $config->{'' . __PACKAGE__} = {
        # XXX FIXME - it seems META.* does not like the leading - in field
        # names! something is wrong with the serialization process.
        'dist' => $self->dist,
        'encoding' => $self->encoding,
        'source_filename' => $self->source_filename,
        'destination_filename' => $self->filename,
        $self->_extra_args,
    };
    return $config;
};

sub gather_files
{
    my $self = shift;

    # this should die if the file does not exist
    my $file = dist_file($self->dist, $self->source_filename);

    my $content = path($file)->slurp_raw;
    $content = Encode::decode($self->encoding, $content, Encode::FB_CROAK());

    require Dist::Zilla::File::InMemory;
    $self->add_file(Dist::Zilla::File::InMemory->new(
        name => $self->filename,
        encoding => $self->encoding,    # only used in Dist::Zilla 5.000+
        content => $content,
    ));
}

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

    return unless $file->name eq $self->filename;
    $self->log_debug([ 'updating contents of %s in memory', $file->name ]);

    my $content = $self->fill_in_string(
        $file->content,
        {
            $self->_extra_args,     # must be first
            dist => \($self->zilla),
            plugin => \$self,
        },
    );

    # older Dist::Zilla wrote out all files :raw, so we need to encode manually here.
    $content = Encode::encode($self->encoding, $content, Encode::FB_CROAK()) if Dist::Zilla->VERSION < 5.000;

    $file->content($content);
}

__PACKAGE__->meta->make_immutable;

__END__

=pod

=encoding UTF-8

=for :stopwords Karen Etheridge sharedir irc

=head1 NAME

Dist::Zilla::Plugin::GenerateFile::ShareDir - Create files in the build, based on a template located in a dist sharedir

=head1 VERSION

version 0.005

=head1 SYNOPSIS

In your F<dist.ini>:

    [GenerateFile::ShareDir]
    -dist = Dist::Zilla::PluginBundle::Author::ME
    -source_filename = my_data_template.txt
    -destination_filename = examples/my_data.txt
    key1 = value to pass to template
    key2 = another value to pass to template

=head1 DESCRIPTION

Generates a file in your dist, indicated by C<-destination_file>, based on the
L<Text::Template> located in the C<-source_file> of C<-dist>'s
L<distribution sharedir|File::ShareDir>. Any extra config values are passed
along to the template, in addition to C<$zilla> and C<$plugin> objects.

I expect that usually the C<-dist> that contains the template will be either a
plugin bundle, so you can generate a custom-tailored file in your dist, or a
plugin that subclasses this one.  (Otherwise, you can just as easily use
L<Dist::Zilla::Plugin::ShareDir|[GatherDir::Template]> to generate the file
directly, without needing a sharedir.)

=for Pod::Coverage::TrustPod gather_files
    munge_file

=head1 OPTIONS

This plugin accepts the following options:

=over 4

=item * C<-dist>

The distribution name to use when finding the sharedir (see L<File::ShareDir>
and L<Dist::Zilla::Plugin::ShareDir>). Defaults to the dist corresponding to
the running plugin.

=item * C<-destination_filename> or C<-filename>

The filename to generate in the distribution being built. Required.

=item * C<-source_filename>

The filename in the sharedir to use to generate the new file. Defaults to the
same filename and path as C<-destination_file>.

=item * C<-encoding>

The encoding of the source file; will also be used for the encoding of the
destination file. Defaults to UTF-8.

=item * C<arbitrary option>

All other keys/values provided will be passed to the template as is.

=back

=head1 SUPPORT

Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=Dist-Zilla-Plugin-GenerateFile-ShareDir>
(or L<[e-mail]|mailto:[e-mail]>).
I am also usually active on irc, as 'ether' at C<irc.perl.org>.

=head1 SEE ALSO

=over 4

=item *

L<File::ShareDir>

=item *

L<Dist::Zilla::Plugin::ShareDir>

=item *

L<Text::Template>

=back

=head1 AUTHOR

Karen Etheridge <[e-mail]>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2013 by Karen Etheridge.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut