File Coverage

blib/lib/Git/Megapull.pm

Criterion	Covered	Total	%
statement	18	59	30.5
branch	0	24	0.0
condition	0	3	0.0
subroutine	6	11	54.5
pod	2	2	100.0
total	26	99	26.2

use strict;
use warnings;
package Git::Megapull;
{
  $Git::Megapull::VERSION = '0.101752';
}
use base 'App::Cmd::Simple';
# ABSTRACT: clone or update all repositories found elsewhere

use autodie;
use Config::GitLike;
use String::RewritePrefix;


sub opt_spec {
  return (
    # [ 'private|p!', 'include private repositories'     ],
    [ 'bare|b!',    'produce bare clones'                              ],
    [ 'clonely|c',  'only clone things that do not exist; skip others' ],
    [ 'origin=o',   'name to use when creating or fetching; default: origin',
                    { default => 'origin' }                            ],
    [ 'source|s=s', "the source class (or a short form of it)",
                    { default => $ENV{GIT_MEGAPULL_SOURCE} }           ],
  );
}

sub execute {
  my ($self, $opt, $args) = @_;

  my $source = $opt->{source};
  unless ($source) {
    my $config = Config::GitLike->new(confname => "$ENV{HOME}/.gitconfig");
    $config->load;
    $source = $config->get(key => "megapull.source");
  }

  $source ||= $self->_default_source;

  $self->usage_error("no source provided") unless $source;

  $source = String::RewritePrefix->rewrite(
    { '' => 'Git::Megapull::Source::', '=' => '' },
    $source,
  );

  # XXX: validate $source as module name -- rjbs, 2009-09-13
  # XXX: validate $opt->{origin} -- rjbs, 2009-09-13

  eval "require $source; 1" or die;

  die "bad source: not a Git::Megapull::Source\n"
    unless eval { $source->isa('Git::Megapull::Source') };

  my $repos = $source->repo_uris;

  my %existing_dir  = map { $_ => 1 } grep { $_ !~ m{\A\.} and -d $_ } <*>;

  for my $name (sort { $a cmp $b } keys %$repos) {
    my $name = $name;
    my $uri  = $repos->{ $name };
    my $dirname = $opt->{bare} ? "$name.git" : $name;

    if (-d $dirname) {
      if (not $opt->{clonely}) {
        my $merge = $opt->{bare} ? '' : "&& git merge $opt->{origin}/master";
        $self->__do_cmd(
          "cd $dirname && "
          . "git fetch $opt->{origin} $merge"
        );
      }
    } else {
      $self->_clone_repo($name, $uri, $opt);
    }

    delete $existing_dir{ $dirname };
  }

  for (keys %existing_dir) {
    warn "unknown directory found: $_\n";
  }
}

sub _default_source {}
sub _clone_repo {
  my ($self, $repo, $uri, $opt) = @_;

  my $bare = $opt->{bare} ? '--bare' : '';
  # git clone --origin doesn't work with --bare on git 1.6.6.1 or git
  # 1.7: "fatal: --bare and --origin origin options are incompatible."
  my $orig = $opt->{bare} ? ''       : "--origin $opt->{origin}";
  $self->__do_cmd("git clone $orig $bare $uri");

  if ($opt->{bare}) {
      # Add an origin remote so we can git fetch later
      my ($target) = $uri =~ m[/(.*?)$];
      $self->__do_cmd("(cd $target && git remote add origin $uri && cd ..)");
  }
}

sub __do_cmd {
  my ($self, $cmd) = @_;
  print "$cmd\n";
  system("$cmd");
}

1;

__END__