our $tagformat;
our $tagformatfn;
+our %forceopts = map { $_=>0 } ();
+
our %format_ok = map { $_=>1 } ("1.0","3.0 (native)","3.0 (quilt)");
our $suite_re = '[-+.0-9a-z]+';
sub badcfg { print STDERR "$us: invalid configuration: @_\n"; exit 12; }
+sub forceable_fail ($$) {
+ my ($forceoptsl, $msg) = @_;
+ fail $msg unless grep { $forceopts{$_} } @$forceoptsl;
+ print STDERR "warning: overriding problem due to --force:\n". $msg;
+}
+
sub no_such_package () {
print STDERR "$us: package $package does not exist in suite $isuite\n";
exit 4;
badcfg "ftpmasterapi archive query method takes no data part"
if length $data;
my @cmd = archive_api_query_cmd($subpath);
+ my $url = $cmd[$#cmd];
+ push @cmd, qw(-w %{http_code});
my $json = cmdoutput @cmd;
+ unless ($json =~ s/\d+\d+\d$//) {
+ failedcmd_report_cmd undef, @cmd;
+ fail "curl failed to print 3-digit HTTP code";
+ }
+ my $code = $&;
+ fail "fetch of $url gave HTTP code $code"
+ unless $url =~ m#^file://# or $code =~ m/^2/;
return decode_json($json);
}
badusage "need only 1 subpath argument" unless @ARGV==1;
my ($subpath) = @ARGV;
my @cmd = archive_api_query_cmd($subpath);
+ push @cmd, qw(-f);
debugcmd ">",@cmd;
exec @cmd or fail "exec curl: $!\n";
}
} elsif (m/^--deliberately-($deliberately_re)$/s) {
push @ropts, $_;
push @deliberatelies, $&;
+ } elsif (m/^--force-(.*)/ && defined $forceopts{$1}) {
+ push @ropts, $&;
+ $forceopts{$1} = 1;
+ $_='';
} elsif (m/^--dgit-tag-format=(old|new)$/s) {
# undocumented, for testing
push @ropts, $_;