#!/usr/bin/perl

=head1 NAME

dh-make-pm - build Debian packages (dh-make-perl on pbuilder+cowdancer  steroids)

=head1 SYNOPSIS

	dh-make-pm --cpan Debian::Apt::PM
	
		--cpan          which module to build
		--no-retry      will skip packaging modules that already failed to package
		--dh-make-perl  set different command to execute instead of dh-make-perl to create debian/ folder.

=head1 DESCRIPTION

F<dh-make-pm> is basicaly recursive F<dh-make-perl> that will build the
deb package from CPAN distribution and all it's dependecies properly
indexing and creating repository.

=head1 USAGE

=head1 pbuilder set-up

	# execute
	sudo apt-get install cowdancer
	cowbuilder --create --distribution sid
	echo "dh-make-pm" > /var/cache/pbuilder/base.cow/etc/debian_chroot

	# add to /etc/pbuilderrc
	MIRRORSITE=http://ftp.cz.debian.org/debian/
	BINDMOUNTS="/var/cache/pbuilder/result"
	PDEBUILD_PBUILDER=cowbuilder
	
	mkdir /var/cache/pbuilder/result/unstable
	wget http://bratislava.pm.org/tutorial/debian-simple-repo/Makefile -O /var/cache/pbuilder/result/Makefile
	wget http://bratislava.pm.org/tutorial/debian-simple-repo/Release.conf -O /var/cache/pbuilder/result/Release.conf
	
	vim /var/cache/pbuilder/base.cow/etc/apt/sources.list    # update to your taste
	echo "deb file:///var/cache/pbuilder/result/ unstable/" >> /var/cache/pbuilder/base.cow/etc/apt/sources.list
	echo "deb file:///var/cache/pbuilder/result/ unstable/" >> /etc/apt/sources.list

	# generate a key without passphrase
	gpg --gen-key
	gpg --export --armor $KEYID
	apt-key add -
	chroot /var/cache/pbuilder/base.cow/
	apt-key add -
	exit

	cd /var/cache/pbuilder/result/
	make

	cowbuilder --update --bindmounts /var/cache/pbuilder/result/
	
	cpan -i Debian::Apt::PM
	
	# patch DhMakePerl.pm
	cd /usr/share/perl5/
	patch -p1 < $DIST_ROOT/patch/DhMakePerl.pm.patch

=head1 create deb files

	dh-make-pm --cpan Debian::Apt::PM
	dh-make-pm --cpan Tatsumaki

=head1 when something goes wrong

