plugins/new.pl

#!/usr/bin/env perl
use v5.16;
use strict;
use warnings FATAL => 'all';
use FindBin;
use lib "$FindBin::Bin";
use mplib::config qw($CFG);
use mplib::util qw(fail note ok strip_flag_value);
use mplib::resolve qw(init find_portdir);
use mplib::portformat qw(resolve_port);
use mplib::portlint qw(lint_port);
 
# scaffolds a new port: asks (interactively, or via flags for scripting)
# just enough to pick the right classes/*.mp shape and write a correct
# pkg.conf -- --depth 1, CFLAGS/LDFLAGS forwarding, and a del.sh pattern
# that actually matches the build system are all baked into the CLASSES
# already (classes/cmake.mp, meson.mp, autotools.mp, ...), so a class-
# based port needs no add.sh/del.sh at all, just pkg_fetch= + inherit=.
# that's the whole point: fewer hand-written lines is fewer chances to
# reproduce one of the bugs mplib::portlint knows about.
#
# usage: mp new <category>/<name>
#            [--class=autotools|cmake|meson|configure-make|plain-make|bootstrap-make|custom]
#            [--url=<git-or-tarball-url>] [--license=<id>] [--tags=<tags>]
#            [--deps=<extra deps>] [--bin=<resulting binary name>] [--yes]
#            [--dir=<root>]
# any omitted value not given via flag is prompted for on STDIN; --yes
# accepts every default without prompting (for scripting/testing). --dir=
# writes <root>/<category>/<name> instead of the first configured repo's
# ports dir, and searches <root> the same way CUSTOM_PORTS_DIR already
# is (first, ahead of every configured repo) for the pre-existing-port
# collision check just below -- so a port scaffolded under --dir= is
# immediately findable by mp lint/devtest/depcheck/fetchcheck given the
# identical --dir=<root>, without needing to add it to any repo at all
# (drafting a port before deciding where it ultimately belongs).
 
my $flags = mplib::config::parse_flags(\@ARGV);
mplib::config::load($flags);
my $dir = strip_flag_value(\@ARGV, 'dir');
$CFG->{CUSTOM_PORTS} = $dir if defined $dir;
init();
 
my %opt;
for(my $i = 0; $i < @ARGV; $i = $i + 1)
{
	next unless $ARGV[$i] =~ /^--(class|url|license|tags|deps|bin)=(.*)$/;
	$opt{$1} = $2;
	splice(@ARGV, $i, 1);
	$i = $i - 1;
}
my $yes = 0;
for(my $i = 0; $i < @ARGV; $i = $i + 1)
{
	next unless $ARGV[$i] eq '--yes';
	$yes = 1;
	splice(@ARGV, $i, 1);
	$i = $i - 1;
}
 
fail("usage: mp new <category>/<name> [--class=...] [--url=...] [--license=...] [--yes] [--dir=<root>]")
    unless defined $ARGV[0];
my $target = $ARGV[0];
fail("expected <category>/<name>, e.g. \"editors/foo\"") unless $target =~ m{^([a-z0-9][a-z0-9-]*)/([a-z0-9][a-z0-9._-]*)$};
my ($cat, $name) = ($1, $2);
fail("$target already exists (find_portdir found it)") if find_portdir($name);
 
my @CLASSES = qw(autotools cmake meson configure-make plain-make bootstrap-make custom);
my %CLASS_HAS_UNINSTALL_RISK = map { $_ => 1 } qw(configure-make plain-make bootstrap-make);
 
sub prompt {
	my ($msg, $default) = @_;
	return $default if $yes;
	print STDERR $msg . (defined $default && $default ne '' ? " [$default]" : '') . ': ';
	my $line = <STDIN>;
	return $default unless defined $line;
	chomp $line;
	return $line eq '' ? $default : $line;
}
 
my $class = $opt{class};
unless(defined $class)
{
	print STDERR "which build system? (" . join('/', @CLASSES) . ")\n";
	print STDERR "  autotools       -- ./configure comes from configure.ac, needs autoreconf first\n";
	print STDERR "  configure-make  -- a ./configure script is already checked in\n";
	print STDERR "  cmake / meson   -- as named\n";
	print STDERR "  plain-make      -- just \"make\", no configure step at all\n";
	print STDERR "  bootstrap-make  -- a ./bootstrap script generates configure\n";
	print STDERR "  custom          -- none of the above; writes an add.sh/del.sh scaffold instead\n";
	$class = prompt('class', 'autotools');
}
fail("unknown class \"$class\" (expected one of: @CLASSES)") unless grep { $_ eq $class } @CLASSES;
 
my $url = $opt{url};
$url = prompt('fetch url (git:// or a git host https url; a .tar.gz/.tar.xz/etc url for a tarball release)', '')
    unless defined $url;
fail('a fetch url is required') unless defined $url && $url ne '';
 
my $license = $opt{license};
$license = prompt('license (spdx-ish id, e.g. mit/gpl-3.0/isc)', 'TODO') unless defined $license;
 
my $tags = $opt{tags};
$tags = prompt('pkg_tags (space-separated virtual-dep tags this port provides, blank for none)', '')
    unless defined $tags;
 
my %CLASS_DEPS = (
	cmake  => 'cmake', meson => '%meson %ninja %pkg-config',
	'bootstrap-make' => 'gnu-autoconf gnu-automake gnu-libtool',
	autotools => 'gnu-autoconf gnu-automake gnu-libtool',
);
my $deps = $opt{deps};
$deps = prompt('extra pkg_deps (beyond what the class already declares), blank for none', '')
    unless defined $deps;
 
