90 lines
2.8 KiB
Perl
90 lines
2.8 KiB
Perl
# Common sub shared between http and ftp
|
|
package Devscripts::Uscan::_xtp;
|
|
|
|
use strict;
|
|
use File::Basename;
|
|
use Exporter 'import';
|
|
use Devscripts::Uscan::Output;
|
|
use Devscripts::Uscan::Utils;
|
|
|
|
our @EXPORT = ('partial_version');
|
|
|
|
sub _xtp_newfile_base {
|
|
my ($self) = @_;
|
|
my $newfile_base;
|
|
if (@{ $self->filenamemangle }) {
|
|
|
|
# HTTP or FTP site (with filenamemangle)
|
|
if ($self->versionless) {
|
|
$newfile_base = $self->upstream_url;
|
|
} else {
|
|
$newfile_base = $self->search_result->{newfile};
|
|
}
|
|
my $cmp = $newfile_base;
|
|
uscan_verbose "Matching target for filenamemangle: $newfile_base";
|
|
if (
|
|
mangle(
|
|
$self->watchfile, \$self->line,
|
|
'filenamemangle:', \@{ $self->filenamemangle },
|
|
\$newfile_base
|
|
)
|
|
) {
|
|
$self->status(1);
|
|
return undef;
|
|
}
|
|
if ($newfile_base =~ m/^(?:https?|ftp):/) {
|
|
$newfile_base = basename($newfile_base);
|
|
}
|
|
if ($cmp eq $newfile_base) {
|
|
uscan_die "filenamemangle failed for $cmp";
|
|
}
|
|
unless ($self->search_result->{newversion}) {
|
|
|
|
# uversionmanglesd version is '', make best effort to set it
|
|
$newfile_base
|
|
=~ m/^.+?[-_]?(\d[\-+\.:\~\da-zA-Z]*)(?:\.tar\.(gz|bz2|xz|zstd?)|\.zip)$/i;
|
|
$self->search_result->{newversion} = $1;
|
|
unless ($self->search_result->{newversion}) {
|
|
uscan_warn
|
|
"Fix filenamemangle to produce a filename with the correct version";
|
|
$self->status(1);
|
|
return undef;
|
|
}
|
|
uscan_verbose
|
|
"Newest upstream tarball version from the filenamemangled filename: $self->{search_result}->{newversion}";
|
|
}
|
|
} else {
|
|
# HTTP or FTP site (without filenamemangle)
|
|
$newfile_base = basename($self->search_result->{newfile});
|
|
if ($self->mode eq 'http') {
|
|
|
|
# Remove HTTP header trash
|
|
$newfile_base =~ s/[\?#].*$//; # PiPy
|
|
# just in case this leaves us with nothing
|
|
if ($newfile_base eq '') {
|
|
uscan_warn
|
|
"No good upstream filename found after removing tailing ?... and #....\n Use filenamemangle to fix this.";
|
|
$self->status(1);
|
|
return undef;
|
|
}
|
|
}
|
|
}
|
|
return $newfile_base;
|
|
}
|
|
|
|
sub partial_version {
|
|
my ($download_version) = @_;
|
|
my ($d1, $d2, $d3);
|
|
if (defined $download_version) {
|
|
uscan_verbose "download version requested: $download_version";
|
|
if ($download_version
|
|
=~ m/^([-~\+\w]+)(\.[-~\+\w]+)?(\.[-~\+\w]+)?(\.[-~\+\w]+)?$/) {
|
|
$d1 = "$1" if defined $1;
|
|
$d2 = "$1$2" if defined $2;
|
|
$d3 = "$1$2$3" if defined $3;
|
|
}
|
|
}
|
|
return ($d1, $d2, $d3);
|
|
}
|
|
|
|
1;
|