Adding upstream version 2.23.7.upstream/2.23.7upstream

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

1 files changed, 257 insertions, 0 deletions

diff --git a/lib/Devscripts/Uscan/FindFiles.pm b/lib/Devscripts/Uscan/FindFiles.pm
new file mode 100644
index 0000000..3f8f8b3
--- /dev/null
+++ b/lib/Devscripts/Uscan/FindFiles.pm
@@ -0,0 +1,257 @@
+
+=head1 NAME
+
+Devscripts::Uscan::FindFiles - watchfile finder
+
+=head1 SYNOPSIS
+
+  use Devscripts::Uscan::Config;
+  use Devscripts::Uscan::FindFiles;
+  
+  # Get config
+  my $config = Devscripts::Uscan::Config->new->parse;
+  
+  # Search watchfiles
+  my @wf = find_watch_files($config);
+
+=head1 DESCRIPTION
+
+This package exports B<find_watch_files()> function. This function search
+Debian watchfiles following configuration parameters.
+
+=head1 SEE ALSO
+
+L<uscan>, L<Devscripts::Uscan::WatchFile>, L<Devscripts::Uscan::Config>
+
+=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::FindFiles;
+
+use strict;
+use filetest 'access';
+use Cwd qw/cwd/;
+use Exporter 'import';
+use Devscripts::Uscan::Output;
+use Devscripts::Versort;
+use Dpkg::Changelog::Parse qw(changelog_parse);
+use File::Basename;
+
+our @EXPORT = ('find_watch_files');
+
+sub find_watch_files {
+    my ($config) = @_;
+    my $opwd = cwd();
+
+    # when --watchfile is used
+    if (defined $config->watchfile) {
+        uscan_verbose "Option --watchfile=$config->{watchfile} used";
+        my ($config) = (@_);
+
+        # no directory traversing then, and things are very simple
+        if (defined $config->package) {
+
+            # no need to even look for a changelog!
+            return (
+                ['.', $config->package, $config->uversion, $config->watchfile]
+            );
+        } else {
+            # Check for debian/changelog file
+            until (-r 'debian/changelog') {
+                chdir '..' or uscan_die "can't chdir ..: $!";
+                if (cwd() eq '/') {
+                    uscan_die "Are you in the source code tree?\n"
+                      . "   Cannot find readable debian/changelog anywhere!";
+                }
+            }
+
+            my ($package, $debversion, $uversion)
+              = scan_changelog($config, $opwd, 1);
+
+            return ([cwd(), $package, $uversion, $config->watchfile]);
+        }
+    }
+
+    # when --watchfile is not used, scan watch files
+    push @ARGV, '.' if !@ARGV;
+    {
+        local $, = ',';
+        uscan_verbose "Scan watch files in @ARGV";
+    }
+
+    # Run find to find the directories.  We will handle filenames with spaces
+    # correctly, which makes this code a little messier than it would be
+    # otherwise.
+    my @dirs;
+    open FIND, '-|', 'find', @ARGV,
+      qw{-follow -type d ( -name .git -prune -o -name debian -print ) }
+      or uscan_die "Couldn't exec find: $!";
+
+    while (<FIND>) {
+        chomp;
+        push @dirs, $_;
+        uscan_debug "Found $_";
+    }
+    close FIND;
+
+    uscan_die "No debian directories found" unless @dirs;
+
+    my @debdirs = ();
+
+    my $origdir = cwd;
+    for my $dir (@dirs) {
+        $dir =~ s%/debian$%%;
+
+        unless (chdir $origdir) {
+            uscan_warn "Couldn't chdir back to $origdir, skipping: $!";
+            next;
+        }
+        unless (chdir $dir) {
+            uscan_warn "Couldn't chdir $dir, skipping: $!";
+            next;
+        }
+
+        uscan_verbose "Check debian/watch and debian/changelog in $dir";
+
+        # Check for debian/watch file
+        if (-r 'debian/watch') {
+            unless (-r 'debian/changelog') {
+                uscan_warn
+                  "Problems reading debian/changelog in $dir, skipping";
+                next;
+            }
+            my ($package, $debversion, $uversion)
+              = scan_changelog($config, $opwd);
+            next unless ($package);
+
+            uscan_verbose
+              "package=\"$package\" version=\"$uversion\" (no epoch/revision)";
+            push @debdirs, [$debversion, $dir, $package, $uversion];
+        }
+    }
+
+    uscan_warn "No watch file found" unless @debdirs;
+
+    # Was there a --upstream-version option?
+    if (defined $config->uversion) {
+        if (@debdirs == 1) {
+            $debdirs[0][3] = $config->uversion;
+        } else {
+            uscan_warn
+"ignoring --upstream-version as more than one debian/watch file found";
+        }
+    }
+
+    # Now sort the list of directories, so that we process the most recent
+    # directories first, as determined by the package version numbers
+    @debdirs = Devscripts::Versort::deb_versort(@debdirs);
+
+    # Now process the watch files in order.  If a directory d has
+    # subdirectories d/sd1/debian and d/sd2/debian, which each contain watch
+    # files corresponding to the same package, then we only process the watch
+    # file in the package with the latest version number.
+    my %donepkgs;
+    my @results;
+    for my $debdir (@debdirs) {
+        shift @$debdir;    # don't need the Debian version number any longer
+        my $dir       = $$debdir[0];
+        my $parentdir = dirname($dir);
+        my $package   = $$debdir[1];
+        my $version   = $$debdir[2];
+
+        if (exists $donepkgs{$parentdir}{$package}) {
+            uscan_warn
+"Skipping $dir/debian/watch\n   as this package has already been found";
+            next;
+        }
+
+        unless (chdir $origdir) {
+            uscan_warn "Couldn't chdir back to $origdir, skipping: $!";
+            next;
+        }
+        unless (chdir $dir) {
+            uscan_warn "Couldn't chdir $dir, skipping: $!";
+            next;
+        }
+
+        uscan_verbose
+"$dir/debian/changelog sets package=\"$package\" version=\"$version\"";
+        push @results, [$dir, $package, $version, "debian/watch", cwd];
+    }
+    unless (chdir $origdir) {
+        uscan_die "Couldn't chdir back to $origdir! $!";
+    }
+    return @results;
+}
+
+sub scan_changelog {
+    my ($config, $opwd, $die) = @_;
+    my $out
+      = $die
+      ? sub { uscan_die(@_) }
+      : sub { uscan_warn($_[0] . ', skipping'); return undef; };
+
+    # Figure out package info we need
+    my $changelog = eval { changelog_parse(); };
+    if ($@) {
+        return $out->("Problems parsing debian/changelog");
+    }
+
+    my ($package, $debversion, $uversion);
+    $package = $changelog->{Source};
+    return $out->("Problem determining the package name from debian/changelog")
+      unless defined $package;
+    $debversion = $changelog->{Version};
+    return $out->("Problem determining the version from debian/changelog")
+      unless defined $debversion;
+    uscan_verbose
+"package=\"$package\" version=\"$debversion\" (as seen in debian/changelog)";
+
+    # Check the directory is properly named for safety
+    if ($config->check_dirname_level == 2
+        or ($config->check_dirname_level == 1 and cwd() ne $opwd)) {
+        my $good_dirname;
+        my $re = $config->check_dirname_regex;
+        $re =~ s/PACKAGE/\Q$package\E/g;
+        if ($re =~ m%/%) {
+            $good_dirname = (cwd() =~ m%^$re$%);
+        } else {
+            $good_dirname = (basename(cwd()) =~ m%^$re$%);
+        }
+        return $out->("The directory name "
+              . basename(cwd())
+              . " doesn't match the requirement of\n"
+              . "   --check-dirname-level=$config->{check_dirname_level} --check-dirname-regex=$re .\n"
+              . "   Set --check-dirname-level=0 to disable this sanity check feature."
+        ) unless $good_dirname;
+    }
+
+    # Get current upstream version number
+    if (defined $config->uversion) {
+        $uversion = $config->uversion;
+    } else {
+        $uversion = $debversion;
+        $uversion =~ s/-[^-]+$//;    # revision
+        $uversion =~ s/^\d+://;      # epoch
+    }
+    return ($package, $debversion, $uversion);
+}
+1;