Dist::Zilla - distribution builder; installer not included!

  main_module = lib/Foo/Bar.pm

  [
    'Ricardo Signes <rjbs@cpan.org>',
    'X. Ample, Jr <example@example.biz>',
  ]

  my $plugin = $zilla->plugin_named( $plugin_name );

  my $roles = $zilla->plugins_with( -SomeRole );

  my $files = $zilla->find_files( $finder_name );

  my $stash = $zilla->stash_named( $name );

package Dist::Zilla;
BEGIN {
  $Dist::Zilla::VERSION = '4.200008';
}
# ABSTRACT: distribution builder; installer not included!
use Moose 0.92; # role composition fixes
with 'Dist::Zilla::Role::ConfigDumper';

use Moose::Autobox 0.09; # ->flatten
use MooseX::LazyRequire;
use MooseX::Types::Moose qw(ArrayRef Bool HashRef Object Str);
use MooseX::Types::Perl qw(DistName LaxVersionStr);
use MooseX::Types::Path::Class qw(Dir File);
use Moose::Util::TypeConstraints;

use Dist::Zilla::Types qw(License);

use Hash::Merge::Simple ();
use Log::Dispatchouli 1.100712; # proxy_loggers, quiet_fatal
use Path::Class;
use List::Util qw(first);
use Software::License 0.101370; # meta2_name
use String::RewritePrefix;
use Try::Tiny;

use Dist::Zilla::Prereqs;
use Dist::Zilla::File::OnDisk;
use Dist::Zilla::Role::Plugin;
use Dist::Zilla::Util;

use namespace::autoclean;


has chrome => (
  is  => 'rw',
  isa => role_type('Dist::Zilla::Role::Chrome'),
  required => 1,
);


has name => (
  is   => 'ro',
  isa  => DistName,
  lazy_required => 1,
);


has _version_override => (
  isa => LaxVersionStr,
  is  => 'ro' ,
  init_arg => 'version',
);

# XXX: *clearly* this needs to be really much smarter -- rjbs, 2008-06-01
has version => (
  is   => 'rw',
  isa  => LaxVersionStr,
  lazy => 1,
  init_arg  => undef,
  required  => 1,
  builder   => '_build_version',
);

sub _build_version {
  my ($self) = @_;

  my $version = $self->_version_override;

  for my $plugin ($self->plugins_with(-VersionProvider)->flatten) {
    next unless defined(my $this_version = $plugin->provide_version);

    $self->log_fatal('attempted to set version twice') if defined $version;

    $version = $this_version;
  }

  $self->log_fatal('no version was ever set') unless defined $version;

  $version;
}


has abstract => (
  is   => 'rw',
  isa  => 'Str',
  lazy => 1,
  required => 1,
  default  => sub {
    my ($self) = @_;

    unless ($self->main_module) {
      die "no abstract given and no main_module found; make sure your main module is in ./lib\n";
    }

    my $file = $self->main_module;
    $self->log("extracting distribution abstract from " . $file->name);
    my $abstract = Dist::Zilla::Util->abstract_from_file($file);

    if (!defined($abstract)) {
        my $filename = $file->name;
        die "Unable to extract an abstract from $filename. Please add the following comment to the file with your abstract:
        # ABSTRACT: turns baubles into trinkets
";
    }

    return $abstract;
  }
);


has _main_module_override => (
  isa => 'Str',
  is  => 'ro' ,
  init_arg  => 'main_module',
  predicate => '_has_main_module_override',
);

has main_module => (
  is   => 'ro',
  isa  => 'Dist::Zilla::Role::File',
  lazy => 1,
  init_arg => undef,
  required => 1,
  default  => sub {

    my ($self) = @_;

    my $file;
    my $guessing = q{};
    my $guess;

    if ( $self->_has_main_module_override ) {
       $file = first { $_->name eq $self->_main_module_override }
               $self->files->flatten;
    } else {
       $guessing = 'guessing '; # We're having to guess

       ($guess = $self->name) =~ s{-}{/}g;
       $guess = "lib/$guess.pm";

       $file = (first { $_->name eq $guess } $self->files->flatten)
           ||  $self->files
             ->grep(sub { $_->name =~ m{\.pm\z} and $_->name =~ m{\Alib/} })
             ->sort(sub { length $_[0]->name <=> length $_[1]->name })
             ->head;
    }

    if (not $file) {
        my @errorlines;

        push @errorlines, "Unable to find main_module in the distribution";
        if ( $self->_has_main_module_override ) {
            push @errorlines, "'main_module' was specified in dist.ini but the file '" . $self->_main_module_override . "' is not to be found in our dist. ( Did you add it? )";
        } else {
            push @errorlines,"We tried to guess '$guess' but no file like that existed";
        }
        if ( not $self->files->flatten ) {
            push @errorlines, "Upon further inspection we didn't find any files in your dist, did you add any?";
        } elsif ( not $self->files->grep(sub{ $_->name =~ m{\.pm\z} })->head ){
            push @errorlines, "We didn't find any .pm files in your dist, this is probably a problem.";
        }
        push @errorlines,"Cannot continue without a main_module";
        $self->log_fatal( join qq{\n}, @errorlines );
    }
    $self->log("${guessing}dist's main_module is " . $file->name);

    return $file;
  },
);


