view release on metacpan or  search on metacpan

lib/Dist/Zilla/Plugin/Bitbucket/Create.pm  view on Meta::CPAN

has 'fork_policy' => (
	is => 'ro',
	isa => enum( [ qw( allow_forks no_public_forks no_forks ) ] ),
	default => 'allow_forks',
);

#pod =attr language
#pod
#pod The programming language used in the repository. Defaults to nothing.
#pod
#pod NOTE: Must be a valid (lowercase) item as shown in the drop-down list on the repository's admin page on the Bitbucket website.
#pod
#pod =cut

has 'language' => (
	is => 'ro',
	isa => 'Maybe[Str]',
);

sub after_mint {
	my $self   = shift;
	my ($opts) = @_;

	return if $self->prompt and not $self->_confirm;

	my $root = $opts->{'mint_root'};

	my $repo_name;

	if ($opts->{'repo'}) {
		$repo_name = $opts->{'repo'};
	} elsif ($self->repo) {
		$repo_name = $self->fill_in_string( $self->repo, { dist => \($self->zilla) }, );
	} else {
		$repo_name = $self->zilla->name;
	}

	# set the repo settings
	my ($params, $headers);
	$params->{'name'} = $repo_name;
	$params->{'is_private'} = 'true' if $self->is_private;
	$params->{'description'} = $self->description if $self->description;
	$params->{'fork_policy'} = $self->fork_policy;
	$params->{'language'} = $self->language if $self->language;

	$params->{'has_issues'} = $self->has_issues ? 'true' : 'false';
	$self->log_debug([ 'Issues are %s', $params -> {'has_issues'} ? 'enabled' : 'disabled' ]);

	$params->{'has_wiki'} = $self->has_wiki ? 'true' : 'false';
	$self->log_debug([ 'Wiki is %s', $params -> {'has_wiki'} ? 'enabled' : 'disabled' ]);

	{
		# we are in a completely different path and as such the auto-detection logic won't work!
		my $p = pushd( $root );
		$p = $p; # shutup UsedVars warning
		$params->{'scm'} = $self->scm;
	}

	# construct the HTTP request!
	my $http = HTTP::Tiny->new;
	my ($login, $pass)  = $self->_get_credentials(0);
	$headers->{'authorization'} = "Basic " . MIME::Base64::encode_base64("$login:$pass", '');
	$headers->{'content-type'} = "application/json";

	# We use the v2.0 API to create
	my $url = 'https://api.bitbucket.org/2.0/repositories/' . $login . '/' . $repo_name; # TODO encode the repo_name and login?
	$self->log([ "Creating new Bitbucket repository '%s'", $repo_name ]);
	my $response = $http->request( 'POST', $url, {
		content => encode_json( $params ),
		headers => $headers
	});

	if ( ! $response->{'success'} ) {
		$self->log( ["Error: HTTP status(%s) when trying to POST => %s", $response->{'status'}, $response->{'reason'} ] );
		return;
	}

	my $r = decode_json( $response->{'content'} );
	if ( ! $r ) {
		$self->log( "ERROR: Malformed response content when trying to POST" );
		return;
	}
	if ( exists $r->{'error'} ) {
		$self->log( [ "Unable to create new Bitbucket repository: %s", $r->{'error'} ] );
		return;
	}

	# Now, we add the remote!
	if ( $self->scm eq 'git' ) {
		my $git_dir = "$root/.git";
		my $rem_ref = $git_dir . "/refs/remotes/" . $self->remote;

		if ((-d $git_dir) && (not -d $rem_ref)) {
			my $git = Git::Wrapper->new($root);

			$self->log_debug([ "Setting Bitbucket remote '%s'", $self->remote ]);

			$git->remote("add", $self->remote, 'git@bitbucket.org:' . $login . '/' . $repo_name . '.git');

			my ($branch) = try { $git->rev_parse( { abbrev_ref => 1, symbolic_full_name => 1 }, 'HEAD' ) };

			if ($branch) {
				try {
					$git->config("branch.$branch.merge");
					$git->config("branch.$branch.remote");
				} catch {
					$self->log_debug([ "Setting up remote tracking for branch '%s'", $branch ]);

					$git->config("branch.$branch.merge", "refs/heads/$branch");
					$git->config("branch.$branch.remote", $self->remote);
				};
			}
		}
	} else {
		# TODO hg doesn't seem to have the same equivalent as git remote - we have to push!
		my $cmd = 'hg push ssh://hg@bitbucket.org/' . $login . '/' . $repo_name;

		# TODO we need a Hg::Wrapper! :)
		`$cmd`; ## no critic (InputOutput::ProhibitBacktickOperators)
	}
}