summaryrefslogtreecommitdiffstats
path: root/lib/Devscripts/Uscan/_xtp.pm
blob: 4e6d74b2f236ee87c592fe17d6a062745637c52b (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
# 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};
        }
        uscan_verbose "Matching target for filenamemangle: $newfile_base";
        if (
            mangle(
                $self->watchfile,  \$self->line,
                'filenamemangle:', \@{ $self->filenamemangle },
                \$newfile_base
            )
        ) {
            $self->status(1);
            return undef;
        }
        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)|\.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;