has license => (
  is   => 'ro',
  isa  => License,
  lazy => 1,
  init_arg  => 'license_obj',
  predicate => '_has_license',
  builder   => '_build_license',
  handles   => {
    copyright_holder => 'holder',
    copyright_year   => 'year',
  },
);

sub _build_license {
  my ($self) = @_;

  my $license_class    = $self->_license_class;
  my $copyright_holder = $self->_copyright_holder;
  my $copyright_year   = $self->_copyright_year;

  if ($license_class) {
    $license_class = String::RewritePrefix->rewrite(
      {
        '=' => '',
        ''  => 'Software::License::'
      },
      $license_class,
    );
  } else {
    require Software::LicenseUtils;
    my @guess = Software::LicenseUtils->guess_license_from_pod(
      $self->main_module->content
    );

    if (@guess != 1) {
      $self->log_fatal(
        "no license data in config, no %Rights stash,",
        "couldn't make a good guess at license from Pod; giving up"
      );
    }

    my $filename = $self->main_module->name;
    $license_class = $guess[0];
    $self->log("based on POD in $filename, guessing license is $guess[0]");
  }

  Class::MOP::load_class($license_class);

  my $license = $license_class->new({
    holder => $self->_copyright_holder,
    year   => $self->_copyright_year,
  });

  $self->_clear_license_class;
  $self->_clear_copyright_holder;
  $self->_clear_copyright_year;

  return $license;
}

has _license_class => (
  is        => 'ro',
  isa       => 'Maybe[Str]',
  lazy      => 1,
  init_arg  => 'license',
  clearer   => '_clear_license_class',
  default   => sub {
    my $stash = $_[0]->stash_named('%Rights');
    $stash && return $stash->license_class;
    return;
  }
);

has _copyright_holder => (
  is        => 'ro',
  isa       => 'Maybe[Str]',
  lazy      => 1,
  init_arg  => 'copyright_holder',
  clearer   => '_clear_copyright_holder',
  default   => sub {
    return unless my $stash = $_[0]->stash_named('%Rights');
    $stash && return $stash->copyright_holder;
    return;
  }
);

has _copyright_year => (
  is        => 'ro',
  isa       => 'Int',
  lazy      => 1,
  init_arg  => 'copyright_year',
  clearer   => '_clear_copyright_year',
  default   => sub {
    # Oh man.  This is a terrible idea!  I mean, what if by the code gets run
    # around like Dec 31, 23:59:59.9 and by the time the default gets called
    # it's the next year but the default was already set up?  Oh man.  That
    # could ruin lives!  I guess we could make this a sub to defer the guess,
    # but think of the performance hit!  I guess we'll have to suffer through
    # this until we can optimize the code to not take .1s to run, right? --
    # rjbs, 2008-06-13
    my $stash = $_[0]->stash_named('%Rights');
    my $year  = $stash && $stash->copyright_year;
    return defined $year ? $year : (localtime)[5] + 1900;
  }
);


has authors => (
  is   => 'ro',
  isa  => ArrayRef[Str],
  lazy => 1,
  required => 1,
  default  => sub {
    my ($self) = @_;

    if (my $stash  = $self->stash_named('%User')) {
      return $stash->authors;
    }

    my $author = try { $self->copyright_holder };
    return [ $author ] if defined $author and length $author;

    $self->log_fatal(
      "No %User stash and no copyright holder;",
      "can't determine dist author; configure author or a %User section",
    );
  },
);


has files => (
  is   => 'ro',
  isa  => ArrayRef[ role_type('Dist::Zilla::Role::File') ],
  lazy => 1,
  init_arg => undef,
  default  => sub { [] },
);

sub prune_file {
  my ($self, $file) = @_;
  my @files = @{ $self->files };

  for my $i (0 .. $#files) {
    next unless $file == $files[ $i ];
    splice @{ $self->files }, $i, 1;
    return;
  }

  return;
}


has root => (
  is   => 'ro',
  isa  => Dir,
  coerce   => 1,
  required => 1,
);


has is_trial => (
  is => 'rw', # XXX: make SetOnce -- rjbs, 2010-03-23
  isa => Bool,
  default => sub { $ENV{TRIAL} ? 1 : 0 }
);


has plugins => (
  is   => 'ro',
  isa  => 'ArrayRef[Dist::Zilla::Role::Plugin]',
  init_arg => undef,
  default  => sub { [ ] },
);


has distmeta => (
  is   => 'ro',
  isa  => 'HashRef',
  init_arg  => undef,
  lazy      => 1,
  builder   => '_build_distmeta',
);

sub _build_distmeta {
  my ($self) = @_;

  my $meta = {
    'meta-spec' => {
      version => 2,
      url     => 'http://github.com/dagolden/cpan-meta/',
    },
    name     => $self->name,
    version  => $self->version,
    abstract => $self->abstract,
    author   => $self->authors,
    license  => $self->license->meta2_name,

    # XXX: what about unstable?
    release_status => ($self->is_trial or $self->version =~ /_/)
                    ? 'testing'
                    : 'stable',

    dynamic_config => 0, # problematic, I bet -- rjbs, 2010-06-04
    generated_by   => $self->_metadata_generator_id
                    . ' version '
                    . (defined $self->VERSION ? $self->VERSION : '(undef)')
  };

  $meta = Hash::Merge::Simple::merge($meta, $_->metadata)
    for $self->plugins_with(-MetaProvider)->flatten;

  return $meta;
}

sub _metadata_generator_id { 'Dist::Zilla' }


has prereqs => (
  is   => 'ro',
  isa  => 'Dist::Zilla::Prereqs',
  init_arg => undef,
  default  => sub { Dist::Zilla::Prereqs->new },
  handles  => [ qw(register_prereqs) ],
);


sub plugin_named {
  my ($self, $name) = @_;
  my $plugin = first { $_->plugin_name eq $name } $self->plugins->flatten;

  return $plugin if $plugin;
  return;
}


sub plugins_with {
  my ($self, $role) = @_;

  $role =~ s/^-/Dist::Zilla::Role::/;
  my $plugins = $self->plugins->grep(sub { $_->does($role) });

  return $plugins;
}


sub find_files {
  my ($self, $finder_name) = @_;

  $self->log_fatal("no plugin named $finder_name found")
    unless my $plugin = $self->plugin_named($finder_name);

  $self->log_fatal("plugin $finder_name is not a FileFinder")
    unless $plugin->does('Dist::Zilla::Role::FileFinder');

  $plugin->find_files;
}

sub _check_dupe_files {
  my ($self) = @_;

  my %files_named;
  for my $file ($self->files->flatten) {
    ($files_named{ $file->name} ||= [])->push($file);
  }

  return unless
    my @dupes = grep { $files_named{$_}->length > 1 } keys %files_named;

  for my $name (@dupes) {
    $self->log("attempt to add $name multiple times; added by: "
       . join('; ', map { $_->added_by } @{ $files_named{ $name } })
    );
  }

  Carp::croak("aborting; duplicate files would be produced");
}

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

  # Okay, this is a bit much, until we have ->debug. -- rjbs, 2008-06-13
  # $self->log("writing out " . $file->name);

  my $file_path = file($file->name);

  my $to_dir = $build_root->subdir( $file_path->dir );
  my $to = $to_dir->file( $file_path->basename );
  $to_dir->mkpath unless -e $to_dir;
  die "not a directory: $to_dir" unless -d $to_dir;

  Carp::croak("attempted to write $to multiple times") if -e $to;

  open my $out_fh, '>', "$to" or die "couldn't open $to to write: $!";

  # This is needed, or \n is translated to \r\n on win32.
  # Maybe :raw:utf8 is needed, but not sure.
  #     -- Kentnl - 2010-06-10
  binmode( $out_fh , ":raw" );

  print { $out_fh } $file->content;
  close $out_fh or die "error closing $to: $!";
  chmod $file->mode, "$to" or die "couldn't chmod $to: $!";
}


has logger => (
  is   => 'ro',
  isa  => 'Log::Dispatchouli::Proxy', # could be duck typed, I guess
  lazy => 1,
  handles => [ qw(log log_debug log_fatal) ],
  default => sub {
    $_[0]->chrome->logger->proxy({ proxy_prefix => '[DZ] ' })
  },
);

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

has _local_stashes => (
  is   => 'ro',
  isa  => HashRef[ Object ],
  lazy => 1,
  default => sub { {} },
);

has _global_stashes => (
  is   => 'ro',
  isa  => HashRef[ Object ],
  lazy => 1,
  default => sub { {} },
);


sub stash_named {
  my ($self, $name) = @_;

  return $self->_local_stashes->{ $name } if $self->_local_stashes->{$name};
  return $self->_global_stashes->{ $name };
}

__PACKAGE__->meta->make_immutable;
1;

__END__