my $is_tarball = $url =~ /\.tar\.(gz|bz2|xz|lz)$/;
my $ver = $is_tarball ? prompt('pkg_ver (this fetches a fixed tarball, not a git checkout -- pin the real version)', 'TODO') : 'git';
 
my $root = defined $dir ? $dir : $CFG->{REPOS}[0]{ports};
my $portdir = "$root/$cat/$name";
fail("$portdir already exists") if -e $portdir;
mkdir $root unless -d $root;
mkdir "$root/$cat" unless -d "$root/$cat";
mkdir $portdir or fail("mkdir $portdir: $!");
 
my @lines;
push @lines, "pkg_name=\"$name\"\n";
push @lines, "pkg_license=\"$license\"\n";
push @lines, "pkg_ver=\"$ver\"\n";
push @lines, "pkg_tags=\"$tags\"\n" if $tags ne '';
push @lines, "pkg_pref=\"50\"\n" if $tags ne '';
push @lines, "pkg_deps=\"$deps\"\n" if $deps ne '';
 
if($class ne 'custom')
{
	my $fetchspec = $is_tarball
	    ? do { my ($url_dir) = $url =~ m{([^/]+)\.tar\.}; "tar:$url,$url_dir" }
	    : "git:$url";
	push @lines, "pkg_fetch=\"$fetchspec\"\n";
	push @lines, "\ninherit=\"$class\"\n";
	if($CLASS_HAS_UNINSTALL_RISK{$class})
	{
		my $bin = $opt{bin};
		$bin = prompt('resulting binary name (blank to just trust "make uninstall" -- '
		    . 'risky, many hand-written Makefiles have no uninstall target at all)', '')
		    unless defined $bin;
		if($bin ne '')
		{
			push @lines, "\n# overrides just the class's own \"make uninstall\" remove phase --\n";
			push @lines, "# $class can't promise upstream's Makefile has a real uninstall target.\n";
			push @lines, "remove:\n";
			push @lines, "\trm -f \$MP_PREFIX/bin/$bin\n";
			push @lines, "\trm -rf $name\n";
		}
		else
		{
			note('kept "make uninstall" -- run mp lint on this port before relying on it');
		}
	}
}
 
open(my $fh, '>', "$portdir/pkg.conf") or fail("write $portdir/pkg.conf: $!");
print $fh @lines;
close($fh);
 
if($class eq 'custom')
{
	# always rename the checkout to $name right after fetching it,
	# regardless of git vs tarball -- lets every line after this (cd,
	# the final rm -rf) use the literal port name with zero
	# basename-guessing, instead of two DIFFERENT derivations (one for
	# add.sh's "cd", a separate one for del.sh's "rm -rf") that can
	# silently drift apart, exactly the class of bug this whole tool
	# exists to stop a hand-written port from shipping.
	open(my $afh, '>', "$portdir/add.sh") or fail("write $portdir/add.sh: $!");
	print $afh "set -e\n\n";
	if($is_tarball)
	{
		my ($archive) = $url =~ m{([^/]+)$};
		$archive ||= 'archive.tar';
		print $afh "curl -LO $url\n";
		print $afh "tar xf $archive\n";
		print $afh "# TODO: confirm this matches the tarball's real top-level dir name\n";
		print $afh "# (usually the archive name minus its .tar.* suffix, not guaranteed).\n";
		my ($guess) = $archive =~ /^(.*)\.tar\.\w+$/;
		print $afh "mv " . ($guess || $archive) . " $name\n";
		print $afh "rm -f $archive\n";
	}
	else
	{
		# an explicit destdir, always -- so it's always literally $name,
		# never a derived guess that could drift from what del.sh assumes.
		print $afh "git clone --depth 1 $url $name\n";
	}
	print $afh "cd $name\n";
	print $afh "./configure --prefix=\$MP_PREFIX\n";
	print $afh "make -j\$MP_JOBS CFLAGS=\"\$CFLAGS\" LDFLAGS=\"\$LDFLAGS\"\n";
	print $afh "make install\n";
	print $afh "make clean || true\n";
	close($afh);
 
	open(my $dfh, '>', "$portdir/del.sh") or fail("write $portdir/del.sh: $!");
	print $dfh "set -e\n\n";
	print $dfh "# TODO: \"make uninstall\" only works if upstream's Makefile really\n";
	print $dfh "# defines that target -- many hand-written ones don't (mp lint will\n";
	print $dfh "# flag this at [low]; replace with explicit rm -f lines if it doesn't).\n";
	print $dfh "cd $name\n";
	print $dfh "make uninstall\n";
	print $dfh "cd ..\n";
	print $dfh "rm -rf $name\n";
	close($dfh);
	chmod 0644, "$portdir/add.sh", "$portdir/del.sh";
}
 
ok("wrote $portdir");
 
my $pc = resolve_port($portdir);
if($pc)
{
	my @findings = lint_port($pc, $name);
	if(@findings)
	{
		print STDERR "mp lint found something worth a look before you build this:\n";
		print STDERR "  [$_->{severity}] $_->{msg}\n" for @findings;
	}
	else
	{
		ok('mp lint: clean');
	}
}
print STDERR "next: mp devtest $cat/$name\n";