The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Module::Provision::TraitFor::CreatingDistributions;

use namespace::autoclean;

use Class::Usul::Constants;
use Class::Usul::Functions  qw( emit emit_to io trim );
use Class::Usul::Types      qw( ArrayRef NonEmptySimpleStr );
use English                 qw( -no_match_vars );
use IO::Handle;
use Moo::Role;
use Class::Usul::Options;

requires qw( appbase appldir branch builder chdir config exec_perms
             homedir incdir method output next_argv project_file
             quiet render_templates run_cmd stash testdir vcs );

# Object attributes (public)
option 'editor'     => is => 'lazy', isa => NonEmptySimpleStr,
   documentation    => 'Which text editor to use',
   default          => sub { $_[ 0 ]->config->editor }, format => 's';

# Construction
around '_build_appldir' => sub {
   my ($next, $self, @args) = @_; my $appldir = $self->$next( @args );

   return !$appldir && $self->method eq 'dist'
          ? $self->appbase->catdir( $self->branch ) : $appldir ;
};

around '_build_builder' => sub {
   my ($next, $self, @args) = @_; my $builder = $self->$next( @args );

   return !$builder && $self->method eq 'dist'
        ? $self->config->builder : $builder;
};

around '_build_project' => sub {
   my ($next, $self, @args) = @_; my $project;

   $self->method eq 'dist' and $project = $self->next_argv and return $project;

   return $self->$next( @args );
};

around '_build_vcs' => sub {
   my ($next, $self, @args) = @_; my $vcs = $self->$next( @args );

   return $vcs eq 'none' && $self->method eq 'dist' ? $self->config->vcs : $vcs;
};

# Public Methods
sub create_directories {
   my $self = shift; my $perms = $self->exec_perms;

   $self->output( 'Creating directories' );
   $self->appldir->exists or $self->appldir->mkpath( $perms );
   $self->builder eq 'MB'
      and ($self->incdir->exists or $self->incdir->mkpath( $perms ));
   $self->testdir->exists or $self->testdir->mkpath( $perms );
   $self->homedir->parent->exists or $self->homedir->parent->mkpath( $perms );
   return;
}

sub dist : method {
   my $self = shift;

   $self->dist_pre_hook;
   $self->create_directories;
   $self->render_templates;
   $self->dist_post_hook;
   return OK;
}

sub dist_post_hook {
   my $self = shift;

   $self->generate_metadata( TRUE ); $self->prove;

   return;
}

sub dist_pre_hook {
   my $self = shift; umask $self->_create_mask;

   $self->appbase->exists or $self->appbase->mkpath( $self->exec_perms );
   $self->stash->{abstract} = $self->next_argv || $self->stash->{abstract};
   $self->chdir( $self->appbase );
   return;
}

sub edit_project : method {
   my $self = shift; my $path = $self->_project_file_path;

   $self->run_cmd( $self->editor.SPC.$path, { async => TRUE } );
   return OK;
}

sub generate_metadata {
   my ($self, $create) = @_; $self->chdir( $self->appldir );

   my $mdf; my $verbose = $create ? FALSE : TRUE;

   if ($self->builder eq 'DZ') {
      $self->run_cmd( 'dzil build', $verbose ? { out => 'stdout' } : {} );
      $self->run_cmd( 'dzil clean' );
      $mdf = 'README.md';
   }
   elsif ($self->builder eq 'MB') {
      $self->run_cmd( 'perl '.$self->project_file );
      $self->run_cmd( './Build manifest', $verbose ? { out => 'stdout' } : {} );
      $self->run_cmd( './Build distmeta', $verbose ? { out => 'stdout' } : {} );
      $self->run_cmd( './Build distclean' );
      $mdf = 'README.md';
   }
   elsif ($self->builder eq 'MI') {
      $self->run_cmd( 'perl '.$self->project_file );
      $self->run_cmd( 'make manifest', $verbose ? { out => 'stdout' } : {} );
      $self->run_cmd( 'make clean' );
      $mdf = 'README.mkdn';
   }

   return $create ? $mdf : undef;
}

sub metadata : method {
   my $self = shift; $self->generate_metadata( FALSE ); return OK;
}

sub prove : method {
   my $self = shift; $self->chdir( $self->appldir );

   my $cmd = $self->_get_test_command( $self->next_argv );

   __set_env_true( @{ $self->config->test_env_vars } );

   $self->output ( 'Testing [_1]', { args => [ $self->appldir ] } );
   $self->run_cmd( $cmd, $self->quiet ? {} : { out => 'stdout' } );
   return OK;
}

