Adding upstream version 2.23.4+deb12u1.upstream/2.23.4+deb12u1upstream

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

1 files changed, 27 insertions, 0 deletions

diff --git a/lib/Devscripts/Uscan/CatchRedirections.pm b/lib/Devscripts/Uscan/CatchRedirections.pm
new file mode 100644
index 0000000..28f99ca
--- /dev/null
+++ b/lib/Devscripts/Uscan/CatchRedirections.pm
@@ -0,0 +1,27 @@
+# dummy subclass used to store all the redirections for later use
+package Devscripts::Uscan::CatchRedirections;
+
+use base 'LWP::UserAgent';
+
+my @uscan_redirections;
+
+sub redirect_ok {
+    my $self = shift;
+    my ($request) = @_;
+    if ($self->SUPER::redirect_ok(@_)) {
+        push @uscan_redirections, $request->uri;
+        return 1;
+    }
+    return 0;
+}
+
+sub get_redirections {
+    return \@uscan_redirections;
+}
+
+sub clear_redirections {
+    undef @uscan_redirections;
+    return;
+}
+
+1;