—#!/usr/bin/perl
# Created on: 2017-04-24 08:14:56
# Create by: Ivan Wills
# $Id$
# $Revision$, $HeadURL$, $Date$
# $Revision$, $Source$, $Date$
use
strict;
use
warnings;
use
Getopt::Alt;
use
App::BitBucketCli;
our
$VERSION
= 0.004;
my
(
$name
) =
$PROGRAM_NAME
=~ m{^.*/(.*?)$}mxs;
exit
main();
sub
main {
my
@common
= (
'colors|c=s%'
,
'force|f!'
,
'host|h=s'
,
'long|l'
,
'password|P=s'
,
'project|p=s'
,
'remote|m=s'
,
'repository|r=s'
,
'regexp|R'
,
'sleep|s=i'
,
'test|T!'
,
'username|U=s'
,
'verbose|v+'
,
);
my
(
$options
,
$cmd
,
$opt
) = get_options(
{
name
=>
'bb-cli'
,
conf_prefix
=>
'.'
,
helper
=> 1,
default
=> {
remote
=>
'origin'
,
colors
=> {
aborted
=>
'grey18 on_grey0'
,
disabled
=>
'grey22'
,
notbuilt
=>
'grey12'
,
},
},
sub_command
=> {
help
=> [],
branch
=> [
@common
,
'long|l'
,
'recipient|R=s'
,
],
projects
=> [
@common
,
],
repositories
=> [
@common
,
'project|p=s'
,
],
repository
=> [
@common
,
'project|p=s'
,
'repository|r=s'
,
],
pull_requests
=> [
@common
,
'repository|r=s'
,
'project|p=s'
,
],
},
auto_complete
=>
sub
{
my
(
$option
,
$auto
,
$errors
) =
@_
;
my
$sub_command
=
$option
->cmd;
if
(
$sub_command
eq
'--'
) {
warn
'--'
;
}
},
},
\
@common
,
);
$opt
->_show_help
if
$cmd
eq
'help'
;
$options
= set_defaults(
$options
);
# do stuff here
my
$bbs
= App::BitBucketCli->new(
host
=>
$options
->{host},
user
=>
$options
->{username},
pass
=>
$options
->{password},
opt
=>
$options
,
);
return
$bbs
->
$cmd
(
@ARGV
) || 0;
}
sub
set_defaults {
my
(
$opt
) =
@_
;
my
$config
=
eval
{ LoadFile(
$ENV
{HOME} .
'/.bb-cli.yml'
) } || {};
my
$top
= `git rev-parse --show-toplevel 2> /dev/null`;
chomp
$top
;
if
(
$top
) {
# find other information about repository
my
@remotes
= `git remote -v`;
# Eg
# origin ssh://git@stash.example.com:45222/lux/lux.git (fetch)
# origin ssh://git@stash.example.com:45222/lux/lux.git (push)
#
for
my
$remote
(
@remotes
) {
my
(
$name
,
$url
,
$type
) =
$remote
=~ /^(\S+)\s+(.*?)\s+[(](\w+)[)]$/;
next
if
$name
ne
$opt
->remote;
if
(
$url
=~ /^http/ ) {
my
(
$protocol
,
$user
,
$host
,
$project
,
$repo
) =
$url
=~ m{^(https?)://(?:([^@]+)[@])?([^:/]+)(?:[:]\d+)?/scm/(\w+)/(\w+)};
if
(
$config
->{
$host
} ) {
for
my
$key
(
keys
%{
$config
->{
$host
} }) {
$opt
->{
$key
} ||=
$config
->{
$host
}{
$key
};
}
}
$opt
->{host} ||=
$host
;
$opt
->{username} ||=
$user
;
$opt
->{project} ||=
$project
;
$opt
->{repository} ||=
$repo
;
}
elsif
(
$url
=~ /^ssh/ ) {
my
(
$protocol
,
$host
,
$port
,
$project
,
$repo
) =
$url
=~ m{^(ssh)://(?:[^@]+@)?([^:/]+)(?:[:](\d+))?/([^/]+)/(.*?)[.]git$};
#warn "$url\n$protocol $host $port $project $repo\n";
if
(
$config
->{
$host
} ) {
for
my
$key
(
keys
%{
$config
->{
$host
} }) {
$opt
->{
$key
} ||=
$config
->{
$host
}{
$key
};
}
}
$opt
->{host} ||=
$host
;
$opt
->{project} ||=
$project
;
$opt
->{repository} ||=
$repo
;
}
}
}
$opt
->{host} ||=
$config
->{host};
$opt
->{username} ||=
$config
->{user};
$opt
->{password} ||=
$config
->{pass};
return
$opt
;
}
__DATA__
=head1 NAME
bb-cli - Command line tool for communicating with BitBucket Server
=head1 VERSION
0his documentation refers to bb-cli version 0.004
=head1 SYNOPSIS
bb-cli [option]
bb-cli projects [options]
bb-cli repositories [options]
bb-cli repository [options]
bb-cli branch [options]
bb-cli pull_requests [options]
OPTIONS:
-c --colors[=]str Change colours used specified as key=value
eg --colors disabled=grey22
current colour names aborted, disabled and notbuilt
-f --force Force action
-l --long Show long form data if possible
-p --project[=]str
For commands that need a project name this is the name to use
-R --recipient[=]str
??
-R --regexp[=]str ??
-m --remote[=]str ??
-r --repository[=]str
For commands that work on repositories this contains the repository
-s --sleep[=]seconds
??
-t --test ??
CONFIGURATION:
-h --host[=]str Specify the Stash/Bitbucket Servier host name
-P --password[=]str
The password to connect to the server as
-u --username[=]str
The username to connect to the server as
-v --verbose Show more detailed option
--version Prints the version information
--help Prints this help information
--man Prints the full documentation for bb-cli
=head1 DESCRIPTION
=head1 SUBROUTINES/METHODS
=head1 DIAGNOSTICS
=head1 CONFIGURATION AND ENVIRONMENT
=head1 DEPENDENCIES
=head1 INCOMPATIBILITIES
=head1 BUGS AND LIMITATIONS
There are no known bugs in this module.
Please report problems to Ivan Wills (ivan.wills@gmail.com).
Patches are welcome.
=head1 AUTHOR
Ivan Wills - (ivan.wills@gmail.com)
=head1 LICENSE AND COPYRIGHT
Copyright (c) 2017 Ivan Wills (14 Mullion Close, Hornsby Heights, NSW Australia 2077).
All rights reserved.
This module is free software; you can redistribute it and/or modify it under
the same terms as Perl itself. See L<perlartistic>. This program is
distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
PARTICULAR PURPOSE.
=cut