#!/usr/bin/perl

use strict;
use File::Basename;
use Getopt::Long;
use CPAN;
use File::Path qw(mkpath);
use File::Copy;
use Parse::CPAN::Meta;
use Archive::Tar;
use File::Find;
use Module::Depends;
use Data::Dumper;

my $VERSION = '1.3.10';

my $MODULE_PREFIX = 'lib';
my $MODULE_SUFFIX = '-perl';

my $RULES = '/usr/share/cpan2deb/rules';

my $version = undef;
my $notest  = undef;
my $manual  = undef;
my $quilt   = undef;
my @authors = ();

sub usage {
    print STDERR "usage: " . basename($0) . " [-v] [-n] [-m] [-q] [-r <rules file>] [-a author] <module name | URL>\n";
    exit 1;
}
GetOptions(
    "version"  => \$version,
    "notest"   => \$notest,
    "manual"   => \$manual,
    "rules=s"  => \$RULES,  
    "quilt"    => \$quilt,
    "author=s" => \@authors,
    );
if ($version) {
    print STDERR basename($0) . " " . $VERSION . "\n";
    exit;
}
my ($MODULE) = @ARGV;
usage() if (! $MODULE);

my $pwd = $ENV{PWD};

my $MODULE_BASE;
if ($MODULE =~ m,^http://search.cpan.org/CPAN/authors/id/(.*)$,o) {
    $MODULE_BASE = $MODULE = $1;
}
my $mo = CPAN::Shell->expandany($MODULE);
if (! defined($mo)) {
    print STDERR "$MODULE missing\n";
    exit 1;
}
$mo->get();

my ($yml, $deps, $MODULE_DIR, $MODULE_NAME, $MODULE_ARC);
if (ref($mo) eq 'CPAN::Distribution') {
    $MODULE_ARC = $CPAN::Config->{keep_source_where} . '/authors/id/' . $MODULE;

    # override module name
    ($MODULE) = $mo->base_id =~ /^(.*)-[\d\.]*$/o;
    $MODULE =~ s/-/::/g;
} else {
    $MODULE_ARC = $CPAN::Config->{keep_source_where} . '/authors/id/' . $mo->cpan_file;
}
$MODULE_DIR = $CPAN::Config->{build_dir} . "/" . (fileparse($MODULE_ARC, qr/\.tar\.gz/o))[0];

# LEGACY...
chdir $pwd;

($yml, $deps, $MODULE_DIR, $MODULE_NAME) = parse_Meta($MODULE_DIR, $MODULE_ARC);
if (! $yml || ! $deps) {
    print STDERR "\033[1mCannot find ${MODULE}'s dependencies.\033[m\n";
    exit 1;
}

