File Coverage

blib/lib/App/ghmulti.pm

Criterion	Covered	Total	%
statement	40	83	48.1
branch	7	38	18.4
condition	1	10	10.0
subroutine	13	21	61.9
pod	0	11	0.0
total	61	163	37.4

package App::ghmulti;

use 5.010;
use strict;
use warnings;

use Carp;

use GitHub::Config::SSH::UserData qw(get_user_data_from_ssh_cfg);
use Git::RemoteURL::Parse qw(parse_git_remote_url);


use Getopt::Std;
# If set to true, exit script after processing --help or --version flags
$Getopt::Std::STANDARD_HELP_VERSION = 1;

use Pod::Usage;

our $VERSION = '0.06';


sub run {
  my %opts;
  getopts('cu', \%opts ) or pod2usage(2);

  usr_error("Too many options") if keys(%opts) > 1;

  if ($opts{u}) {
    my $url = @ARGV ? shift(@ARGV) : get_remote_url();
    usr_error("Too many arguments @ARGV") if @ARGV;
    print (get_ssh_url($url), "\n");
  } elsif ($opts{c}) {
    usr_error("Missing URL") if !@ARGV;
    usr_error("Too many arguments") if @ARGV > 2;
    clone_repo(@ARGV);
  } else {
    usr_error("Too many arguments") if @ARGV;
    config_existing_repo();
  }
}


#
# clone_repo GITHUB_REPO, DIR
# clone_repo GITHUB_REPO
#
# Clones GITHUB_REPO and configures the local clone with the data from ‘~/.ssh/config’.
#
sub clone_repo {
  my ($url, $dir) = @_;
  exit_with_msg("You are in a git repo", 1) if in_git_repo();
  my ($uname, $repo) = get_data_from_gh_url($url);
  $dir //= $repo;
  my $user_data = get_user_data_from_ssh_cfg($uname);
  run_cmd("git clone " . get_ssh_url($url) . " $dir");
  chdir($dir);
  config_user_data($user_data);
  chdir("..");
}


#
# config_existing_repo
#
# Configures the current git repo with the data from ‘~/.ssh/config’. If the
# remote url is already in 'git@github-...' the function prints a message and
# does nothing.
#
sub config_existing_repo {
  my $url = get_remote_url();
  exit_with_msg("Remote URL is already 'git\@github-' format") if ($url =~ /^git\@github-/);
  my ($uname, undef) = get_data_from_gh_url($url);
  my $user_data = get_user_data_from_ssh_cfg($uname);
  run_cmd("git remote set-url origin " . get_ssh_url($url));
  config_user_data($user_data);
}



#
# get_ssh_url GITHUB_URL
#
# Changes GITHUB_URL in our 'git\@github-...' format and returns the result.
#
sub get_ssh_url {
  my $url = shift;
  return $url if ($url =~ /^git\@github-/);
  my ($uname, $repo) = get_data_from_gh_url($url);
  return "git\@github-$uname:$uname/$repo.git";
}


#
# get_data_from_gh_url GITHUB_URL
#
# Returns a two-element list containing user name and repo taken from GITHUB_URL.
#
sub get_data_from_gh_url {
  my $url = shift;
  my $data = parse_git_remote_url($url) // croak("$url: unrecognized URL");
  croak("$data->{service}: non-github service. Not supported.") if $data->{service} ne 'github';
  return ($data->{user}, $data->{repo});
}


#
# in_git_repo
#
# Returns a boolean that flags if you are in a git repo.
#
sub in_git_repo {
  `git status 2>&1`;
  return $? == 0;
}


#
# get_remote_url
#
# Returns the remote url. If you are not in a git repo, the sub terminates
# with an error message.
#
sub get_remote_url {
  exit_with_msg("Not in a git repo", 1) unless in_git_repo();
  my $url = `git remote get-url origin`;
  if ($?) {
    die("Failed to execute get-url");
  }
  chomp($url);
  return $url;
}


#
# config_user_data UDATA
#
# Locally configures user.email and user.name.
# UDATA is a reference to a hash containing 'email' and 'full_name'.
#
sub config_user_data {
  my ($udata) = @_;
  run_cmd("git config user.email \"$udata->{email}\"");
  run_cmd("git config user.name \"$udata->{full_name}\"");
}

# ---

#
# exit_with_msg MSG, EXIT_VALUE
# exit_with_msg MSG
#
# Prints MSG and exits with value EXIT_VALUE (default: 0).
# For EXIT_VALUE != 0 the message is printed to STDERR.
#
sub exit_with_msg {
  my ($msg, $exit_value) = @_;
  $exit_value //= 0;
  my $hndl = $exit_value ? *STDERR : *STDOUT;
  $msg .= "\n" if substr($msg, -1) ne "\n";
  print $hndl ($msg);
  exit $exit_value;
}


#
# run_cmd CMD ECHO
# run_cmd CMD
#
# Executes CMD.
#
# If ECHO is a true value, then CMD is also printed to STDOUT. Default is true (1).
#
sub run_cmd {
  my ($cmd, $echo) = @_;
  $echo //= 1;
  chomp($cmd);
  print("Running: $cmd\n") if $echo;
  system($cmd) == 0 or croak("Failed running  $cmd");
}


sub usr_error {
  pod2usage(-verbose => 1, -message => "$0: $_[0]\n", -output  => \*STDERR, -exitval => 1);
}



# ----------- functions for Getopt::Std, must be in main namespace ---------------------

#
# Print help text, see docu of Getopt::Std.
#
#sub HELP_MESSAGE {
sub main::HELP_MESSAGE {
  pod2usage(-exitval => 0, -verbose => 2);
}

#
# Print version info, see docu of Getopt::Std.
#
sub main::VERSION_MESSAGE {
  print("$0: $VERSION\n");
}


1;


__END__