CPAN::Patches::Plugin::Debian - patch CPAN distributions Debian package

    cd Some-Distribution
    dh-make-perl
    cpan-patches list
    cpan-patches update-debian
    cpan-patches --patch-set $HOME/cpan-patches-set list
    cpan-patches --patch-set $HOME/cpan-patches-set update-debian

    perldoc CPAN::Patches

package CPAN::Patches::Plugin::Debian;

use warnings;
use strict;

our $VERSION = '0.02';

use Moose::Role;

use Carp 'croak';
use IO::Any;
use Scalar::Util 'blessed';
use File::Path 'make_path';
use Storable 'dclone';
use Test::Deep::NoTest 'eq_deeply';
use File::Copy 'copy';
use Parse::Deb::Control '0.03';
use File::chdir;
use Debian::Dpkg::Version 'version_compare';
use CPAN::Patches;
use File::Basename 'basename';

sub update_debian {
    my $self = shift;
    my $path = shift || '.';
    
    $self = $self->new()
        if not blessed $self;
    
    my $debian_path             = File::Spec->catdir($path, 'debian');
    my $debian_patches_path     = File::Spec->catdir($debian_path, 'patches');
    my $debian_control_filename = File::Spec->catdir($debian_path, 'control');
    croak 'debian/ folder not found'
        if not -d $debian_path;

    my $meta     = $self->read_meta($path);
    my $name     = $self->clean_meta_name($meta->{'name'}) or croak 'no name in meta';
    my $debian_data = $self->read_debian($name);
    my $deb_control = Parse::Deb::Control->new([$debian_control_filename]);
    
    die $name.' has disabled auto build'
        if $debian_data->{'No-Auto'};
    
    my @series = $self->get_patch_series($name);
    if (@series) {
        make_path($debian_patches_path)
            if not -d $debian_patches_path;
            
        foreach my $patch_filename (@series) {
            print 'copy ', $patch_filename,' to ', $debian_patches_path, "\n"
                if $self->verbose;
            copy($patch_filename, $debian_patches_path);
        }
        IO::Any->spew(
			[$debian_patches_path, 'series'],
			join(
				"\n",
				map { basename($_) } @series
			)."\n"
		);
    }

    # write new debian/rules
    IO::Any->spew(
        [$debian_path, 'rules'],
        "#!/usr/bin/make -f\n\n%:\n	"
        .($debian_data->{'X'} ? 'xvfb-run -a ' : '')
        .'dh '.(@series ? '--with quilt ': '').'$@'
        ."\n"
    );
    
    # update dependencies
    my $cpanp = CPAN::Patches->new;
    foreach my $dep_type ('Depends', 'Build-Depends', 'Build-Depends-Indep') {
        my $dep = {$cpanp->get_deb_package_names($deb_control, $dep_type)};
        my $new_dep = $cpanp->merge_debian_versions($dep, $debian_data->{$dep_type} || {});
        
        if ($debian_data->{'X'} and ($dep_type eq 'Build-Depends-Indep')) {
            $new_dep->{'xauth'} = '';
            $new_dep->{'xvfb'}  = '';
        }
        if (@series and ($dep_type eq 'Build-Depends-Indep')) {
            $new_dep->{'quilt'} = '';
        }
        
        # update if dependencies if needed
        if (not eq_deeply($dep, $new_dep)) {
            my ($control_key) = $deb_control->get_keys($dep_type =~ m/Build/ ? 'Source' : 'Package');
            next if not $control_key;
            
            my $new_value =
                ' '.(
                    join ', ',
                    map { $_.($new_dep->{$_} ? ' '.$new_dep->{$_} : '') }
                    sort
                    keys %{$new_dep}
                )."\n"
            ;
            $control_key->{'para'}->{$dep_type} = $new_value;
        }
    }
    IO::Any->spew([$debian_control_filename], $deb_control->control);
    
    if (my $app_name = $debian_data->{'App'}) {
        local $CWD = $debian_path;
        my $lib_name = 'lib'.$name.'-perl';
        system(q{perl -lane 's/}.$lib_name.q{/}.$app_name.q{/;print' -i *});
        foreach my $filename (glob($lib_name.'*')) {
            rename($filename, $app_name.substr($filename, 0-length($lib_name)));
        }
    }
    
    
    return;
}

sub cmd_update_debian {
	shift->update_debian();
}

