[pkg-perl-tools] 01/04: Extract bug info sub into a Bug class

[Alex Muntada]

This is an automated email from the git hooks/post-receive script.

alexm-guest pushed a commit to branch master
in repository pkg-perl-tools.

commit fed501ba67486a8df25d56daeb510b39a37fa98d
Author: Alex Muntada <alexm at alexm.org>
Date:   Fri Dec 2 20:05:35 2016 +0100

    Extract bug info sub into a Bug class
---
 lib/Debian/PkgPerl/Bug.pm | 101 ++++++++++++++++++++++++++++++++++++++++++++++
 scripts/forward           |  50 ++---------------------
 2 files changed, 104 insertions(+), 47 deletions(-)

diff --git a/lib/Debian/PkgPerl/Bug.pm b/lib/Debian/PkgPerl/Bug.pm
new file mode 100644
index 0000000..1b3889a
--- /dev/null
+++ b/lib/Debian/PkgPerl/Bug.pm
@@ -0,0 +1,101 @@
+package Debian::PkgPerl::Bug;
+
+use strict;
+use warnings;
+
+use autodie;
+use Carp;
+
+=head1 NAME
+
+Debian::PkgPerl::Bug - Retrieves bug information to be forwarded.
+
+=head1 SYNOPSIS
+
+    use Debian::PkgPerl::Bug;
+    my $msg = Debian::PkgPerl::Bug->new();
+    my %info = $msg->retrieve_bug_info();
+
+=head1 DESCRIPTION
+
+Helper class that retrieves information related to the bug being
+forwarded upstream.
+
+=cut
+
+sub new {
+    my $class = shift;
+    my %params = @_;
+
+    return bless \%params, $class;
+}
+
+sub retrieve_bug_info {
+    $bug_info{url} = "https://bugs.debian.org/$bug";
+
+    if ($opt_offline_test) {
+        $bug_info{Subject} = 'Test bug subject';
+        $bug_info{msg}     = "Test bug message\n";
+
+        return;
+    }
+
+    # See http://wiki.debian.org/DebbugsSoapInterface
+    require SOAP::Lite;
+    my $soap = SOAP::Lite->uri('Debbugs/SOAP')
+        ->proxy('http://bugs.debian.org/cgi-bin/soap.cgi');
+
+    my $info = $soap->get_status($bug)->result()->{$bug};
+
+    die "Err: Bug #$bug already closed\n" if $info->{done};
+    if ( $info->{forwarded} ) {
+        if ($opt_force) {
+            warn "Wrn: Bug #$bug already forwarded to $info->{forwarded}\n";
+        }
+        else {
+            die "Err: Bug #$bug already forwarded to $info->{forwarded}\n";
+        }
+    }
+
+    $bug_info{Subject} = $info->{subject};
+
+    # try to get the body of the first message
+    # get_bug_log() fails with a SOAP error for some bugs. cf. #635018
+    my $ok = eval {
+        my $log = $soap->get_bug_log($bug)->result();
+        $bug_info{msg} = $log->[0]->{body};
+        $bug_info{msg} .= "\n" unless $bug_info{msg} =~ /\n$/;
+        1;
+    };
+
+    unless ($ok) {
+        my $err = $@;
+
+        warn "W: Failed to retrieve content of bug #$bug:\n";
+        warn "W: $err";
+    }
+}
+
+=head1 LICENSE AND COPYRIGHT
+
+=over
+
+=item Copyright 2016 Alex Muntada.
+
+=item Copyright 2014 Salvatore Bonaccorso.
+
+=item Copyright 2014 Damyan Ivanov.
+
+=item Copyright 2011 Alessandro Ghedini.
+
+=back
+
+This program is free software; you can redistribute it and/or modify it
+under the terms of either: the GNU General Public License as published
+by the Free Software Foundation; or the Artistic License.
+
+See http://dev.perl.org/licenses/ for more information.
+
+=cut
+
+1;
diff --git a/scripts/forward b/scripts/forward
index b57cb9d..abeb462 100755
--- a/scripts/forward
+++ b/scripts/forward
@@ -16,6 +16,7 @@ use Text::Wrap qw(wrap);
 use Proc::InvokeEditor;
 use MIME::Lite;
 use YAML::XS qw(LoadFile);
+use Debian::PkgPerl::Bug;
 use Debian::PkgPerl::GitHub;
 
 use warnings;
@@ -244,53 +245,8 @@ if ($patch) {
     }
 }
 
-retrieve_bug_info() if $bug;
-
-sub retrieve_bug_info {
-    $bug_info{url} = "https://bugs.debian.org/$bug";
-
-    if ($opt_offline_test) {
-        $bug_info{Subject} = 'Test bug subject';
-        $bug_info{msg}     = "Test bug message\n";
-
-        return;
-    }
-
-    # See http://wiki.debian.org/DebbugsSoapInterface
-    require SOAP::Lite;
-    my $soap = SOAP::Lite->uri('Debbugs/SOAP')
-        ->proxy('http://bugs.debian.org/cgi-bin/soap.cgi');
-
-    my $info = $soap->get_status($bug)->result()->{$bug};
-
-    die "Err: Bug #$bug already closed\n" if $info->{done};
-    if ( $info->{forwarded} ) {
-        if ($opt_force) {
-            warn "Wrn: Bug #$bug already forwarded to $info->{forwarded}\n";
-        }
-        else {
-            die "Err: Bug #$bug already forwarded to $info->{forwarded}\n";
-        }
-    }
-
-    $bug_info{Subject} = $info->{subject};
-
-    # try to get the body of the first message
-    # get_bug_log() fails with a SOAP error for some bugs. cf. #635018
-    my $ok = eval {
-        my $log = $soap->get_bug_log($bug)->result();
-        $bug_info{msg} = $log->[0]->{body};
-        $bug_info{msg} .= "\n" unless $bug_info{msg} =~ /\n$/;
-        1;
-    };
-
-    unless ($ok) {
-        my $err = $@;
-
-        warn "W: Failed to retrieve content of bug #$bug:\n";
-        warn "W: $err";
-    }
-}
+my $bug_info = Debian::PkgPerl::Bug->new();
+%bug_info = $bug_info->retrieve_bug_info() if $bug;
 
 sub get_subject {
     my $default = ( $bug ? $bug_info{Subject} : $patch_info{Subject} ) // '';

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/pkg-perl-tools.git