1 files changed, 90 insertions, 0 deletions
diff --git a/lib/Devscripts/Uscan/_xtp.pm b/lib/Devscripts/Uscan/_xtp.pm
new file mode 100644
index 0000000..092cb52
--- /dev/null
+++ b/lib/Devscripts/Uscan/_xtp.pm
@@ -0,0 +1,90 @@
+# 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;