sub merge_debian_versions {
    my $self = shift;
	my $versions1_orig = shift or die;
	my $versions2      = shift or die;
    
	my $versions1 = dclone $versions1_orig;
	
	while (my ($p, $v2) = each %{$versions2}) {
		if (exists $versions1->{$p}) {
			next if not $v2;
			my $v1 = $versions1->{$p} || '(>= 0)';
			if ($v1 !~ m/\(\s* >= \s* ([^\)]+?) \s*\)/xms) {
				warn 'invalid version '.$v1.' in conflic resolution';
				die;
				next;
			}
			my $v1n = $1;
			if ($v2 !~ m/\(\s* >= \s* ([^\)]+?) \s*\)/xms) {
				warn 'invalid version '.$v2.' in conflic resolution';
				die;
				next;
			}
			my $v2n = $1;

			# only when newer version is needed
			$versions1->{$p} = $v2
				if version_compare($v2n, $v1n) == 1;
		}
		else {
			$versions1->{$p} = $v2;
		}
	}
	
	return $versions1;    
}

sub get_deb_package_names {
    my $self    = shift;
    my $control = shift or croak 'pass control object';
    my $key     = shift or croak 'pass key name';
	
	return
		map {
			my ($p, $v) = split('\s+', $_, 2);
			$v ||= '';
			($p => $v)
		}
		grep { $_ }
		map { s/^\s*//;$_; }
		map { s/\s*$//;$_; }
		map { split(',', $_) }
		map { ${$_->{'value'}} }
		$control->get_keys($key)
	;
}

sub read_debian {
    my $self = shift;
    my $name = shift or croak 'pass name param';
    
    my $debian_filename  = File::Spec->catfile($self->patch_set_location, $name, 'debian');
    return {}
        if not -r $debian_filename;
    
    return $self->decode_debian([$debian_filename]);
}

sub decode_debian {
    my $self = shift;
    my $src  = shift or die 'pass source';
    
    my $cpanp = CPAN::Patches->new;
    my $deb_control = Parse::Deb::Control->new($src);
    my %depends             = $cpanp->get_deb_package_names($deb_control, 'Depends');
    my %build_depends       = $cpanp->get_deb_package_names($deb_control, 'Build-Depends');
    my %build_depends_indep = $cpanp->get_deb_package_names($deb_control, 'Build-Depends-Indep');
    my ($app) = 
        map { s/^\s*//;$_; }
		map { s/\s*$//;$_; }
		map { ${$_->{'value'}} }
		$deb_control->get_keys('App')
    ;
    my ($x_for_testing) = 
        map { s/^\s*//;$_; }
		map { s/\s*$//;$_; }
		map { ${$_->{'value'}} }
		$deb_control->get_keys('X')
    ;
    my ($no_auto) = 
        map { s/^\s*//;$_; }
		map { s/\s*$//;$_; }
		map { ${$_->{'value'}} }
		$deb_control->get_keys('No-Auto')
    ;

    
    return {
        'Depends'             => \%depends,
        'Build-Depends'       => \%build_depends,
        'Build-Depends-Indep' => \%build_depends_indep,
        (defined $app ? ('App' => $app) : ()),
        (defined $x_for_testing ? ('X' => $x_for_testing) : ()),
        (defined $no_auto ? ('No-Auto' => $no_auto) : ()),
    };
}

sub encode_debian {
    my $self = shift;
    my $data = shift;
    
    my $content = '';
    $content .= 'App: '.$data->{'App'}."\n"
        if exists $data->{'App'};
    
    foreach my $dep_type ('Build-Depends', 'Build-Depends-Indep', 'Depends') {
        next if (not $data->{$dep_type}) or (not keys %{$data->{$dep_type}});
        
        my $new_value = (
            join ', ',
            map { $_.($data->{$dep_type}->{$_} ? ' '.$data->{$dep_type}->{$_} : '') }
            sort
            keys %{$data->{$dep_type}}
        );
        $content .= $dep_type.': '.$new_value."\n";
    }

    $content .= 'No-Auto: '.$data->{'No-Auto'}."\n"
        if exists $data->{'No-Auto'};
    $content .= 'X: '.$data->{'X'}."\n"
        if exists $data->{'X'};
    
    return $content;
}

1;


__END__

1; # End of CPAN::Patches