####################
# get architecture #
####################
my @xs;
find( sub { push @xs, $File::Find::name }, $MODULE_DIR);
@xs = grep {/\.xs$/o} @xs;
my $ARCHITECTURE = ($#xs >= 0) ? 'any' : 'all';

#####################
# make .orig.tar.gz #
#####################
if (! $yml->{name}) {
    print STDERR "\033[1mCannot find ${MODULE}'s name in META.\033[m\n";
    exit 1;
}
$yml->{name} =~ s/_/-/g;

my $base_dir = $MODULE_PREFIX . lc($yml->{name}) . $MODULE_SUFFIX . "-" . $yml->{version};
if ($yml->{name} =~ /^$MODULE_PREFIX.*$MODULE_SUFFIX/o) {
    $base_dir = lc($yml->{name}) . "-" . $yml->{version};
} elsif (lc($yml->{name}) =~ /^$MODULE_PREFIX/o) {
    $base_dir = lc($yml->{name}) . $MODULE_SUFFIX . "-" . $yml->{version};
}
my $upstream_dir = $base_dir . "/upstream/" ;

# LEGACY...
chdir $pwd;

if (! -d $upstream_dir) {
    eval { mkpath $upstream_dir; };
    if ($@) {
	print STDERRR $@;
	exit 1;
    }
}

copy($MODULE_ARC, $upstream_dir) or die $!;

my $orig_tar_gz_file = $MODULE_PREFIX . lc($yml->{name}) . $MODULE_SUFFIX . "_" . $yml->{version} . ".orig.tar.gz";
if ($yml->{name} =~ /^$MODULE_PREFIX.*$MODULE_SUFFIX/o) {
    $orig_tar_gz_file = lc($yml->{name}) . "_" . $yml->{version} . ".orig.tar.gz";
} elsif (lc($yml->{name}) =~ /^lib/o) {
    $orig_tar_gz_file = lc($yml->{name}) . $MODULE_SUFFIX . "_" . $yml->{version} . ".orig.tar.gz";
}

if (! -f $orig_tar_gz_file) {
    my $tar = Archive::Tar->new;
    my @files;
    find( sub { push @files, $File::Find::name }, $base_dir);
    $tar->add_files(@files);
    $tar->write($orig_tar_gz_file, 9);
}

###############
# run dh_make #
###############
my $MODULE_FILENAME = $MODULE_PREFIX . lc($yml->{name}) . $MODULE_SUFFIX;
if ($yml->{name} =~ /^$MODULE_PREFIX.*$MODULE_SUFFIX/o) {
    $MODULE_FILENAME = lc($yml->{name});
} elsif (lc($yml->{name}) =~ /^lib/o) {
    $MODULE_FILENAME = lc($yml->{name}) . $MODULE_SUFFIX;
}
my $MODULE_VERSION = $yml->{version};
my $MODULE_MAKE;
my $MODULE_BUILD;
my $MODULE_INSTALL;
my $MANUAL_INSTALL = undef;
if ($yml->{generated_by} =~ /Module::Build/o || exists $yml->{build_requires}->{'Module::Build'}) {
    $MODULE_MAKE    = 'Build.PL --prefix /usr --bindoc /usr/share --libdoc /usr/share --installdirs vendor';
    if ($notest) {
	$MODULE_BUILD   = '(cd $(BUILDDIR); ./Build)';
    } else {
	$MODULE_BUILD   = '(cd $(BUILDDIR); ./Build; ./Build test)';
    }
    $MODULE_INSTALL = '(cd $(BUILDDIR); ./Build install --installdirs vendor --destdir $(CURDIR)/debian/$(PACKAGE))';
} else {
    $MODULE_MAKE    = 'Makefile.PL installdirs=vendor';
    if ($notest) {
	$MODULE_BUILD   = '$(MAKE) -C $(BUILDDIR)';
    } else {
	$MODULE_BUILD   = '$(MAKE) -C $(BUILDDIR); $(MAKE) -C $(BUILDDIR) test';
    }
    $MODULE_INSTALL = '$(MAKE) -C $(BUILDDIR) install DESTDIR=$(CURDIR)/debian/$(PACKAGE) INSTALLDIRS=vendor';
}
if ($manual) {
    $MANUAL_INSTALL  = "\t" . 'mkdir -p $(CURDIR)/debian/$(PACKAGE)-man/usr/share; ';
    $MANUAL_INSTALL .= 'mv $(CURDIR)/debian/$(PACKAGE)/usr/share/man $(CURDIR)/debian/$(PACKAGE)-man/usr/share';
}

# Check distribution type and description
my $distribution_type = $yml->{distribution_type};
if (! $distribution_type || $distribution_type eq 'unknown') {
    $distribution_type = 'module';
}
if (! $yml->{abstract} || $yml->{abstract} eq 'unknown') {
    $yml->{abstract} = "$MODULE perl $distribution_type";
}

chdir $base_dir;
my @licenses = qw(gpl lgpl artistic bsd);
my $license = $yml->{license} eq 'perl' ? 'artistic' : $yml->{license};

if (! grep /$license/, @licenses) {
    $license = 'artistic';
}

system "yes | dh_make -s -c \"$license\" -f ../$orig_tar_gz_file";

my @rm_files = qw(
README.Debian
README.source
cron.d.ex
dirs
docs
emacsen-install.ex
emacsen-remove.ex
emacsen-startup.ex
init.d.ex
init.d.lsb.ex
manpage.1.ex
manpage.sgml.ex
manpage.xml.ex
menu.ex
postinst.ex
postrm.ex
preinst.ex
prerm.ex
watch.ex
);
foreach my $rm_file (@rm_files) {
    unlink "debian/" . $rm_file;
}
unlink "debian/$MODULE_FILENAME-default.ex";
unlink "debian/$MODULE_FILENAME.default.ex";
unlink "debian/$MODULE_FILENAME.doc-base.EX";

################
# change rules #
################
chdir $pwd;
open(my $fd, $RULES) || die $!;
my @buffer = <$fd>;
close($fd);
foreach my $line (@buffer) {
    $line =~ s/__PREFIX__/$MODULE_PREFIX/g;
    $line =~ s/__SUFFIX__/$MODULE_SUFFIX/g;
    $line =~ s/__MODULE__/$MODULE_NAME/g;

    $line =~ s/__MODULE_MAKE__/$MODULE_MAKE/g;
    $line =~ s/__MODULE_BUILD__/$MODULE_BUILD/g;
    $line =~ s/__MODULE_INSTALL__/$MODULE_INSTALL/g;
    $line =~ s/__MANUAL_INSTALL__/$MANUAL_INSTALL/g;
}
my $buffer = join('', @buffer);
if ($ARCHITECTURE eq 'all') {
    $buffer =~ s/(\# Build architecture-)in(dependent files here.\nbinary-)indep(: build install\n\# We have nothing to do by default.)/$1$2arch$3/so;
    $buffer =~ s/(\# Build architecture-)(dependent files here.\nbinary-)arch(: build install)\n\tdh_testdir/$1in$2indep$3/so;
}

open(my $fd, '>', $base_dir . "/debian/rules");
print $fd $buffer;
close($fd);

####################
# modify changelog #
####################
open(my $fd, $base_dir . "/debian/changelog");
my @buffer = <$fd>;
close($fd);

my $codename = (split(/:/, `lsb_release -c`))[1];
$codename =~ s/\s+//g;

foreach my $line (@buffer) {
    $line =~ s/^$MODULE_FILENAME \($yml->{version}-1\) unstable/$MODULE_FILENAME ($yml->{version}-0ubuntu1) $codename/;
    $line =~ s/(Initial release).*/$1/;
}
my $buffer = join('', @buffer);

open(my $fd, '>', $base_dir . "/debian/changelog");
print $fd $buffer;
close($fd);

########################
# create source/format #
########################
mkdir $base_dir . '/debian/source', 0755;
open(my $fd, '>', $base_dir . "/debian/source/format");
if ($quilt) {
    print $fd "3.0 (quilt)\n";
} else {
    print $fd "1.0\n";
}
close($fd);

##################
# change control #
##################
my $Build_Depends = ();
if ($deps->{build_requires}) {
    $Build_Depends = $deps->{build_requires};
} elsif ($deps->build_requires) {
    $Build_Depends = $deps->build_requires;
}
$Build_Depends = lex_depends($Build_Depends);
warn "Build-Depends: " . $Build_Depends . "\n" if $Build_Depends;

my $Depends = ();
if ($deps->{requires}) {
    $Depends = $deps->{requires};
} elsif ($deps->requires) {
    $Depends = $deps->requires;
}
$Depends = lex_depends($Depends);

if ($yml->{recommends}) {
    if (my $rec = lex_depends($yml->{recommends})) {
	my $Recommends = 'Recommends: ' . $rec;
	$Depends .= "\n" . $Recommends;
    }
}

open(my $fd, $base_dir . "/debian/control") || die $!;
my @buffer = <$fd>;
close($fd);

my $tmp_depends = $ARCHITECTURE eq 'any'
    ? "\${perl:Depends}, \${shlibs:Depends}, \${misc:Depends}, $Depends"
    : "\${perl:Depends}, \${misc:Depends}, $Depends";
$tmp_depends =~ s/, $//;
$tmp_depends =~ s/, \n/\n/s;
warn "Depends: " . $tmp_depends . "\n";
foreach my $lines (@buffer) {
    $lines =~ s/^(Section): unknown/$1: perl/;
    $lines =~ s/^(Build-Depends: .*)$/$1, $Build_Depends/ if $Build_Depends;
    $lines =~ s/^(Architecture): .*$/$1: $ARCHITECTURE/;
    $lines =~ s/^(Depends): .*$/$1: $tmp_depends/;
    $lines =~ s/^(Description): .*$/$1: $yml->{abstract}/;
    $lines =~ s/^ <insert long description, indented with spaces>/ This package provides $MODULE perl $distribution_type./;
}
my $buffer = join('', @buffer);
if ($yml->{resources}->{homepage}) {
    $buffer =~ s/(Homepage): <insert the upstream URL, if relevant>/$1: $yml->{resources}->{homepage}/;
} else {
    $buffer =~ s/Homepage: <insert the upstream URL, if relevant>\n//;
}
if ($manual) {
    $buffer .= <<EOF;

Package: ${MODULE_FILENAME}-man
Architecture: all
Depends: man
Description: Manual of $MODULE_NAME
 This package provides $MODULE_NAME perldoc manual.
EOF
;
}

open(my $fd, '>', $base_dir . "/debian/control");
print $fd $buffer;
close($fd);

####################
# change copyright #
####################
open(my $fd, $base_dir . "/debian/copyright") || die $!;
my @buffer = <$fd>;
close($fd);

my $dl_file;
if (ref($mo) eq 'CPAN::Distribution') {
    $dl_file = 'http://search.cpan.org/CPAN/authors/id/' . $MODULE_BASE;
} else {
    $dl_file = (fileparse('http://search.cpan.org/CPAN/authors/id/' . $mo->cpan_file))[1];
}
my @resources = ();
foreach my $key (keys %{$yml->{resources}}) {
    push @resources, "$key $yml->{resources}->{$key}";
}
my $resources = join("\n", @resources);
foreach my $lines (@buffer) {
    if ($resources) {
	$lines =~ s,<(url://example.com|fill in ftp site)>,<$dl_file>\n\n$resources,;
    } else {
	$lines =~ s,<(url://example.com|fill in ftp site)>,<$dl_file>,;
    }
}
my $buffer = join('', @buffer);
my $authors = ref($yml->{author}) eq 'ARRAY' ? join("\n    ", @{$yml->{author}}) : $yml->{author};
if ($#authors >= 0) {
    $authors = join("\n    ", @authors);
}
if ($authors && $authors ne 'unknown') {
    $buffer =~ s/<put author(\'s|\(s\)) name and email here>(.*?<likewise for another author>)?/$authors/s;
    $buffer =~ s/Copyright:\s*\n\n\s+?<Copyright \(C\) YYYY Name OfAuthor>.*?<likewise for another author>\n\n//s;
} else {
    warn "\033[1mAuthors is not defined.\033[m\n";
}
$buffer =~ s/\n\# Please also look if there.*$//s;
open(my $fd, '>', $base_dir . "/debian/copyright");
print $fd $buffer;
close($fd);

############################################################

sub parse_Meta {
    my ($module_dir, $module_arc) = @_;

    my $MODULE_YAML = $module_dir . "/META.yml";
    my $MODULE_JSON = $module_dir . "/META.json";
    my $module_name = (fileparse($module_arc, qr/-\d+.*?\.tar\.gz/o))[0];

    $module_name =~ s/-/::/g;
    if ($module_name eq 'perl') {
	die "\033[1m$MODULE is bundled.\033[m\n";
    }

    # Read META
    my $yml;
    my $deps;
    my $meta = (-f $MODULE_YAML) ? $MODULE_YAML : $MODULE_JSON;
    my $r = eval { $yml = Parse::CPAN::Meta->load_file($meta); };
    if ($r) {
	print Dumper $yml;

	$deps = Module::Depends->new->dist_dir($module_dir)->find_modules;
    } else {
	# build_dir に META があるかもしれないので試す

	my @ymls;
	find( sub { push @ymls, $File::Find::name }, $CPAN::Config->{build_dir});
	my $module_tmp = fileparse($module_arc, qr/\.tar\.gz|\.tgz/o);
	@ymls = sort grep {/${module_tmp}(-.*\.(yml|json))?$/o} @ymls;
	if ($#ymls < 0) {
	    print STDERR "\033[1mCannot find ${MODULE}'s YAML or JSON\033[m\n";
	    exit 1;
	}
	$module_dir = $ymls[0];
	$module_dir =~ s/META\.(yml|json)$//;

	($yml, $deps, $module_dir, $module_name) = parse_Meta($module_dir, $module_arc);
	($yml, $deps) = parse_Makefile($module_dir) unless $yml;
    }
    ($yml, $deps, $module_dir, $module_name);
}

sub parse_Makefile {
    # Module::Install 対応 XXX FIX ME

    my $module_dir = shift;
    my $yaml;

    if (-f $module_dir . "/Makefile.PL") {
	open(my $fd, $module_dir . "/Makefile.PL");
	my @buffer = map {chomp; $_} <$fd>;
	close($fd);

	my @yaml_keys = qw(name author license);
	if (grep {/inc::Module::Install/o} @buffer) {
	    $yaml->{version} = $mo->cpan_version;
	    $yaml->{abstract} = $mo->description;
	    $yaml->{distribution_type} = 'module';

	    foreach (@buffer) {
		foreach my $key (@yaml_keys) {
		    if (/^$key.*?'(.*?)'/o) {
			$yaml->{$key} = $1;
			last;
		    }
		}

		if (/^(build_depends|test_requires).*?'(.*?)'.*?(=>.*?(.*))?;/o) {
		    my ($mod, $ver) = ($1, $3);
		    $ver = 0 if ($ver !~ /\d/o);
		    $deps->{build_requires} = {$mod => $ver};
		} else {
		    $deps->{build_requires} = {};
		}
		if (/^requires.*?'(.*?)'.*?(=>.*?(.*))?;/o) {
		    my ($mod, $ver) = ($1, $3);
		    $ver = 0 if ($ver !~ /\d/o);
		    $deps->{requires} = {$mod => $ver};
		} else {
		    $deps->{requires} = {};
		}
	    }
	}
    }
    ($yaml, $deps);
}

sub lex_depends {
    my $Depends = shift;

    my %Depends = ();
    foreach my $module (sort keys %$Depends) {
	my $mod = $module;
	if ($mod ne 'perl') {
	    my $is_core = `corelist $module`;
	    next if ($is_core !~ /not in CORE/o);

	    my $file = CPAN::Shell->expand("Module", $mod)->cpan_file;
	    $file = basename($file);
	    $file =~ s/-\d+.*?\.tar\.gz$//;
	    $file =~ s/_//g;

	    if ($file ne 'perl') {
		if ($file !~ /^$MODULE_PREFIX/o) {
		    $mod = $MODULE_PREFIX . lc($file);
		} else {
		    $mod = lc($file);
		}
		if ($MODULE_SUFFIX && $file !~ /$MODULE_SUFFIX$/o) {
		    $mod .= $MODULE_SUFFIX;
		}

		my $class = $file;
		$class =~ s/^$MODULE_PREFIX//;
		$class =~ s/$MODULE_SUFFIX$//;
		$class =~ s/-/::/g;
		if ($module ne $class && $Depends->{$module}) {
		    warn "\033[1mCheck $module version - $file\033[m\n";
		}

		if ($Depends->{$module}) {
		    $Depends{$mod} = "(>= $Depends->{$module})";
		} else {
		    $Depends{$mod} ||= undef;
		}
	    }
	} else {
	    if ($Depends->{$module}) {
		# ad hoc: perl version to human readable
		if (my @ver = $Depends->{$module} =~ /(\d+)\.(\d{3})(\d{3})?$/o) {
		    $Depends->{$module} = join('.', map {s/^0+(\d+)$/$1/; $_ ||= 0} @ver);
		}
		$Depends{$mod} = "(>= $Depends->{$module})";
	    } else {
		$Depends{$mod} ||= undef;
	    }
	}
    }

    my @Depends = ();
    foreach my $mod (keys %Depends) {
	my $d = $mod;
	if ($Depends{$mod}) {
	    $d .= " $Depends{$mod}";
	}

	push @Depends, $d;
    }
    $Depends = join(", ", @Depends);
    $Depends;
}