Adding upstream version 2.19.5+deb10u1.upstream/2.19.5+deb10u1upstream

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

1 files changed, 408 insertions, 0 deletions

diff --git a/lib/Devscripts/Uscan/WatchFile.pm b/lib/Devscripts/Uscan/WatchFile.pm
new file mode 100644
index 0000000..a8b5508
--- /dev/null
+++ b/lib/Devscripts/Uscan/WatchFile.pm
@@ -0,0 +1,408 @@
+
+=head1 NAME
+
+Devscripts::Uscan::WatchFile - watchfile object for L<uscan>
+
+=head1 SYNOPSIS
+
+  use Devscripts::Uscan::Config;
+  use Devscripts::Uscan::WatchFile;
+  
+  my $config = Devscripts::Uscan::Config->new({
+    # Uscan config parameters. Example:
+    destdir => '..',
+  });
+
+  # You can use Devscripts::Uscan::FindFiles to find watchfiles
+  
+  my $wf = Devscripts::Uscan::WatchFile->new({
+      config      => $config,
+      package     => $package,
+      pkg_dir     => $pkg_dir,
+      pkg_version => $version,
+      watchfile   => $watchfile,
+  });
+  return $wf->status if ( $wf->status );
+  
+  # Do the job
+  return $wf->process_lines;
+
+=head1 DESCRIPTION
+
+Uscan class to parse watchfiles.
+
+=head1 METHODS
+
+=head2 new() I<(Constructor)>
+
+Parse watch file and creates L<Devscripts::Uscan::WatchLine> objects for
+each line.
+
+=head3 Required parameters
+
+=over
+
+=item config: L<Devscripts::Uscan::Config> object
+
+=item package: Debian package name
+
+=item pkg_dir: Working directory
+
+=item pkg_version: Current Debian package version
+
+=back
+
+=head2 Main accessors
+
+=over
+
+=item watchlines: ref to the array that contains watchlines objects
+
+=item watch_version: format version of the watchfile
+
+=back
+
+=head2 process_lines()
+
+Method that launches Devscripts::Uscan::WatchLine::process() on each watchline.
+
+=head1 SEE ALSO
+
+L<uscan>, L<Devscripts::Uscan::WatchLine>, L<Devscripts::Uscan::Config>,
+L<Devscripts::Uscan::FindFiles>
+
+=head1 AUTHOR
+
+B<uscan> was originally written by Christoph Lameter
+E<lt>clameter@debian.orgE<gt> (I believe), modified by Julian Gilbey
+E<lt>jdg@debian.orgE<gt>. HTTP support was added by Piotr Roszatycki
+E<lt>dexter@debian.orgE<gt>. B<uscan> was rewritten in Perl by Julian Gilbey.
+Xavier Guimard E<lt>yadd@debian.orgE<gt> rewrote uscan in object
+oriented Perl.
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2002-2006 by Julian Gilbey <jdg@debian.org>,
+2018 by Xavier Guimard <yadd@debian.org>
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+=cut
+
+package Devscripts::Uscan::WatchFile;
+
+use strict;
+use Devscripts::Uscan::Downloader;
+use Devscripts::Uscan::Output;
+use Devscripts::Uscan::WatchLine;
+use File::Copy qw/copy move/;
+use List::Util qw/first/;
+use Moo;
+
+use constant {
+    ANY_VERSION => '(?:[-_]?(\d[\-+\.:\~\da-zA-Z]*))',
+    ARCHIVE_EXT => '(?i)(?:\.(?:tar\.xz|tar\.bz2|tar\.gz|zip|tgz|tbz|txz))',
+    DEB_EXT     => '(?:[\+~](debian|dfsg|ds|deb)(\.)?(\d+)?$)',
+};
+use constant SIGNATURE_EXT => ARCHIVE_EXT . '(?:\.(?:asc|pgp|gpg|sig|sign))';
+
+# Required new() parameters
+has config      => (is => 'rw', required => 1);
+has package     => (is => 'ro', required => 1);    # Debian package
+has pkg_dir     => (is => 'ro', required => 1);
+has pkg_version => (is => 'ro', required => 1);
+has bare        => (
+    is      => 'rw',
+    lazy    => 1,
+    default => sub { $_[0]->config->bare });
+has download => (
+    is      => 'rw',
+    lazy    => 1,
+    default => sub { $_[0]->config->download });
+has downloader => (
+    is      => 'ro',
+    lazy    => 1,
+    default => sub {
+        Devscripts::Uscan::Downloader->new({
+            timeout => $_[0]->config->timeout,
+            agent   => $_[0]->config->user_agent,
+            pasv    => $_[0]->config->pasv,
+            destdir => $_[0]->config->destdir,
+        });
+    },
+);
+has signature => (
+    is       => 'rw',
+    required => 1,
+    lazy     => 1,
+    default  => sub { $_[0]->config->signature });
+has watchfile => (is => 'ro', required => 1);    # usually debian/watch
+
+# Internal attributes
+has group         => (is => 'rw', default => sub { [] });
+has origcount     => (is => 'rw');
+has origtars      => (is => 'rw', default => sub { [] });
+has status        => (is => 'rw', default => sub { 0 });
+has watch_version => (is => 'rw');
+has watchlines    => (is => 'rw', default => sub { [] });
+
+# Values shared between lines
+has shared => (
+    is      => 'rw',
+    lazy    => 1,
+    default => \&new_shared,
+);
+
+sub new_shared {
+    return {
+        bare                        => $_[0]->bare,
+        components                  => [],
+        common_newversion           => undef,
+        common_mangled_newversion   => undef,
+        download                    => $_[0]->download,
+        download_version            => undef,
+        origcount                   => undef,
+        origtars                    => [],
+        previous_download_available => undef,
+        previous_newversion         => undef,
+        previous_newfile_base       => undef,
+        previous_sigfile_base       => undef,
+        signature                   => $_[0]->signature,
+        uscanlog                    => undef,
+    };
+}
+has keyring => (
+    is      => 'ro',
+    default => sub { Devscripts::Uscan::Keyring->new });
+
+sub BUILD {
+    my ($self, $args) = @_;
+    my $watch_version = 0;
+    my $nextline;
+    $dehs_tags = {};
+
+    uscan_verbose "Process watch file at: $args->{watchfile}\n"
+      . "    package = $args->{package}\n"
+      . "    version = $args->{pkg_version}\n"
+      . "    pkg_dir = $args->{pkg_dir}";
+
+    $self->origcount(0);    # reset to 0 for each watch file
+    unless (open WATCH, $args->{watchfile}) {
+        uscan_warn "could not open $args->{watchfile}: $!";
+        return 1;
+    }
+
+    my $lineNumber = 0;
+    while (<WATCH>) {
+        next if /^\s*\#/;
+        next if /^\s*$/;
+        s/^\s*//;
+
+      CHOMP:
+
+        # Reassemble lines split using \
+        chomp;
+        if (s/(?<!\\)\\$//) {
+            if (eof(WATCH)) {
+                uscan_warn
+                  "$args->{watchfile} ended with \\; skipping last line";
+                $self->status(1);
+                last;
+            }
+            if ($watch_version > 3) {
+
+                # drop leading \s only if version 4
+                $nextline = <WATCH>;
+                $nextline =~ s/^\s*//;
+                $_ .= $nextline;
+            } else {
+                $_ .= <WATCH>;
+            }
+            goto CHOMP;
+        }
+
+        # "version" must be the first field
+        if (!$watch_version) {
+
+            # Looking for "version" field.
+            if (/^version\s*=\s*(\d+)(\s|$)/) {    # Found
+                $watch_version = $1;
+
+                # Note that version=1 watchfiles have no "version" field so
+                # authorizated values are >= 2 and <= CURRENT_WATCHFILE_VERSION
+                if (   $watch_version < 2
+                    or $watch_version
+                    > $Devscripts::Uscan::Config::CURRENT_WATCHFILE_VERSION) {
+                    # "version" field found but has no authorizated value
+                    uscan_warn
+"$args->{watchfile} version number is unrecognised; skipping watch file";
+                    last;
+                }
+
+                # Next line
+                next;
+            }
+
+            # version=1 is deprecated
+            else {
+                uscan_warn
+                  "$args->{watchfile} is an obsolete version 1 watch file;\n"
+                  . "   please upgrade to a higher version\n"
+                  . "   (see uscan(1) for details).";
+                $watch_version = 1;
+            }
+        }
+
+        # "version" is fixed, parsing lines now
+
+        # Are there any warnings from this part to give if we're using dehs?
+        dehs_output if ($dehs);
+
+        # Handle shell \\ -> \
+        s/\\\\/\\/g if $watch_version == 1;
+
+        # Handle @PACKAGE@ @ANY_VERSION@ @ARCHIVE_EXT@ substitutions
+        s/\@PACKAGE\@/$args->{package}/g;
+        s/\@ANY_VERSION\@/ANY_VERSION/ge;
+        s/\@ARCHIVE_EXT\@/ARCHIVE_EXT/ge;
+        s/\@SIGNATURE_EXT\@/SIGNATURE_EXT/ge;
+        s/\@DEB_EXT\@/DEB_EXT/ge;
+
+        my $line = Devscripts::Uscan::WatchLine->new({
+                # Shared between lines
+                config     => $self->config,
+                downloader => $self->downloader,
+                shared     => $self->shared,
+                keyring    => $self->keyring,
+
+                # Other parameters
+                line          => $_,
+                pkg           => $self->package,
+                pkg_dir       => $self->pkg_dir,
+                pkg_version   => $self->pkg_version,
+                watch_version => $watch_version,
+                watchfile     => $self->watchfile,
+        });
+        push @{ $self->group }, $lineNumber
+          if ($line->type and $line->type eq 'group');
+        push @{ $self->watchlines }, $line;
+        $lineNumber++;
+    }
+
+    close WATCH
+      or $self->status(1),
+      uscan_warn "problems reading $$args->{watchfile}: $!";
+    $self->watch_version($watch_version);
+}
+
+sub process_lines {
+    my ($self) = shift;
+    return $self->process_group if (@{ $self->group });
+    foreach (@{ $self->watchlines }) {
+
+        # search newfile and newversion
+        my $res = $_->process;
+        $self->status($res) if ($res);
+    }
+    return $self->{status};
+}
+
+sub process_group {
+    my ($self) = @_;
+    # Build version
+    my @cur_versions = split /\+~/, $self->pkg_version;
+    my (@new_versions, @last_debian_mangled_uversions, @last_versions);
+    my $download    = 0;
+    my $last_shared = $self->shared;
+    my $last_comp_version;
+    # Isolate component and following lines
+    foreach my $line (@{ $self->watchlines }) {
+        if ($line->type and $line->type eq 'group') {
+            $last_shared       = $self->new_shared;
+            $last_comp_version = shift @cur_versions;
+        }
+        $line->shared($last_shared);
+        $line->pkg_version($last_comp_version || 0);
+    }
+    # Check if download is needed
+    foreach my $line (@{ $self->watchlines }) {
+        next unless ($line->type eq 'group');
+        # Stop on error
+        if (   $line->parse
+            or $line->search
+            or $line->get_upstream_url
+            or $line->get_newfile_base
+            or $line->cmp_versions) {
+            $self->{status} += $line->status;
+            return $self->{status};
+        }
+        $download = $line->shared->{download}
+          if ($line->shared->{download} > $download);
+    }
+    foreach my $line (@{ $self->watchlines }) {
+        # Set same $download for all
+        $line->shared->{download} = $download;
+        # Non "group" lines where not initialized
+        unless ($line->type eq 'group') {
+            if (   $line->parse
+                or $line->search
+                or $line->get_upstream_url
+                or $line->get_newfile_base
+                or $line->cmp_versions) {
+                $self->{status} += $line->status;
+                return $self->{status};
+            }
+        }
+        if ($line->download_file_and_sig) {
+            $self->{status} += $line->status;
+            return $self->{status};
+        }
+        if ($line->mkorigtargz) {
+            $self->{status} += $line->status;
+            return $self->{status};
+        }
+        if ($line->type eq 'group') {
+            push @new_versions, $line->shared->{common_mangled_newversion}
+              || $line->shared->{common_newversion}
+              || ();
+            push @last_versions, $line->parse_result->{lastversion};
+            push @last_debian_mangled_uversions,
+              $line->parse_result->{mangled_lastversion};
+        }
+    }
+    my $new_version = join '+~', @new_versions;
+    $dehs_tags->{'upstream-version'} = $new_version;
+    $dehs_tags->{'debian-uversion'} = join('+~', @last_versions)
+      if (grep { $_ } @last_versions);
+    $dehs_tags->{'debian-mangled-uversion'} = join '+~',
+      @last_debian_mangled_uversions
+      if (grep { $_ } @last_debian_mangled_uversions);
+    my $mangled_ver
+      = Dpkg::Version->new("1:" . $dehs_tags->{'debian-uversion'} . "-0",
+        check => 0);
+    my $upstream_ver = Dpkg::Version->new("1:$new_version-0", check => 0);
+    if ($mangled_ver == $upstream_ver) {
+        $dehs_tags->{'status'} = "up to date";
+    } elsif ($mangled_ver > $upstream_ver) {
+        $dehs_tags->{'status'} = "only older package available";
+    } else {
+        $dehs_tags->{'status'} = "newer package available";
+    }
+    foreach my $line (@{ $self->watchlines }) {
+        my $path = $line->destfile or next;
+        my $ver = $line->shared->{common_mangled_newversion};
+        $path =~ s/\Q$ver\E/$new_version/;
+        print STDERR "mv $line->{destfile} to $path\n";
+        rename $line->{destfile}, $path;
+        if ($line->signature_available) {
+            rename "$line->{destfile}.asc", "$path.asc";
+            rename "$line->{destfile}.sig", "$path.sig";
+        }
+    }
+    return 0;
+}
+
+1;