Adding upstream version 2.21.3+deb11u1.upstream/2.21.3+deb11u1upstream

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

9 files changed, 521 insertions, 0 deletions

diff --git a/test/t/common.t b/test/t/common.t
new file mode 100755
index 0000000..82e9b53
--- /dev/null
+++ b/test/t/common.t
@@ -0,0 +1,106 @@
+#!/usr/bin/perl
+
+package Config::Test;
+
+use Moo;
+
+extends 'Devscripts::Config';
+
+use constant keys => [
+    ['test!',  'TEST', 'bool', 1],
+    ['str=s',  'STR',  qr/^a/, 'ab'],
+    ['str2=s', 'STR2', qr/^a/, 'bb'],
+    ['array=s', 'ARRAY', undef, sub { [] }],
+];
+
+package main;
+
+use Test::More tests => 39;
+
+BEGIN {
+    use_ok('Devscripts::Config');
+}
+
+my $conf;
+$Devscripts::Output::die_on_error = 0;
+
+@Devscripts::Config::config_files = ();
+
+ok($conf = Config::Test->new->parse, 'No conf files, no args');
+ok($conf->{test} == 1,    ' test=1');
+ok($conf->{str} eq 'ab',  ' str=ab');
+ok($conf->{str2} eq 'bb', ' str2=bb');
+
+@Devscripts::Config::config_files = ('t/config1');
+
+ok($conf = Config::Test->new->parse, 'Conf files, no args');
+ok($conf->{test} == 0,    ' test=0');
+ok($conf->{str} eq 'az',  ' str=az');
+ok($conf->{str2} eq 'a1', ' str2=a1');
+if (ok(ref $conf->{array}, ' array')) {
+    ok($conf->{array}->[0] eq "b c",    '  "b c" found');
+    ok($conf->{array}->[1] eq "a",      '  "a" found');
+    ok($conf->{array}->[2] eq "d",      '  "d" found');
+    ok(scalar @{ $conf->{array} } == 3, '  3 elements');
+}
+
+@ARGV = ('--noconf');
+
+ok($conf = Config::Test->new->parse, '--noconf');
+ok($conf->{test} == 1,    ' test=1');
+ok($conf->{str} eq 'ab',  ' str=ab');
+ok($conf->{str2} eq 'bb', ' str2=bb');
+
+@ARGV = ('--conffile', 't/config2');
+
+ok($conf = Config::Test->new->parse, '--conffile t/config2');
+ok($conf->{test} == 1,      ' test=1');
+ok($conf->{str} eq 'ab',    ' str=ab');
+ok($conf->{str2} eq 'axzx', ' str2=axzx');
+
+@ARGV = ('--conffile', '+t/config2');
+
+ok($conf = Config::Test->new->parse, '--conffile +t/config2');
+ok($conf->{test} == 0,      ' test=0');
+ok($conf->{str} eq 'az',    ' str=az');
+ok($conf->{str2} eq 'axzx', ' str2=axzx');
+
+@ARGV = ('--test', '--str2=ac');
+
+ok($conf = Config::Test->new->parse, '--test --str2=ac');
+ok($conf->{test} == 1,    ' test=1');
+ok($conf->{str} eq 'az',  ' str=az');
+ok($conf->{str2} eq 'ac', ' str2=ac');
+
+@ARGV = ('--noconf', '--str2', 'ac', '--notest');
+
+ok($conf = Config::Test->new->parse, '--noconf --no-test --str2=ac');
+ok($conf->{test} == 0,    ' test=0');
+ok($conf->{str} eq 'ab',  ' str=ab');
+ok($conf->{str2} eq 'ac', ' str2=ac');
+
+@ARGV = ('--noconf', '--array', 'a', '--array=b');
+ok($conf = Config::Test->new->parse, '--noconf --array a --array=b');
+ok(ref $conf->{array},         'Multiple options are allowed');
+ok($conf->{array}->[0] eq 'a', ' first value is a');
+ok($conf->{array}->[1] eq 'b', ' second value is b');
+
+# Redirect STDERR to $out;
+my $out;
+{
+    no warnings;
+    open F, ">&STDERR";
+}
+close STDERR;
+open STDERR, '>', \$out;
+eval {
+    @ARGV = ('--noconf', '--str2', 'bc');
+    $conf = Config::Test->new->parse;
+};
+
+# Restore STDERR
+close STDERR;
+open STDERR, ">&F";
+fail($@) if ($@);
+ok($out =~ /Bad str2 value/, '--str2=bc is rejected');
+
diff --git a/test/t/config1 b/test/t/config1
new file mode 100644
index 0000000..829becc
--- /dev/null
+++ b/test/t/config1
@@ -0,0 +1,12 @@
+TEST=no
+STR=az
+STR2=a1
+ARRAY='a "b c" d'
+USCAN_SYMLINK=rename
+USCAN_VERBOSE=yes
+SALSA_TOKEN=xx
+SALSA_KGB=yes
+SALSA_ENABLE_ISSUES=no
+SALSA_EMAIL=ignore
+SALSA_ENABLE_MR=yes
+SALSA_IRKER=no
diff --git a/test/t/config2 b/test/t/config2
new file mode 100644
index 0000000..32d1629
--- /dev/null
+++ b/test/t/config2
@@ -0,0 +1 @@
+STR2=axzx
diff --git a/test/t/json-cache.t b/test/t/json-cache.t
new file mode 100644
index 0000000..a9d8918
--- /dev/null
+++ b/test/t/json-cache.t
@@ -0,0 +1,25 @@
+use Test::More;
+
+use strict;
+
+SKIP: {
+    eval "use JSON";
+    skip "JSON isn't available" if ($@);
+    use_ok('Devscripts::JSONCache');
+
+    my %c;
+
+    ok(tie(%c, 'Devscripts::JSONCache', 'test.json'), 'No file');
+    $c{a} = 1;
+    untie %c;
+    ok(-r 'test.json', 'Cache created');
+    ok(tie(%c, 'Devscripts::JSONCache', 'test.json'), 'Reuse file');
+    ok($c{a} == 1, 'Value saved');
+    untie %c;
+    unlink 'test.json';
+
+    my %c2;
+    eval { tie(%c2, 'Devscripts::JSONCache', 'zzz/test.json') };
+    ok($@, "Build refused if write isn't possible");
+}
+done_testing();
diff --git a/test/t/salsa-config.t b/test/t/salsa-config.t
new file mode 100644
index 0000000..66643bf
--- /dev/null
+++ b/test/t/salsa-config.t
@@ -0,0 +1,19 @@
+use Test::More tests => 8;
+
+BEGIN {
+    use_ok('Devscripts::Salsa::Config');
+}
+
+@Devscripts::Config::config_files = ('t/config1');
+@ARGV = ('push_repo', '--disable-kgb', '--tagpending', '--irker');
+
+ok($conf = Devscripts::Salsa::Config->new->parse, 'Parse');
+
+ok(($conf->kgb == 0 and $conf->disable_kgb), 'KGB disabled');
+ok(($conf->tagpending and $conf->disable_tagpending == 0),
+    'Tagpending enabled');
+ok(($conf->enable_issues == 0 and $conf->disable_issues),
+    'Enable-issues disabled');
+ok(($conf->email == 0     and $conf->disable_email == 0), 'Email ignored');
+ok(($conf->enable_mr == 1 and $conf->disable_mr == 0),    'MR enabled');
+ok(($conf->irker == 1     and $conf->disable_irker == 0), 'Irker enabled');
diff --git a/test/t/salsa.conf b/test/t/salsa.conf
new file mode 100644
index 0000000..d14fa84
--- /dev/null
+++ b/test/t/salsa.conf
@@ -0,0 +1,4 @@
+SALSA_TOKEN=abc
+SALSA_API_URL=http://no-exist.xxx/api/v4
+SALSA_KGB_SERVER_URL=http://no-exist.xxx:9418/webhook/?channel=
+SALSA_TAGPENDING_SERVER_URL=http://no-exist.xxx:9418/tagpending/
diff --git a/test/t/salsa.pm b/test/t/salsa.pm
new file mode 100644
index 0000000..800d1e5
--- /dev/null
+++ b/test/t/salsa.pm
@@ -0,0 +1,226 @@
+{
+
+    package MockRESTClient;
+    use URI;
+    use Moo;
+    extends 'GitLab::API::v4::RESTClient';
+
+    has _mocks => (
+        is       => 'ro',
+        default  => sub { [] },
+        init_arg => undef,
+    );
+
+    sub mock_endpoints {
+        my $self = shift;
+
+        while (@_) {
+            my $method  = shift;
+            my $path_re = shift;
+            my $sub     = shift;
+
+            push @{ $self->_mocks() }, [$method, $path_re, $sub];
+        }
+
+        return;
+    }
+
+    sub _http_tiny_request {
+        my ($self, $req_method, $req) = @_;
+
+        die "req_method may only be 'request' at this time"
+          if $req_method ne 'request';
+
+        my ($method, $url, $options) = @$req;
+
+        my $path = URI->new($url)->path();
+        $path =~ s{^.*api/v4/}{};
+
+        foreach my $mock (@{ $self->_mocks() }) {
+            my ($handler_method, $path_re, $sub) = @$mock;
+
+            next if $method ne $handler_method;
+
+            my @captures = ($path =~ $path_re);
+            next if !@captures;    # No captures still returns a 1.
+
+            my ($status, $content)
+              = $sub->([$method, $url, $options], @captures);
+            $content = JSON::to_json($content) if ref $content;
+
+            return {
+                status  => $status,
+                success => ($status =~ m{^2\d\d$}) ? 1 : 0,
+                defined($content) ? (content => $content) : (),
+            };
+        }
+
+        die "No mock endpoint matched the $method '$path' endpoint";
+    }
+}
+
+sub api {
+    my ($gitdir) = @_;
+    my @users = ({
+        id       => 11,
+        username => 'me',
+        name     => 'Me',
+        email    => 'me@debian.org',
+        state    => 'active'
+    });
+    my @teams = ({
+        id        => 2099,
+        name      => 'Debian JavaScript Maintainers',
+        full_name => 'Debian JavaScript Maintainers',
+        full_path => 'js-team',
+    });
+    my @projects;
+    my $next_id = 1;
+
+    my $api = GitLab::API::v4->new(
+        url               => 'https://example.com/api/v4',
+        rest_client_class => 'MockRESTClient',
+    );
+
+    $api->rest_client->mock_endpoints(
+        GET  => qr{^user$}  => sub { 200, $users[0] },
+        GET  => qr{^users$} => sub { 200, \@users },
+        POST => qr{^users$} => sub {
+            my ($req) = @_;
+            my $user = decode_json($req->[2]->{content});
+            $user->{id} = $next_id;
+            $next_id++;
+            push @users, $user;
+            return 204;
+        },
+        GET => qr{^users?/(\d+)$} => sub {
+            my ($req, $id) = @_;
+            foreach my $user (@users) {
+                next if $user->{id} != $id;
+                return 200, $user;
+            }
+            return 404;
+        },
+        GET => qr{^users/(\D+)$} => sub {
+            my ($req, $id) = @_;
+            foreach my $user (@users) {
+                next if $user->{username} != $id;
+                return 200, $user;
+            }
+            return 404;
+        },
+        GET => qr{^groups$} => sub {
+            200, \@teams;
+        },
+        GET => qr{^groups/([^/]+)$} => sub {
+            my ($req, $name) = @_;
+            foreach my $team (@teams) {
+                next if $team->{full_path} ne $name;
+                return 200, $team;
+            }
+            return 404;
+        },
+        PUT => qr{^users/(\d+)$} => sub {
+            my ($req, $id) = @_;
+            my $data = decode_json($req->[2]->{content});
+            foreach my $user (@users) {
+                next if $user->{id} != $id;
+                %$user = (%$user, %$data,);
+                return 204;
+            }
+            return 404;
+        },
+        DELETE => qr{^users/(\d+)$} => sub {
+            my ($req, $id) = @_;
+            my @new;
+            foreach my $user (@users) {
+                next if $user->{id} == $id;
+                push @new, $user;
+            }
+            return 404 if @new == @users;
+            @users = @new;
+            return 204;
+        },
+        # Projects
+        POST => qr{^projects$} => sub {
+            my $content = JSON::from_json($_[0]->[2]->{content});
+            mkdir "$gitdir/me/$content->{path}";
+            $ENV{"GIT_CONFIG_NOGLOBAL"} = 1;
+            print
+`cd $gitdir/me/$content->{path};git init;git config receive.denyCurrentBranch ignore;cd -`;
+            $content->{id}        = scalar @projects + 1;
+            $content->{hooks}     = [];
+            $content->{namespace} = {
+                kind => 'user',
+                id   => 11,
+                name => 'me',
+            };
+            $content->{path_with_namespace} = 'me/' . $content->{path};
+            $content->{web_url} = 'http://no.org/me/' . $content->{path};
+            push @projects, $content;
+            return 200, $content;
+        },
+        GET => qr{^projects/(\d+)/hooks} => sub {
+            my ($req, $id) = @_;
+            my $res = eval { $projects[$id - 1]->{hooks} };
+            return ($res ? (200, $res) : (404));
+        },
+        GET => qr{^projects/(\d+)/services/(\w+)} => sub {
+            my ($req, $id, $service) = @_;
+            return 404;
+        },
+        GET => qr{^projects$} => sub {
+            my ($req) = @_;
+            return (200, \@projects) unless ($req->[1] =~ /search=([^&]+)/);
+            my $str = $1;
+            my @res;
+            foreach (@projects) {
+                if ($_->{name} =~ /\Q$str\E/) {
+                    push @res, $_;
+                }
+            }
+            return 200, \@res;
+        },
+        GET => qr{^projects/([a-z]+)(?:%2F(\w+))*$} => sub {
+            my ($req, @path) = @_;
+            my $repo = pop @path;
+            my $path = join '/', @path;
+            foreach (@projects) {
+                if ($_->{namespace}->{name} eq $path and $_->{path} eq $repo) {
+                    return 200, $_;
+                }
+            }
+            return 404;
+        },
+        GET => qr{^projects/(\d+)$} => sub {
+            my ($req, $id) = @_;
+            return 404 unless ($_ = $projects[$id - 1]);
+            return 200, $_;
+        },
+        PUT => qr{^projects/(\d+)} => sub {
+            my ($req, $id) = @_;
+            return 404 unless ($_ = $projects[$id - 1]);
+            my $content = JSON::from_json($req->[2]->{content});
+            foreach my $k (keys %$content) {
+                $_->{$k} = $content->{$k};
+            }
+            return 200, {};
+        },
+        POST => qr{^projects/(\d+)/hooks} => sub {
+            my ($req, $id) = @_;
+            return 404 unless ($_ = $projects[$id - 1]);
+            my $content = JSON::from_json($req->[2]->{content});
+            push @{ $_->{hooks} }, $content;
+            return 200, {};
+        },
+        POST => qr{^projects/(\d+)/repository/branches} => sub {
+            return 200, {};
+        },
+        DELETE => qr{^projects/(\d+)/repository/branches/([\w\-\.]+)$} => sub {
+            return 200, {};
+        },
+    );
+    return $api;
+}
+
+1;
diff --git a/test/t/salsa.t b/test/t/salsa.t
new file mode 100644
index 0000000..d80978a
--- /dev/null
+++ b/test/t/salsa.t
@@ -0,0 +1,108 @@
+#!/usr/bin/env perl
+
+my $skip;
+use File::Temp 'tempdir';
+use Test::More;
+use strict;
+
+BEGIN {
+    eval "use Test::Output;use GitLab::API::v4;";
+    $skip = $@ ? 1 : 0;
+}
+
+my $pwd = `pwd`;
+chomp $pwd;
+my ($api, $gitdir);
+
+sub mkDebianDir {
+    my $tmpdir = tempdir(CLEANUP => 1);
+    chdir $tmpdir;
+    $ENV{"GIT_CONFIG_NOGLOBAL"} = 1;
+    $ENV{"HOME"} = "";
+    system "git init";
+    system "git config user.name 'Joe Developer'";
+    system 'git config user.email "jd@debian.org"';
+    mkdir 'debian';
+    open F, ">debian/changelog";
+    print F <<EOF;
+foobar (0-1) unstable; urgency=low
+
+  * Initial release
+
+ -- Joe Developer <jd\@debian.org>  Mon, 02 Nov 2013 22:21:31 -0100
+EOF
+    close F;
+    open F, ">README.md";
+    print F <<EOF;
+# Salsa test
+EOF
+    system "git add *";
+    system "git commit -a -m 'Salsa test'";
+    system "git checkout -q -b dev";
+    chdir $pwd;
+    return $tmpdir;
+}
+
+sub run {
+    my ($result, $out, @list) = @_;
+    @ARGV = ('--no-cache', @list);
+    my ($res, $salsa);
+    combined_like(
+        sub {
+            $salsa = Devscripts::Salsa->new({ api => $api });
+            $salsa->config->git_server_url($gitdir . '/');
+            $res = $salsa->run;
+        },
+        $out,
+        "command: " . join(' ', @list));
+    ok($res =~ /^$result$/i, " result is $result");
+}
+
+sub run_debug {
+    my ($result, $out, @list) = @_;
+    @ARGV = ('--no-cache', @list);
+    my ($res, $salsa);
+    $salsa = Devscripts::Salsa->new({ api => $api });
+    $salsa->config->git_server_url($gitdir . '/');
+    $res = $salsa->run;
+}
+
+SKIP: {
+    skip "Missing dependencies" if ($skip);
+    require './t/salsa.pm';
+    $gitdir = tempdir(CLEANUP => 1);
+    sleep 1;
+    mkdir "$gitdir/me" or die "$gitdir/me: $!";
+
+    $api = api($gitdir);
+
+    use_ok 'Devscripts::Salsa';
+    $Devscripts::Output::die_on_error = 0;
+    @Devscripts::Config::config_files = ('t/salsa.conf');
+
+    # Search methods
+    run(0, qr/Id\s*:\s*11\nUsername\s*:\s*me/s, 'whoami');
+    run(0, qr/Id\s*:\s*2099\nName/s,            'search_group', 'js-team');
+    run(0, qr/Id\s*:\s*2099\nName/s,            'search_group', 2099);
+    run(0, qr/Id.*\nUsername\s*: me/s,          'search_user', 'me');
+    run(0, qr/Id.*\nUsername\s*: me/s,          'search_user', 'm');
+    run(0, qr/Id.*\nUsername\s*: me/s,          'search_user', 11);
+
+    # Project methods
+    my $repo = mkDebianDir;
+    run(0, qr/Project .*created/s, '-C', $repo, '--verbose', 'push_repo', '.');
+    chdir $pwd;
+    $repo = tempdir(CLEANUP => 1);
+    run(0, qr/KGB hook added.*Tagpending hook added/s,
+        'update_repo', '--kgb', '--irc=debian', '--tagpending', 'foobar');
+    run(0, qr/foobar\s*:\s*OK/s,
+        'update_safe', '--kgb', '--irc=debian', '--tagpending', 'foobar');
+    run(0, qr{Full path\s*:\s*me/foobar}, 'search', 'foobar');
+    run(0, qr{Configuring foobar},
+        'rename_branch', 'foobar', '--source-branch=dev',
+        '--dest-branch=dev2');
+}
+
+done_testing;
+
+1;
diff --git a/test/t/uscan-config.t b/test/t/uscan-config.t
new file mode 100644
index 0000000..5209924
--- /dev/null
+++ b/test/t/uscan-config.t
@@ -0,0 +1,20 @@
+use Test::More tests => 8;
+
+BEGIN {
+    use_ok('Devscripts::Uscan::Config');
+    use_ok('Devscripts::Uscan::Output');
+}
+
+@Devscripts::Config::config_files = ('t/config1');
+@ARGV = ( '--download-version', '1.0', '-dd', '--no-verbose' );
+
+ok(
+    $conf = Devscripts::Uscan::Config->new->parse,
+    'USCAN_SYMLINK=rename + --download-version'
+);
+
+ok($conf->symlink eq 'rename', ' symlink=rename');
+ok($conf->download_version eq '1.0',' download_version=1.0');
+ok($conf->user_agent =~ /^Debian uscan/, qq' user agent starts with "Debian uscan" ($conf->{user_agent})');
+ok($conf->download == 2, 'Force download');
+ok($verbose == 0, 'Verbose is disabled');