This file is indexed.

/usr/share/perl5/Debian/Rules.pm is in dh-make-perl 0.80-1.

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
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
package Debian::Rules;

use strict;
use warnings;

our $VERSION = '0.66';

=head1 NAME

Debian::Rules - handy manipulation of debian/rules

=head1 SYNOPSIS

    my $r = Debian::Rules->new('debian/rules');

    my $r = Debian::Rules->new( { filename => 'debian/rules' } );

    $r->is_dh7tiny && print "Using the latest and greatest\n";
    $r->is_quiltified && print "quilt rules the rules\n";

    # file contents changed externally
    $r->parse;

    $r->add_quilt;
    $r->drop_quilt;

    $r->write;  # or undef($r);


=head1 DESCRIPTION

Some times, one needs to know whether F<debian/rules> uses the L<debhelper(1)>
7 tiny variant, or whether it is integrated with L<quilt(1)>. Debian::Rules
provides facilities to check this, as well as adding/removing quilt
integration.

Modified contents are written to file either vie the L</write> method, or when
the object reference goes out of scope (via DESTROY).

=head1 CONSTRUCTOR

C<new> is the standard L<Class::Accessor> constructor, with the exception that
if only one, non-reference argument is provided, it is treated as a value for
the L<filename> field.

If a file name is given, the constructor calls L</read> to read the file
contents into memory.

One of B<filename> or B<lines> is mandatory.

=head1 FIELDS

=over

=item filename

Contains the file name of the rules file.

=item lines

Reference to an array pointing to the rules file. Initialized by L</new>.

=back

=cut

use base 'Class::Accessor';

__PACKAGE__->mk_accessors(
    qw(filename lines _is_dh7tiny _is_quiltified _parsed));

sub new {
    my $class = shift;

    my @params = @_;

    # allow single argument to be treated as filename
    @params = { filename => $params[0] }
        if @params == 1 and not ref( $params[0] );

    my $self = $class->SUPER::new(@params);

    $self->filename or $self->lines or die "'filename' or 'lines' is mandatory";

    $self->lines( [] ) unless $self->lines;

    $self->read if $self->filename;

    return $self;
}

=head1 METHODS

=over

=item parse

Parses the rules file and stores its findings for later use. Called
automatically by L<is_dh7tiny> and L<is_quiltified>. The result of the parsing
is cached and subsequent calls to C<is_XXX> use the cache. To force cache
refresh (for example if the contents of the file have been changed), call
C<parse> again.

=cut

sub parse {
    my $self = shift;

    $self->_is_dh7tiny(0);
    $self->_is_quiltified(0);

    for ( my $i = 1; $i < @{ $self->lines }; $i++ ) {
        if (    $self->lines->[$i] =~ /^%:/
            and $i + 1 < @{ $self->lines }
            and $self->lines->[ $i + 1 ] =~ /^\tdh .*\$\@/ )
        {
            $self->_is_dh7tiny(1);

            if ( $self->lines->[ $i + 1 ] =~ /--with[ =]quilt/ ) {
                $self->_is_quiltified(1);
                last;
            }
        }
    }

    $self->_parsed(1);
}

=item is_dh7tiny

Returns true if the contents of the rules file seem to use the so called
I<tiny> variant offered by debhelper 7. Tiny rules are detected by the
presence of the following two lines:

    %:
            dh $@

(any options on the C<dh> command line ignored).

=cut

sub is_dh7tiny {
    my $self = shift;

    $self->parse unless $self->_parsed;

    return $self->_is_dh7tiny;
}

=item is_quiltified

Returns true if the contents of the rules file indicate that L<quilt(1)> is
used. Various styles of C<quilt> integration are detected:

=over

=item dh --with=quilt

=item F<quilt.make> with C<< $(QUILT_STAMPFN) >> and C<unpatch> targets.

=back

=cut

sub is_quiltified {
    my $self = shift;

    $self->parse unless $self->_parsed;

    return $self->_is_quiltified;
}

=item add_quilt

Integrates L<quilt(1)> into the rules. For debhelper 7 I<tiny> rules (as
determined by L</is_dh7tiny>) C<--with=quilt> is added to every C<dh>
invocation. For the more traditional variant, quilt is integrated via
F<quilt.make> and its C<< $(QUILT_STAMPFN) >> and C<unpatch> targets.

=cut

sub add_quilt {
    my $self = shift;

    return if $self->is_quiltified;

    my $lines = $self->lines;

    if ( $self->is_dh7tiny) {
        for (@$lines) {

            # add --with=quilt to every dh call
            s/(?<=\s)dh /dh --with=quilt /
                unless /--with[= ]quilt/;    # unless it is already there
        }
    }
    else {

        # non-dh7tiny
        splice @$lines, 1, 0,
            ( '', 'include /usr/share/quilt/quilt.make' )
            unless grep /quilt\.make/, @$lines;

        push @$lines,
            '',
            'override_dh_auto_configure: $(QUILT_STAMPFN)',
            "\tdh_auto_configure"
            unless grep /QUILT_STAMPFN/, @$lines;

        push @$lines, '', 'override_dh_auto_clean: unpatch',
            "\tdh_auto_clean"
            unless grep /override_dh_auto_clean:.*unpatch/, @$lines;
    }
}

=item drop_quilt

Removes L<quilt(1)> integration. Both debhelper 7 I<tiny> style (C<dh
--with=quilt>) and traditional (C<< $(QUILT_STAMPFN) >> and C<unpatch>)
approaches are detected and removed.