sub select_project : method {
   my $self     = shift;
   my @projects = $self->base->all_dirs;
   my @options  = map { $_->basename } @projects;
   my $prompt   = 'Select a project from the following list';
   my $index    = $self->get_option( $prompt, undef, TRUE, undef, \@options );

   $index < 0 and return FAILED;

   my $name     = $projects[ $index ]->basename;
   my $project  = Module::Provision->new
      ( noask => TRUE, project => $name, quiet => TRUE );

   $self->chdir( my $dir = $project->appldir );

   my $io = IO::Handle->new; $io->fdopen( 3, 'w' );

   emit_to $io, $dir; $io->close;

   return Module::Provision->new
      ( method => 'edit_project', noask => TRUE, quiet => TRUE )->run;
}

sub show_tab_title : method {
   my $self = shift;
   my $file = $self->next_argv || $self->_project_file_path;
   my $text = (grep { m{ tab-title: }msx } io( $file )->getlines)[ -1 ]
           || ':'.$self->distname;

   emit trim( (split m{ : }msx, $text, 2)[ 1 ] ).SPC.$self->appbase;
   return OK;
}

# Private methods
sub _create_mask {
   return oct '0777' ^ $_[ 0 ]->exec_perms;
}

sub _get_test_command {
   return $_[ 1 ]                  ? 'prove -lv '.$_[ 1 ]
        : $_[ 0 ]->builder eq 'DZ' ? 'dzil test'
                                   : 'prove t';
}

sub _project_file_path {
   return $_[ 0 ]->appldir->catfile( $_[ 0 ]->project_file );
}

# Private functions
sub __set_env_true {
   $ENV{ $_ } = TRUE for (@_); return;
}

1;

__END__

=pod

=encoding utf8

=head1 Name

Module::Provision::TraitFor::CreatingDistributions - Create distributions

=head1 Synopsis

   use Moose;

   extends 'Module::Provision::Base';
   with    'Module::Provision::TraitFor::CreatingDistributions';

=head1 Description

Create distributions using either Git or SVN for the VCS

=head1 Configuration and Environment

Requires these attributes to be defined in the consuming class;
C<appbase>, C<appldir>, C<builder>, C<exec_perms>, C<homedir>,
C<incdir>, C<project_file>, C<render_templates>, C<stash>, C<testdir>,
and C<vcs>

Defines the following attributes;

=over 3

=item <editor>

Which text editor to use. It is a read only, lazily evaluated, simple
string that cannot be null. It defaults to the C<editor> configuration
variable

=back

=head1 Subroutines/Methods

=head2 create_directories

   $self->create_directories;

Creates the required directories for the new distribution. If subclassed this
method can be modified to include additional directories

=head2 dist - Create a new distribution

   $exit_code = $self->dist;

The distributions main module name is specified on the command line

=head2 dist_post_hook

   $self->dist_post_hook;

Runs after the new distribution has been created. If subclassed this method
can be modified to perform additional actions after the templates have been
rendered

=head2 dist_pre_hook

   $self->dist_pre_hook;

Runs before the new distribution is created. If subclassed this method
can be modified to perform additional actions before the project directories
are created

=head2 edit_project - Edit the project file

   $exit_code = $self->edit_project;

The project file is one of; F<dist.ini>, F<Build.PL>, or
F<Makefile.PL> in the current directory

=head2 generate_metadata

   $markdown_file = $self->generate_metadata( $create_flag );

Generates the distribution metadata files. If the create_flag is C<TRUE>
returns the name of the F<README.md> file

=head2 metadata - Generate the distribution metadata files

   $exit_code = $self->metadata;

Calls L</generate_metadata> with the create flag set to C<FALSE>

=head2 prove - Runs the tests for the distribution

   $exit_code = $self->prove;

Returns the exit code

=head2 select_project - List available projects and select one to edit

   $exit_code = $self->select_project

Use from the shell like this:

   cd $(module_provision -q select_project 2>&1 1>/dev/tty)

=head2 show_tab_title - Display the tab title for the current distribution

   $exit_code = $self->show_tab_title;

Print the tab title for the current project to C<STDOUT>

=head1 Diagnostics

None

=head1 Dependencies

=over 3

=item L<Class::Usul>

=item L<Moose::Role>

=back

=head1 Incompatibilities

There are no known incompatibilities in this module

=head1 Bugs and Limitations

There are no known bugs in this module.
Please report problems to the address below.
Patches are welcome

=head1 Acknowledgements

Larry Wall - For the Perl programming language

=head1 Author

Peter Flanigan, C<< <pjfl@cpan.org> >>

=head1 License and Copyright

Copyright (c) 2013 Peter Flanigan. All rights reserved

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself. See L<perlartistic>

This program is distributed in the hope that it will be useful,
but WITHOUT WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE

=cut

# Local Variables:
# mode: perl
# tab-width: 3
# End: