view release on metacpan or  search on metacpan

lib/Module/Provision/TraitFor/VCS.pm  view on Meta::CPAN

option 'no_auto_rev' => is => 'ro',   isa => Bool, default => FALSE,
   documentation     => 'Do not turn on Revision keyword expansion';

has 'cmd_line_flags' => is => 'lazy', isa => HashRef[Bool],
   builder           => $_build_cmd_line_flags;

# Private attributes
has '_new_version'   => is => 'rwp',  isa => Str;

# Private functions
my $_get_state_file_name = sub {
   return (map  { m{ load-project-state \s+ [\'\"](.+)[\'\"] }mx; }
           grep { m{ eval: \s+ \( \s* load-project-state }mx }
           io( $_[ 0 ] )->getlines)[ -1 ];
};

my $_tag_from_version = sub {
   my $ver = shift; return $ver->component( 0 ).'.'.$ver->component( 1 );
};

# Private methods
my $_add_git_hooks = sub {
   my ($self, @hooks) = @_;

   for my $hook (grep { -e ".git${_}" } @hooks) {
      my $dest = $self->appldir->catfile( '.git', 'hooks', $hook );

      $dest->exists and $dest->unlink; link ".git${hook}", $dest;
      chmod $self->exec_perms, ".git${hook}";
   }

   return;
};

my $_add_tag_to_git = sub {
   my ($self, $tag) = @_;

   my $message = $self->loc( $self->config->tag_message );
   my $sign    = $self->config->signing_key; $sign and $sign = "-u ${sign}";

   $self->run_cmd( "git tag -d v${tag}", { err => 'null', expected_rv => 1 } );
   $self->run_cmd( "git tag ${sign} -m '${message}' v${tag}" );
   return;
};

my $_add_to_git = sub {
   my ($self, $target, $type) = @_;

   my $params = $self->quiet ? {} : { out => 'stdout' };

   $self->run_cmd( "git add ${target}", $params );
   return;
};

my $_add_to_svn = sub {
   my ($self, $target, $type) = @_;

   my $params = $self->quiet ? {} : { out => 'stdout' };

   $self->run_cmd( "svn add ${target} --parents", $params );
   $self->run_cmd( "svn propset svn:keywords 'Id Revision Auth' ${target}",
                   $params );
   $type and $type eq 'program'
      and $self->run_cmd( "svn propset svn:executable '*' ${target}", $params );
   return;
};

my $_commit_release_to_git = sub {
   my ($self, $msg) = @_;

   $self->run_cmd( 'git add .' ); $self->run_cmd( "git commit -m '${msg}'" );

   return;
};

my $_commit_release_to_svn = sub {
   # TODO: Fill this in
};

my $_get_rev_file = sub {
   my $self = shift; ($self->no_auto_rev or $self->vcs ne 'git') and return;

   return $self->appldir->parent->catfile( lc '.'.$self->distname.'.rev' );
};

my $_get_svn_repository = sub {
   my $self = shift; my $info = $self->run_cmd( 'svn info' )->stdout;

   return (split m{ : \s }mx, (grep { m{ \A Repository \s Root: }mx }
                               split  m{ \n }mx, $info)[ 0 ])[ 1 ];
};

my $_get_version_numbers = sub {
   my ($self, @args) = @_; $args[ 0 ] and $args[ 1 ] and return @args;

   my $prompt = '+Enter major/minor 0 or 1';
   my $comp   = $self->get_line( $prompt, 1, TRUE, 0 );
      $prompt = '+Enter increment/decrement';
   my $bump   = $self->get_line( $prompt, 1, TRUE, 0 ) or return @args;
   my ($from, $ver);

   if ($from = $args[ 0 ]) { $ver = Perl::Version->new( $from ) }
   else {
      $ver  = $self->dist_version or return @args;
      $from = $_tag_from_version->( $ver );
   }

   $ver->component( $comp, $ver->component( $comp ) + $bump );
   $comp == 0 and $ver->component( 1, 0 );

   return ($from, $_tag_from_version->( $ver ));
};

my $_initialize_svn = sub {
   my $self = shift; my $class = blessed $self; $self->chdir( $self->appbase );

   my $repository = $self->appbase->catdir( $self->repository );

   $self->run_cmd( "svnadmin create ${repository}" );

   my $branch = $self->branch;
   my $url    = 'file://'.$repository->catdir( $branch );
   my $msg    = $self->loc( 'Initialised by [_1]', $class );

   $self->run_cmd( "svn import ${branch} ${url} -m '${msg}'" );

   my $appldir = $self->appldir; $appldir->rmtree;

   $self->run_cmd( "svn co ${url}" );
   $appldir->filter( sub { $_ !~ m{ \.git }msx and $_ !~ m{ \.svn }msx } );

   for my $target ($appldir->deep->all_files) {
      $self->run_cmd( "svn propset svn:keywords 'Id Revision Auth' ${target}" );
   }

   $msg = $self->loc( 'Add RCS keywords to project files' );
   $self->run_cmd( "svn commit ${branch} -m '${msg}'" );
   $self->chdir( $self->appldir );
   $self->run_cmd( 'svn update' );
   return;
};

my $_push_to_git_remote = sub {
   my $self = shift; my $info = $self->run_cmd( 'git remote -v' )->stdout;

   (grep { m{ \(push\) \z }mx } split m{ \n }mx, $info)[ 0 ] or return;

   my $params = $self->quiet ? {} : { out => 'stdout' };

   $self->run_cmd( 'git push --all',  $params );
   $self->run_cmd( 'git push --tags', $params );
   return;
};

my $_push_to_remote = sub {
   my $self = shift;

   $self->vcs eq 'git' and $self->$_push_to_git_remote;
   return;
};

my $_svn_ignore_meta_files = sub {
   my $self = shift; $self->chdir( $self->appldir );

   my $ignores = "LICENSE\nMANIFEST\nMETA.json\nMETA.yml\nREADME\nREADME.md";

   $self->run_cmd( "svn propset svn:ignore '${ignores}' ." );
   $self->run_cmd( 'svn commit -m "Ignoring meta files" .' );
   $self->run_cmd( 'svn update' );
   return;
};

my $_wrap = sub {
   my $self = shift; my $method = shift; return not $self->$method( @_ );
};

my $_add_tag_to_svn = sub {
   my ($self, $tag) = @_; my $params = $self->quiet ? {} : { out => 'stdout' };

   my $repo    = $self->$_get_svn_repository;
   my $from    = "${repo}/trunk";
   my $to      = "${repo}/tags/v${tag}";
   my $message = $self->loc( $self->config->tag_message )." v${tag}";
   my $cmd     = "svn copy --parents -m '${message}' ${from} ${to}";

   $self->run_cmd( $cmd, $params );
   return;
};

my $_commit_release = sub {
   my ($self, $tag) = @_; my $msg = $self->config->tag_message." v${tag}";

   $self->vcs eq 'git' and $self->$_commit_release_to_git( $msg );
   $self->vcs eq 'svn' and $self->$_commit_release_to_svn( $msg );
   return;
};

my $_initialize_git = sub {
   my $self = shift;
   my $msg  = $self->loc( 'Initialised by [_1]', blessed $self );

   $self->chdir( $self->appldir ); $self->run_cmd( 'git init' );

   $self->add_hooks; $self->$_commit_release_to_git( $msg );

   return;
};

my $_reset_rev_file = sub {
   my ($self, $create) = @_; my $file = $self->$_get_rev_file;

   $file and ($create or $file->exists)
         and $file->println( $create ? '1' : '0' );
   return;
};

my $_reset_rev_keyword = sub {
   my ($self, $path) = @_;

   my $zero = 0; # Zero variable prevents unwanted Rev keyword expansion

   $self->$_get_rev_file and $path->substitute
      ( '\$ (Rev (?:ision)?) (?:[:] \s+ (\d+) \s+)? \$', '$Rev: '.$zero.' $' );
   return;
};

my $_add_tag = sub {