=cut

sub drop_quilt {
    my $self = shift;

    my $lines = $self->lines;

    # look for the quilt include line and remove it and the previous empty one
    for ( my $i = 1; $i < @$lines; $i++ ) {
        if ( $lines->[$i] eq 'include /usr/share/quilt/quilt.make' ) {
            splice @$lines, $i, 1;

            # collapse two sequencial empty lines
            # NOTE: this won't work if the include statement was the last line
            # in the rules, but this is highly unlikely
            splice( @$lines, $i, 1 )
                if $i < @$lines
                    and $lines->[$i] eq ''
                    and $lines->[ $i - 1 ] eq '';

            last;
        }
    }

    # remove the QUILT_STAMPFN dependency override
    for ( my $i = 1; $i < @$lines; $i++ ) {
        if (    $lines->[$i] eq ''
            and $lines->[ $i + 1 ] eq
            'override_dh_auto_configure: $(QUILT_STAMPFN)'
            and $lines->[ $i + 2 ] eq "\tdh_auto_configure"
            and $lines->[ $i + 3 ] eq '' )
        {
            splice @$lines, $i, 3;
            last;
        }
    }

   # also remove $(QUILT_STAMPFN) as a target dependency
   # note that the override_dh_auto_configure is handled above because in that
   # case the whole makefile snipped is to be removed
   # Here we deal with the more generic cases
    for ( my $i = 1; $i < @$lines; $i++ ) {
        $lines->[$i] =~ s{
            ^                               # at the beginning of the line
            ([^\s:]+):                      # target name, followed by a colon
            (.*)                            # any other dependencies
            \$\(QUILT_STAMPFN\)             # followed by $(QUILT_STAMPFN)
        }{$1:$2}x;
    }

    # remove unpatch dependency in clean
    for ( my $i = 1; $i < @$lines; $i++ ) {
        if (    $lines->[$i] eq 'override_dh_auto_clean: unpatch'
            and $lines->[ $i + 1 ] eq "\tdh_auto_clean"
            and ( $i + 2 > $#$lines or $lines->[ $i + 2 ] !~ /^\t/ ) )
        {
            splice @$lines, $i, 2;

            # At this point there may be an extra empty line left.
            # Remove an empty line after the removed target
            # Or any trailing empty line (if the target was at EOF)
            if ( $i > $#$lines ) {
                $#$lines-- if $lines->[-1] eq '';   # trim trailing empty line
            }
            elsif ( $lines->[$i] eq '' ) {
                splice( @$lines, $i, 1 );
            }

            last;
        }
    }

    # similarly to the $(QUILT_STAMPFN) stripping, here we process a general
    # ependency on the 'unpatch' rule
    for ( my $i = 1; $i < @$lines; $i++ ) {
        $lines->[$i] =~ s{
            ^                               # at the beginning of the line
            ([^\s:]+):                      # target name, followed by a colon
            (.*)                            # any other dependencies
            unpatch                         # followed by 'unpatch'
        }{$1:$2}x;
    }

    # drop --with=quilt from dh command line
    for (@$lines) {
        while ( /dh (.*)--with[= ]quilt(.*)\n/ ) {
            my ( $before, $after ) = ( $1, $2 );
            $after =~ s/\s+$//;                         # remove trailing spaces
            $after =~ s/^\s+// if $before =~ /\s$/;     # collapse adjascent spaces
            $before =~ s/\s+$// if $after eq '';        # more trailing spaces
            $after =~ s/^\s+// if $before eq '';        # extra leading space
            s/dh (.*)--with[= ]quilt(.*)\n/dh $before$after\n/;
        }
    }
}

=item read [I<file name>]

Replaces the current rules content with the content of I<filename>. If
I<filename> is not given, uses the value of the L</filename> member.

=cut

sub read {
    my $self = shift;
    my $filename = shift // $self->filename;

    defined($filename) or die "No filename given to read() nor new()";

    @{ $self->lines } = ();
    $self->_parsed(0);

    return unless -e $filename;

    my $fh;
    open( $fh, '<', $filename ) or die "open($filename): $!";
    while( defined( $_ = <$fh> ) ) {
        push @{ $self->lines }, $_;
    }
    close $fh;
}

=item write [I<filename>]

Writes the in-memory contents I<filename>. If not given, uses the value of the
L</filename> member.

If L</lines> points to an empty array, the file is removed.

=cut

sub write {
    my $self = shift;
    my $filename = shift // $self->filename;

    defined($filename) or die "No filename given to write() nor new()";

    if ( @{ $self->lines } ) {
        open my $fh, '>', $filename
            or die "Error opening '$filename': $!";

        print $fh $_ for @{ $self->lines };

        close $fh;
    }
    else {
        unlink $filename or die "unlink($filename): $!";
    }
}

sub DESTROY {
    my $self = shift;

    $self->write if $self->filename;

    bless $self, 'Class::Accessor'; # chain destruction
}

=back

=head1 COPYRIGHT & LICENSE

=over

=item Copyright (C) 2009, 2010 Damyan Ivanov <dmn@debian.org>

=back

This program is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License version 2 as published by the Free
Software Foundation.

This program is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
PARTICULAR PURPOSE.  See the GNU General Public License for more details.

You should have received a copy of the GNU General Public License along with
this program; if not, write to the Free Software Foundation, Inc., 51 Franklin
Street, Fifth Floor, Boston, MA 02110-1301 USA.

=cut

1;