<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package DhMakePerl::Command::refresh;

=head1 NAME

DhMakePerl::Command::refresh - dh-make-perl refresh implementation

=head1 DESCRIPTION

This module implements the I&lt;refresh&gt; command of L&lt;dh-make-perl(1)&gt;.

=cut

use strict; use warnings;

our $VERSION = '0.77';

use base 'DhMakePerl::Command::Packaging';
use Debian::Control::FromCPAN;
use Debian::WNPP::Query ();
use File::Spec::Functions qw(catfile);
use Tie::File;

=head1 METHODS

=over

=item execute

Provides I&lt;refresh&gt; command implementation.

=cut

sub execute {
    my $self = shift;

    $self-&gt;main_dir( $ARGV[0] || '.' );
    print "Engaging refresh mode in " . $self-&gt;main_dir . "\n"
        if $self-&gt;cfg-&gt;verbose;

    if ( not $self-&gt;cfg-&gt;_explicitly_set-&gt;{'source-format'}
        and -e ( my $f = catfile( $self-&gt;debian_file('source'), 'format' ) ) )
    {
        open( my $fh, '&lt;', $f ) or die "open($f): $!";
        my $present = &lt;$fh&gt;;
        close $fh;

        chomp($present) if $present;
        if ($present) {
            $self-&gt;cfg-&gt;source_format($present);
            print "Detected source format: $present\n"
                if $self-&gt;cfg-&gt;verbose;
        }
    }

    $self-&gt;control-&gt;read( $self-&gt;debian_file('control') );
    $self-&gt;fill_maintainer;
    $self-&gt;process_meta;
    $self-&gt;extract_basic();    # also detects arch-dep package

    $self-&gt;extract_docs     if $self-&gt;cfg-&gt;only-&gt;{docs};
    $self-&gt;extract_examples if $self-&gt;cfg-&gt;only-&gt;{examples};
    print "Found docs: @{ $self-&gt;docs }\n"
        if @{ $self-&gt;docs } and $self-&gt;cfg-&gt;verbose;
    print "Found examples: @{ $self-&gt;examples }\n"
        if @{ $self-&gt;examples } and $self-&gt;cfg-&gt;verbose;

    if ( $self-&gt;cfg-&gt;only-&gt;{only} ) {
        $self-&gt;create_rules;
        $self-&gt;create_compat( $self-&gt;debian_file('compat') );
    }

    if ( $self-&gt;cfg-&gt;only-&gt;{examples} ) {
        $self-&gt;update_file_list( examples =&gt; $self-&gt;examples );
    }

    if ( $self-&gt;cfg-&gt;only-&gt;{docs} ) {
        $self-&gt;update_file_list( docs =&gt; $self-&gt;docs );
    }

    if ( $self-&gt;cfg-&gt;only-&gt;{copyright} ) {
        $self-&gt;backup_file( $self-&gt;debian_file('copyright') );
        $self-&gt;create_copyright( $self-&gt;debian_file('copyright') );
    }

    if ( $self-&gt;cfg-&gt;only-&gt;{control} ) {
        my $control = $self-&gt;control;
        if ( -e catfile( $self-&gt;debian_file('patches'), 'series' )
            and $self-&gt;cfg-&gt;source_format ne '3.0 (quilt)' )
        {
            $self-&gt;add_quilt($control);
        }
        else {
            $self-&gt;drop_quilt($control);
        }

        $self-&gt;write_source_format(
            catfile( $self-&gt;debian_dir, 'source', 'format' ) );

        $self-&gt;discover_dependencies;

        $self-&gt;discover_utility_deps($control);
        $control-&gt;prune_perl_deps();

        $self-&gt;backup_file( $self-&gt;debian_file('control') );
        $control-&gt;write( $self-&gt;debian_file('control') );
    }

    print "--- Done\n" if $self-&gt;cfg-&gt;verbose;
    return 0;
}

=item add_quilt( $control )

Plugs quilt into F&lt;debian/rules&gt; and F&lt;debian/control&gt;. Depends on
F&lt;debian/rules&gt; being in DH7 three-liner format. Also adds debian/README.source
documenting quilt usage.

=cut

sub add_quilt {
    my( $self, $control ) = @_;

    $self-&gt;read_rules;

    $self-&gt;rules-&gt;add_quilt;

    # README.source
    my $quilt_mini_doc = &lt;&lt;EOF;
This package uses quilt for managing all modifications to the upstream
source. Changes are stored in the source package as diffs in
debian/patches and applied during the build.

See /usr/share/doc/quilt/README.source for a detailed explaination.
EOF

    my $readme = $self-&gt;debian_file('README.source');
    my $quilt_already_documented = 0;
    my $readme_source_exists = -e $readme;
    if($readme_source_exists) {
        my @readme;
        tie @readme, 'Tie::File', $readme
            or die "Unable to tie '$readme': $!";

        for( @readme ) {
            if( m{quilt/README.source} ) {
                $quilt_already_documented = 1;
                last;
            }
        }
    }

    print "README.source already documents quilt\n"
        if $quilt_already_documented and $self-&gt;cfg-&gt;verbose;

    unless($quilt_already_documented) {
        my $fh;
        open( $fh, '&gt;&gt;', $readme )
            or die "Unable to open '$readme' for writing: $!";

        print $fh "\n\n" if $readme_source_exists;
        print $fh $quilt_mini_doc;
        close $fh;
    }
}

=item drop_quilt( $control )

removes quilt from F&lt;debian/rules&gt;. Expects that
L&lt;|add_quilt&gt; was used to add quilt to F&lt;debian/rules&gt;.

If F&lt;debian/README.source&gt; exists, references to quilt are removed from it (and
the file removed if empty after that).

Both dh7-style (C&lt;dh --with=quilt&gt;) and old-fashioned (C&lt;$(QUILT_STAMPFN)&gt;
target dependency) are supported.

=cut

sub drop_quilt {
    my( $self, $control ) = @_;

    $self-&gt;read_rules;

    $self-&gt;rules-&gt;drop_quilt;

    # README.source
    my $readme = $self-&gt;debian_file('README.source');

    if( -e $readme ) {
        my @readme;
        tie @readme, 'Tie::File', $readme
            or die "Unable to tie '$readme': $!";

        my( $start, $end );
        for( my $i = 0; defined( $_ = $readme[$i] ); $i++ ) {
            if( m{^This package uses quilt } ) {
                $start = $i;
                next;
            }

            if( defined($start)
                    and m{^See /usr/share/doc/quilt/README.source} ) {
                $end = $i;
                last;
            }
        }

        if( defined($start) and defined($end) ) {
            print "Removing references to quilt from README.source\n"
                if $self-&gt;cfg-&gt;verbose;

            splice @readme, $start, $end-$start+1;

            # file is now empty?
            if( join( '', @readme ) =~ /^\s*$/ ) {
                unlink $readme
                    or die "unlink($readme): $!";
            }
        }
    }
}

=back

=cut

1;

=head1 COPYRIGHT &amp; LICENSE

=over

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

=item Copyright (C) 2010 gregor herrmann &lt;gregoa@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

</pre></body></html>