<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">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-&gt;new('debian/rules');

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

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

    # file contents changed externally
    $r-&gt;parse;

    $r-&gt;add_quilt;
    $r-&gt;drop_quilt;

    $r-&gt;write;  # or undef($r);


=head1 DESCRIPTION

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

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

=head1 CONSTRUCTOR

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

If a file name is given, the constructor calls L&lt;/read&gt; to read the file
contents into memory.

One of B&lt;filename&gt; or B&lt;lines&gt; 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&lt;/new&gt;.

=back

=cut

use base 'Class::Accessor';

__PACKAGE__-&gt;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 =&gt; $params[0] }
        if @params == 1 and not ref( $params[0] );

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

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

    $self-&gt;lines( [] ) unless $self-&gt;lines;

    $self-&gt;read if $self-&gt;filename;

    return $self;
}

=head1 METHODS

=over

=item parse

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

=cut

sub parse {
    my $self = shift;

    $self-&gt;_is_dh7tiny(0);
    $self-&gt;_is_quiltified(0);

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

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

    $self-&gt;_parsed(1);
}

=item is_dh7tiny

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

    %:
            dh $@

(any options on the C&lt;dh&gt; command line ignored).

=cut

sub is_dh7tiny {
    my $self = shift;

    $self-&gt;parse unless $self-&gt;_parsed;

    return $self-&gt;_is_dh7tiny;
}

=item is_quiltified

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

=over

=item dh --with=quilt

=item F&lt;quilt.make&gt; with C&lt;&lt; $(QUILT_STAMPFN) &gt;&gt; and C&lt;unpatch&gt; targets.

=back

=cut

sub is_quiltified {
    my $self = shift;

    $self-&gt;parse unless $self-&gt;_parsed;

    return $self-&gt;_is_quiltified;
}

=item add_quilt

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

=cut

sub add_quilt {
    my $self = shift;

    return if $self-&gt;is_quiltified;

    my $lines = $self-&gt;lines;

    if ( $self-&gt;is_dh7tiny) {
        for (@$lines) {

            # add --with=quilt to every dh call
            s/(?&lt;=\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&lt;quilt(1)&gt; integration. Both debhelper 7 I&lt;tiny&gt; style (C&lt;dh
--with=quilt&gt;) and traditional (C&lt;&lt; $(QUILT_STAMPFN) &gt;&gt; and C&lt;unpatch&gt;)
approaches are detected and removed.

=cut

sub drop_quilt {
    my $self = shift;

    my $lines = $self-&gt;lines;

    # look for the quilt include line and remove it and the previous empty one
    for ( my $i = 1; $i &lt; @$lines; $i++ ) {
        if ( $lines-&gt;[$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 &lt; @$lines
                    and $lines-&gt;[$i] eq ''
                    and $lines-&gt;[ $i - 1 ] eq '';

            last;
        }
    }

    # remove the QUILT_STAMPFN dependency override
    for ( my $i = 1; $i &lt; @$lines; $i++ ) {
        if (    $lines-&gt;[$i] eq ''
            and $lines-&gt;[ $i + 1 ] eq
            'override_dh_auto_configure: $(QUILT_STAMPFN)'
            and $lines-&gt;[ $i + 2 ] eq "\tdh_auto_configure"
            and $lines-&gt;[ $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 &lt; @$lines; $i++ ) {
        $lines-&gt;[$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 &lt; @$lines; $i++ ) {
        if (    $lines-&gt;[$i] eq 'override_dh_auto_clean: unpatch'
            and $lines-&gt;[ $i + 1 ] eq "\tdh_auto_clean"
            and ( $i + 2 &gt; $#$lines or $lines-&gt;[ $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 &gt; $#$lines ) {
                $#$lines-- if $lines-&gt;[-1] eq '';   # trim trailing empty line
            }
            elsif ( $lines-&gt;[$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 &lt; @$lines; $i++ ) {
        $lines-&gt;[$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&lt;file name&gt;]

Replaces the current rules content with the content of I&lt;filename&gt;. If
I&lt;filename&gt; is not given, uses the value of the L&lt;/filename&gt; member.

=cut

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

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

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

    return unless -e $filename;

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

=item write [I&lt;filename&gt;]

Writes the in-memory contents I&lt;filename&gt;. If not given, uses the value of the
L&lt;/filename&gt; member.

If L&lt;/lines&gt; points to an empty array, the file is removed.

=cut

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

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

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

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

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

sub DESTROY {
    my $self = shift;

    $self-&gt;write if $self-&gt;filename;

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

=back

=head1 COPYRIGHT &amp; LICENSE

=over

=item Copyright (C) 2009, 2010 Damyan Ivanov &lt;dmn@debian.org&gt;

=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;
</pre></body></html>