/usr/share/perl5/Debian/PkgPerl/Patch.pm is in pkg-perl-tools 0.42.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 | package Debian::PkgPerl::Patch;
use strict;
use warnings;
use autodie;
use Carp;
use File::Spec;
=head1 NAME
Debian::PkgPerl::Patch - Retrieves patch information to be forwarded.
=head1 SYNOPSIS
use Debian::PkgPerl::Patch;
my $msg = Debian::PkgPerl::Patch->new();
my %info = $msg->retrieve_patch_info();
=head1 DESCRIPTION
Helper class that retrieves information related to the patch being
forwarded upstream.
=cut
sub new {
my $class = shift;
my %params = @_;
return bless \%params, $class;
}
sub retrieve_patch_info {
my $self = shift;
my %patch_info;
my $patch = $self->{patch};
my $opt_force = $self->{force};
$patch_info{patch} = $patch;
open( my $in, "<", $patch );
my $line_no = 1;
while ( $line_no <= 10 ) {
my $line = <$in>;
chomp($line);
last if $line =~ /^(?:diff|index|---|\+\+\+)/s;
if ( $line !~ /^Forwarded: not yet/i
and $line !~ /^Forwarded: no$/i
and $line =~ /^(?:Forwarded|Bug): (\S+)/i )
{
if ($opt_force) {
warn "Patch already forwarded to $1\n";
warn "Continuing anyway because of --force.\n";
}
else {
die "Patch already forwarded to $1\n";
}
}
$patch_info{Subject} = $1
if $line =~ /^(?:Subject|Description):\s+(.+)/;
$patch_info{From} = $1
if $line =~ /^(?:From|Author):\s+(.+)/;
$line_no++;
}
unless ( $patch_info{Subject} ) {
# TODO: Use basename($patch) instead?
# default subject is the patch name
my $fn = ( File::Spec->splitpath($patch) )[-1];
$fn =~ s/\.(?:patch|diff)$//; # strip extension
$fn =~ s/^\d+[-_]?//; # strip leading number
$fn =~ s/(\_|\-)/ /g; # spaces make reading easier
$patch_info{Subject} = $fn;
}
return %patch_info;
}
=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;
|