diff options
Diffstat (limited to 'lib/Devscripts/Salsa.pm')
-rwxr-xr-x | lib/Devscripts/Salsa.pm | 410 |
1 files changed, 410 insertions, 0 deletions
diff --git a/lib/Devscripts/Salsa.pm b/lib/Devscripts/Salsa.pm new file mode 100755 index 0000000..5c02b16 --- /dev/null +++ b/lib/Devscripts/Salsa.pm @@ -0,0 +1,410 @@ +package Devscripts::Salsa; + +=head1 NAME + +Devscripts::Salsa - salsa(1) base object + +=head1 SYNOPSIS + + use Devscripts::Salsa; + exit Devscripts::Salsa->new->run + +=head1 DESCRIPTION + +Devscripts::Salsa provides salsa(1) command launcher and some common utilities +methods. + +=cut + +use strict; + +use Devscripts::Output; +use Devscripts::Salsa::Config; + +BEGIN { + eval "use GitLab::API::v4;use GitLab::API::v4::Constants qw(:all)"; + if ($@) { + print STDERR "You must install GitLab::API::v4\n"; + exit 1; + } +} +use Moo; +use File::Basename; +use File::Path qw(make_path); + +# Command aliases +use constant cmd_aliases => { + ci => 'last_ci_status', + co => 'checkout', + ls => 'list_repos', + search => 'search_project', + search_repo => 'search_project', + mr => 'merge_request', + mrs => 'merge_requests', + pipe => 'pipeline_schedule', + pipeline => 'pipeline_schedule', # preferred name + schedule => 'pipeline_schedule', + pipes => 'pipeline_schedules', + pipelines => 'pipeline_schedules', # preferred name + schedules => 'pipeline_schedules', +}; + +=head1 ACCESSORS + +=over + +=item B<config> : Devscripts::Salsa::Config object (parsed) + +=cut + +has config => ( + is => 'rw', + default => sub { Devscripts::Salsa::Config->new->parse }, +); + +=item B<cache> : Devscripts::JSONCache object + +=cut + +# File cache to avoid polling Gitlab too much +# (used to store ids, paths and names) +has _cache => ( + is => 'rw', + lazy => 1, + default => sub { + return {} unless ($_[0]->config->cache_file); + my %h; + eval { + my ($cache_file, $cache_dir) = fileparse $_[0]->config->cache_file; + if (!-d $cache_dir) { + make_path $cache_dir; + } + require Devscripts::JSONCache; + tie %h, 'Devscripts::JSONCache', $_[0]->config->cache_file; + ds_debug "Cache opened"; + }; + if ($@) { + ds_verbose "Unable to create cache object: $@"; + return {}; + } + return \%h; + }, +); +has cache => ( + is => 'rw', + lazy => 1, + default => sub { + $_[0]->_cache->{ $_[0]->config->api_url } //= {}; + return $_[0]->_cache->{ $_[0]->config->api_url }; + }, +); + +# In memory cache (used to avoid querying the project id twice when using +# update_safe +has projectCache => ( + is => 'rw', + default => sub { {} }, +); + +=item B<api>: GitLab::API::v4 object + +=cut + +has api => ( + is => 'rw', + lazy => 1, + default => sub { + my $r = GitLab::API::v4->new( + url => $_[0]->config->api_url, + ( + $_[0]->config->private_token + ? (private_token => $_[0]->config->private_token) + : () + ), + ); + $r or ds_die "Unable to create GitLab::API::v4 object"; + return $r; + }, +); + +=item User or group in use + +=over + +=item B<username> + +=item B<user_id> + +=item B<group_id> + +=item B<group_path> + +=back + +=cut + +# Accessors that resolve names, ids or paths +has username => ( + is => 'rw', + lazy => 1, + default => sub { $_[0]->id2username }); + +has user_id => ( + is => 'rw', + lazy => 1, + default => sub { + $_[0]->config->user_id || $_[0]->username2id; + }, +); + +has group_id => ( + is => 'rw', + lazy => 1, + default => sub { $_[0]->config->group_id || $_[0]->group2id }, +); + +has group_path => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + return undef unless ($self->group_id); + return $self->cache->{group_path}->{ $self->{group_id} } + if $self->cache->{group_path}->{ $self->{group_id} }; + return $self->{group_path} if ($self->{group_path}); # Set if --group + eval { + $self->{group_path} + = $self->api->group_without_projects($self->group_id) + ->{full_path}; + $self->cache->{group_path}->{ $self->{group_id} } + = $self->{group_path}; + }; + if ($@) { + ds_verbose $@; + ds_warn "Unexistent group " . $self->group_id; + return undef; + } + return $self->{group_path}; + }, +); + +=back + +=head1 METHODS + +=over + +=item B<run>: main method, load and run command and return Unix result code. + +=cut + +sub run { + my ($self, $args) = @_; + binmode STDOUT, ':utf8'; + + # Check group or user id + my $command = $self->config->command; + if (my $tmp = cmd_aliases->{$command}) { + $command = $tmp; + } + eval { with "Devscripts::Salsa::$command" }; + if ($@) { + ds_verbose $@; + ds_die "Unknown command $command"; + return 1; + } + return $self->$command(@ARGV); +} + +=back + +=head2 Utilities + +=over + +=item B<levels_name>, B<levels_code>: convert strings to GitLab level codes +(owner, maintainer, developer, reporter and guest) + +=cut + +sub levels_name { + my $res = { + + # needs GitLab::API::v4::Constants 0.11 + # no_access => $GITLAB_ACCESS_LEVEL_NO_ACCESS, + guest => $GITLAB_ACCESS_LEVEL_GUEST, + reporter => $GITLAB_ACCESS_LEVEL_REPORTER, + developer => $GITLAB_ACCESS_LEVEL_DEVELOPER, + maintainer => $GITLAB_ACCESS_LEVEL_MASTER, + owner => $GITLAB_ACCESS_LEVEL_OWNER, + }->{ $_[1] }; + ds_die "Unknown access level '$_[1]'" unless ($res); + return $res; +} + +sub levels_code { + return { + $GITLAB_ACCESS_LEVEL_GUEST => 'guest', + $GITLAB_ACCESS_LEVEL_REPORTER => 'reporter', + $GITLAB_ACCESS_LEVEL_DEVELOPER => 'developer', + $GITLAB_ACCESS_LEVEL_MASTER => 'maintainer', + $GITLAB_ACCESS_LEVEL_OWNER => 'owner', + }->{ $_[1] }; +} + +=item B<username2id>, B<id2username>: convert username to an id an reverse + +=cut + +sub username2id { + my ($self, $user) = @_; + $user ||= $self->config->user || $self->api->current_user->{id}; + unless ($user) { + return ds_warn "Token seems invalid"; + return 1; + } + unless ($user =~ /^\d+$/) { + return $self->cache->{user_id}->{$user} + if $self->cache->{user_id}->{$user}; + my $users = $self->api->users({ username => $user }); + return ds_die "Username '$user' not found" + unless ($users and @$users); + ds_verbose "$user id is $users->[0]->{id}"; + $self->cache->{user_id}->{$user} = $users->[0]->{id}; + return $users->[0]->{id}; + } + return $user; +} + +sub id2username { + my ($self, $id) = @_; + $id ||= $self->config->user_id || $self->api->current_user->{id}; + return $self->cache->{user}->{$id} if $self->cache->{user}->{$id}; + my $res = eval { $self->api->user($id)->{username} }; + if ($@) { + ds_verbose $@; + return ds_die "$id not found"; + } + ds_verbose "$id is $res"; + $self->cache->{user}->{$id} = $res; + return $res; +} + +=item B<group2id>: convert group name to id + +=cut + +sub group2id { + my ($self, $name) = @_; + $name ||= $self->config->group; + return unless $name; + if ($self->cache->{group_id}->{$name}) { + $self->group_path($self->cache->{group_id}->{$name}->{path}); + return $self->group_id($self->cache->{group_id}->{$name}->{id}); + } + my $groups = $self->api->group_without_projects($name); + if ($groups) { + $groups = [$groups]; + } else { + $self->api->groups({ search => $name }); + } + return ds_die "No group found" unless ($groups and @$groups); + if (scalar @$groups > 1) { + ds_warn "More than one group found:"; + foreach (@$groups) { + print <<END; +Id : $_->{id} +Name : $_->{name} +Full name: $_->{full_name} +Full path: $_->{full_path} + +END + } + return ds_die "Set the chosen group id using --group-id."; + } + ds_verbose "$name id is $groups->[0]->{id}"; + $self->cache->{group_id}->{$name}->{path} + = $self->group_path($groups->[0]->{full_path}); + $self->cache->{group_id}->{$name}->{id} = $groups->[0]->{id}; + return $self->group_id($groups->[0]->{id}); +} + +=item B<project2id>: get id of a project. + +=cut + +sub project2id { + my ($self, $project) = @_; + return $project if ($project =~ /^\d+$/); + my $res; + $project = $self->project2path($project); + if ($self->projectCache->{$project}) { + ds_debug "use cached id for $project"; + return $self->projectCache->{$project}; + } + unless ($project =~ /^\d+$/) { + eval { $res = $self->api->project($project)->{id}; }; + if ($@) { + ds_debug $@; + ds_warn "Project $project not found:"; + return undef; + } + } + ds_verbose "$project id is $res"; + $self->projectCache->{$project} = $res; + return $res; +} + +=item B<project2path>: get full path of a project + +=cut + +sub project2path { + my ($self, $project) = @_; + return $project if ($project =~ m#/#); + my $path = $self->main_path; + return undef unless ($path); + ds_verbose "Project $project => $path/$project"; + return "$path/$project"; +} + +=item B<main_path>: build path using given group or user + +=cut + +sub main_path { + my ($self) = @_; + my $path; + if ($self->config->path) { + $path = $self->config->path; + } elsif (my $tmp = $self->group_path) { + $path = $tmp; + } elsif ($self->user_id) { + $path = $self->username; + } else { + ds_warn "Unable to determine project path"; + return undef; + } + return $path; +} + +# GitLab::API::v4 does not permit to call /groups/:id with parameters. +# It takes too much time for the "debian" group, since it returns the list of +# all projects together with all the details of the projects +sub GitLab::API::v4::group_without_projects { + my $self = shift; + return $self->_call_rest_client('GET', 'groups/:group_id', [@_], + { query => { with_custom_attributes => 0, with_projects => 0 } }); +} + +1; + +=back + +=head1 AUTHOR + +Xavier Guimard E<lt>yadd@debian.orgE<gt> + +=head1 COPYRIGHT AND LICENSE + +Copyright 2018, Xavier Guimard E<lt>yadd@debian.orgE<gt> |