I most cases when there is a missing or wrong dependency then the .deb
build will fail.

	cd $HOME/.dh-make-pm/build/$TAR_BALL_FOLDER/
	vim debian/control
	# set correct dependencies
	pdebuild
	mv /var/cache/pbuilder/result/*-perl* /var/cache/pbuilder/result/unstable/
	cd /var/cache/pbuilder/result
	make
	dh-make-pm --cpan $THE_MODULE_YOU_WANTED_TO_BUILD

=cut


use strict;
use warnings;

use 5.010;

use Getopt::Long;
use Pod::Usage;
use File::HomeDir;
use File::Path 2.01 'make_path', 'remove_tree';
use CPAN;
use File::Basename 'basename';
use File::Copy 'copy';
use JSON::Util;
use Debian::Apt::PM::SPc;

use Debian::Apt::PM;
our $aptpm = Debian::Apt::PM->new();

exit main();

sub main {
	my $help;
	my $module_name;
	my $repository_folder = '/var/cache/pbuilder/result';
	my $build_folder      = File::Spec->catdir(File::HomeDir->my_home, '.dh-make-pm', 'build');
	my $no_build_retry    = 0;
	my $dh_make_perl      = 'dh-make-perl';
	my $no_cpan_patches   = 0;
	GetOptions(
		'help|h'  => \$help,
		'cpan=s'  => \$module_name,
		'repo=s'  => \$repository_folder,
		'build=s' => \$build_folder,
		'no-retry' => \$no_build_retry,
		'dh-make-perl=s' => \$dh_make_perl,
		'no-cpan-patches' => \$no_cpan_patches,
	) or pod2usage;
	pod2usage if $help;
	pod2usage if not $module_name;

	my ($deb_in_root_of_repo) = </var/cache/pbuilder/result/*.deb>;
	die $deb_in_root_of_repo.' left unsorted'
		if $deb_in_root_of_repo;
	
	die $repository_folder.' folder does not exists'
		if not -d $repository_folder;
	die $build_folder.' folder does not exists'
		if not -d $build_folder;
	
	my $build_history_filename = Debian::Apt::PM::SPc->sharedstatedir.'/dh-make-pm/build-history.json';
	JSON::Util->encode({}, [$build_history_filename])
		if not -f $build_history_filename;
	my %build_history = %{JSON::Util->decode([$build_history_filename])};
	
	my %all_prereq;
	my @to_make = ($module_name);

	# update Perl indexes
	system('apt-pm', 'update') and die $!;

	my $i = 0;
	while (@to_make > $i) {
		my %prereq = find_prereq($to_make[$i++]);
		foreach my $new_req (keys %prereq) {
			if (not $all_prereq{$new_req}) {
				$all_prereq{$new_req} = 1;
				push @to_make, $new_req;
			}
		}
		die 'too many pre requisities ('.join(',', @to_make).') for '.$module_name.' giving up'
			if (@to_make > 100);
	}
	
	print STDERR 'going to build deb from ', join(', ', @to_make), "\n";

	while (my $build = pop @to_make) {
		chdir(File::Spec->catdir($build_folder, '..'));
		
		# clean-up build directory
		remove_tree( $build_folder, {keep_root => 1} );

		my $dist = CPAN::Shell->expand('Module', $build)->distribution;
		my $meta = $dist->parse_meta_yml;
		my ($dist_folder, $dist_tarball) = $dist->run_preps_on_packagedir;

		copy($dist_tarball, $build_folder) or die "Copy failed: $!";;
		$dist_tarball = basename($dist_tarball);
		
		# don't retry to build a tarball that failed build before
		die $dist_tarball.' previous build failed'
			if ($no_build_retry and $build_history{$dist_tarball}->{'fail'});

		# refresh the repository
		system('sudo', 'cowbuilder', '--update', '--bindmounts', '/var/cache/pbuilder/result/') and die $!;
				
		# mark current tarball as fail
		$build_history{$dist_tarball}->{'fail'} = time();
		JSON::Util->encode(\%build_history, [$build_history_filename], { 'atomic' => 1 });
		
		chdir($build_folder) or die $!;

		extract_dist_tarball($dist_tarball);
		
		my ($folder) = grep { -d $_ } <*>;
		die 'distribution '.$dist_tarball.' folder not found'
			if not $folder;
		
		rename($folder, $folder.'.orig');
		extract_dist_tarball($dist_tarball);
		
		chdir($folder);
		system($dh_make_perl) and die $!;
		if (not $no_cpan_patches) {
			system('cpan-patches', 'update-debian') and die $!;
		}
		
		my $changes_file = IO::Any->slurp('debian/changelog');
		die 'failed to parse package name and version from debian/changelog'
			if $changes_file !~ m/\A([-a-z0-9]+) \s+ \(([^)]+)\)/xms;
		my ($package_name, $package_version) = ($1, $2);
		chdir('..');
		my $debian_folder = $package_name.'-'.$package_version;
		$debian_folder =~ s/-[^-]+$//xms;    # strip debian packaging version
		my $debian_filename = $package_name.'_'.$package_version;
		$debian_filename =~ s/-[^-]+$//xms;    # strip debian packaging version
		die 'ups' if $folder eq $debian_folder;     # should never happend but if than better die
		rename($folder.'.orig', $debian_folder);
		system('tar', 'cvzf',  $debian_filename.'.orig.tar.gz', $debian_folder);
		rename($debian_folder, $debian_folder.'.orig');
		rename($folder, $debian_folder);
		system('diff -Naur '.$debian_folder.'.orig '.$debian_folder.' | gzip -9 > '.$package_name.'_'.$package_version.'.diff.gz');
		remove_tree($debian_folder.'.orig');

		chdir($debian_folder);
		eval {
			local $SIG{ALRM} = sub { die "alarm" };
			alarm(30*60);
			system('pdebuild', '--pbuilder', 'cowbuilder') and die $!;		
			alarm(0);
		};
		
		my ($generated_deb) = </var/cache/pbuilder/result/*.deb>;
		die $dist_tarball.' deb build failed'
			if not $generated_deb;
		die 'is '.$generated_deb.' deb archive?'
			if $generated_deb !~ m{^ ([^_]+) _ [^/]+ $}xms;
		my $deb_basename = $1;
		
		system('mv', glob($deb_basename.'*'), '/var/cache/pbuilder/result/unstable') and die $!;

		# mark current tarball as pass
		delete $build_history{$dist_tarball}->{'fail'};
		$build_history{$dist_tarball}->{'pass'} = time();
		JSON::Util->encode(\%build_history, [$build_history_filename], { 'atomic' => 1 });

		# refresh repository and apt-pm index
		chdir($repository_folder);
		system('make', 'all') and die $!;
		system('apt-pm', 'update') and die $!;
	}
	
	
	return 0;
}

sub find_prereq {
	my $module_name = shift;
	
	return if $module_name ~~ ['perl'];
	
	my $dist = CPAN::Shell->expand('Module', $module_name);
	$dist = $dist->distribution
		if $dist;
	die $module_name.' not found'
		if not $dist;
	
	$dist->get;
	my $meta = $dist->parse_meta_yml;
	my %prereq = map { %{$meta->{$_} || {}} } qw(requires build_requires configure_requires recommends);

    my @debs;
    my @build_dep;
    while (my($need_module, $need_version) = each %prereq) {
		# ignore Perl version requires, no clue how to handle
		if ($need_module ~~ ['perl']) {
			delete $prereq{$need_module};
			next;
		};
		
        my $debs = $aptpm->find($need_module, $need_version);
		delete $prereq{$need_module}
        	if ($debs and $debs->{'min'});
    }
    
    return %prereq;
}

sub extract_dist_tarball {
	my $dist_tarball = shift or die;
	given ($dist_tarball) {
		when (/(\.tar\.gz|\.tgz)$/) {
			system('tar', 'xvzf', $dist_tarball);
		}
		when (/\.tar\.bz2$/) {
			system('tar', 'xvjf', $dist_tarball);
		}
		when (/\.zip$/) {
			system('unzip', $dist_tarball);
		}
		default {
			die 'unsupported dist format - '.$dist_tarball;
		}
	}
}
