add fatpacker script
[chaz/homebank2ledger] / maint / fatpack.pl
1 #!/usr/bin/env perl
2
3 # This script creates a fatpacked version of homebank2ledger. Much of this code was inspired by or
4 # blatantly copied from cpanminus build scripts, written by Tatsuhiko Miyagawa.
5
6 use warnings FATAL => 'all';
7 use strict;
8 use autodie ':all';
9
10 use App::FatPacker ();
11 use Cwd;
12 use File::Find;
13 use File::Path;
14 use File::pushd;
15 use Module::CoreList;
16
17
18 my $distdir = shift;
19
20 my $script_name = 'bin/homebank2ledger';
21 my $libdir = 'lib';
22
23 if ($distdir) {
24 if (-d "$distdir/blib") {
25 $script_name = "$distdir/blib/script/homebank2ledger";
26 $libdir = "$distdir/blib/lib";
27 }
28 else {
29 $script_name = "$distdir/$script_name";
30 $libdir = "$distdir/$libdir";
31 }
32 }
33
34 make_fatlib();
35 make_script();
36 exit;
37
38
39 BEGIN {
40 # IO::Socket::IP requires newer Socket, which is C-based
41 $ENV{PERL_HTTP_TINY_IPV4_ONLY} = 1;
42 }
43
44 END {
45 no autodie;
46 unlink('homebank2ledger.tmp');
47 rmtree('.fatpack-build');
48 rmtree('fatlib');
49 }
50
51
52 sub find_requires {
53 my $file = shift;
54
55 my %requires;
56 open my $in, "<", $file;
57 while (<$in>) {
58 /^\s*(?:use|require) (\S+)[^;]*;\s*$/
59 and $requires{$1} = 1;
60 }
61
62 keys %requires;
63 }
64
65 sub mod_to_pm {
66 local $_ = shift;
67 s!::!/!g;
68 "$_.pm";
69 }
70
71 sub pm_to_mod {
72 local $_ = shift;
73 s!/!::!g;
74 s/\.pm$//;
75 $_;
76 }
77
78 sub in_lib {
79 my $file = shift;
80 -e "$libdir/$file";
81 }
82
83 sub is_core {
84 my $module = shift;
85 exists $Module::CoreList::version{5.008001}{$module};
86 }
87
88 sub exclude_modules {
89 my($modules, $except) = @_;
90 my %exclude = map { $_ => 1 } @$except;
91 [ grep !$exclude{$_}, @$modules ];
92 }
93
94 sub pack_modules {
95 my($path, $modules, $no_trace) = @_;
96
97 $modules = exclude_modules($modules, $no_trace);
98
99 my $packer = App::FatPacker->new;
100 my @requires = grep !is_core(pm_to_mod($_)), grep /\.pm$/, split /\n/,
101 $packer->trace(use => $modules, args => ['-e', 1]);
102 push @requires, map mod_to_pm($_), @$no_trace;
103
104 my @packlists = $packer->packlists_containing(\@requires);
105 for my $packlist (@packlists) {
106 print "Packing $packlist\n";
107 }
108 $packer->packlists_to_tree($path, \@packlists);
109 }
110
111 sub make_fatlib {
112 my @modules = grep !in_lib(mod_to_pm($_)), find_requires($script_name);
113
114 pack_modules(cwd . '/fatlib', \@modules, []);
115
116 use Config;
117 print "Remove fatlib/$Config{archname}\n";
118 rmtree("fatlib/$Config{archname}");
119 rmtree("fatlib/POD2");
120
121 my $want = sub {
122 if (/\.pod$/) {
123 print "Remove $_\n";
124 unlink $_;
125 }
126 };
127
128 find({ wanted => $want, no_chdir => 1 }, 'fatlib');
129 }
130
131
132 sub generate_file {
133 my($base, $target, $fatpack) = @_;
134
135 open my $in, "<", $base;
136 open my $out, ">", "$target.tmp";
137
138 print STDERR "Generating $target from $base\n";
139
140 while (<$in>) {
141 s|^#!\h*perl|#!/usr/bin/env perl|;
142 s|^# FATPACK.*|$fatpack|;
143 print $out $_;
144 }
145
146 close $out;
147
148 eval { unlink $target };
149 rename "$target.tmp", $target;
150 }
151
152 sub make_script {
153 mkdir '.fatpack-build';
154 system qw(cp -r fatlib), $libdir, qw(.fatpack-build/);
155
156 my $fatpack_compact = do {
157 my $dir = pushd '.fatpack-build';
158
159 my @files;
160 my $want = sub {
161 push @files, $_ if /\.pm$/;
162 if (/\.pod$/) {
163 print "Remove $_\n";
164 unlink $_;
165 }
166 };
167
168 find({ wanted => $want, no_chdir => 1 }, 'fatlib', 'lib');
169 system qw(perlstrip --cache -v), @files;
170
171 `fatpack file`;
172 };
173
174 my $filename = $script_name;
175 $filename =~ s!^.*/!!;
176
177 generate_file($script_name, $filename, $fatpack_compact);
178 chmod 0755, $filename;
179 }
180
This page took 0.039407 seconds and 4 git commands to generate.