Add lua fatpacker

2016-08-28 21:03:37 +02:00 · 2016-08-28 21:03:37 +02:00 · 3876867418
commit 3876867418
1 changed files with 168 additions and 0 deletions
--- a/src/fatpack.pl
+++ b/src/fatpack.pl
@ -0,0 +1,168 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use Getopt::Long;
+use File::Basename qw/dirname basename/;
+use Storable qw/dclone/;
+use Data::Compare;
+use Data::Dumper;
+
+my $outdir;
+my $truncate = '';
+my $inputfile;
+my $usage='';
+
+GetOptions('output=s' => \$outdir, 'truncate' => \$truncate, 'input=s' => \$inputfile, 'help' => \$usage);
+
+if (   $usage
+	|| ((!$outdir)    || (! -d $outdir))
+	|| ((!$inputfile) || (! -f $inputfile))) {
+	print <<"EOF";
+$0 --input <file.lua> --output <directory> [--truncate]
+	--help     Print this help message
+	--input    file to fatpack. Expects all libs to reside in basedir(file)
+	--output   output directory for fatpacked files
+	--truncate unconditionally override in outdir (default=false)
+EOF
+	exit -1;
+}
+
+sub slurp {
+	my $filename = shift;
+	return do {
+		local $/;
+		open my $file, '<:encoding(UTF-8)', $filename or die "Failed to open file $filename";
+		<$file>;
+	};
+}
+
+sub extractIncludes {
+	# get all requires from a given modules
+	my $filecontent = shift;
+
+	my @requires = ($filecontent =~ m/require\((.*?)\)/g);
+	@requires = map {sanitizeRequire($_)} @requires;
+
+	return \@requires;
+}
+
+sub sanitizeRequire {
+	my $require = shift;
+	# remove all quotes and whitespaces from requires
+	$require =~ s/^['"\s]+|['"\s]+$//g;
+	return $require;
+}
+
+sub fix {
+	my $op  = shift;
+	my $old = shift;
+	my $new = $old;
+
+	do {
+		$old = $new;
+		$new = dclone($old);
+		$new = $op->($new);
+	} while (!Compare($old, $new));
+
+	return $new;
+}
+
+sub getModule {
+	my $includedir = shift;
+	my $modulename = shift;
+
+	return slurp("$includedir/$modulename.lua");
+}
+
+sub fatpack {
+	my $mainmodule = shift;
+	my $modules    = shift;
+
+	# split the module in shebang+header and the actual code
+	$modules->{$mainmodule} =~ /^(?<head>(#!.*\n|--.*\n)+)(?<tail>(.|\n)*)/;
+
+	my $head = $+{head};
+	my $tail = $+{tail};
+
+	# Build the fatpacked script
+	my $packed =  $head;
+
+	$packed .= <<"EOF";
+	
+do
+	local _ENV = _ENV
+EOF
+
+	while(my ($module, $content) = each %{$modules}) {
+		next if ($module eq $mainmodule);
+
+		my $effcontent = $content;
+		# Strip the shebang
+		$effcontent =~ s/^#!.*\n//g;
+
+		$packed .= <<"EOF";
+	package.preload["$module"] = function( ... )
+		local arg = _G.arg;
+		_ENV = _ENV;
+
+		$effcontent
+	end
+EOF
+	}
+
+	$packed .= "\nend\n";
+
+	$packed .= $tail;
+
+	return $packed;
+}
+
+sub unslurp {
+	my $dst = shift;
+	my $content = shift;
+
+	open(my $fh, '>', $dst);
+	print $fh, $content;
+	close $fh;
+}
+
+sub main {
+	my $includedir = dirname($inputfile);
+
+	my $inputmodule = basename($inputfile, ".lua");
+
+	my $modules = {
+		$inputmodule => getModule($includedir, $inputmodule),
+	};
+
+	my $process = sub {
+		my $modules = shift;
+
+		my @new = ();
+
+		# gather all includes in all modules
+		while(my ($key, $value) = each %{$modules}) {
+			my $extracted = extractIncludes($value);
+			push @new, $extracted->@*;
+		}
+
+		# Add all new modules and their contents
+		foreach my $module (@new) {
+			if (! exists $modules->{$module}) {
+				$modules->{$module} = getModule($includedir, $module);
+			}
+		}
+
+		return $modules;
+	};
+
+	$modules = fix($process, $modules);
+
+	my $fat = fatpack($inputmodule, $modules);
+
+	unslurp("$outdir/$mainmodule.lua", $fat);
+}
+
+main();