1#!/usr/bin/perl -w
2
3use Digest::SHA;
4use File::Copy qw(copy);  # Core module
5use IO::File;
6use strict;
7
8our $Debug;
9
10# We don't use getopt, as want multiple in/outs and stop at first command
11my @opt_name;
12my @opt_in;  # We allow empty opt_in and opt_out so we can cache --version checks.
13my @opt_out;
14my @opt_cmd;
15my @opt_vercmd;
16my $Opt_Gen = "gen";
17my $Opt_Verbose;
18my $opt_skip_cmd = 0;
19my $in_cmd;
20my $list = \@opt_in;
21while (defined(my $param=shift @ARGV)) {
22    if ($in_cmd) { push @opt_cmd, $param; }
23    elsif ($param =~ /^-?-debug/) { $Debug=1; }
24    elsif ($param =~ /^-?-cmd/) { $in_cmd = 1; }
25    elsif ($param =~ /^-?-in/) { $list = \@opt_in; }
26    elsif ($param =~ /^-?-name/) { $list = \@opt_name; }
27    elsif ($param =~ /^-?-skip-cmd/) { $opt_skip_cmd = shift @ARGV; }
28    elsif ($param =~ /^-?-out/) { $list = \@opt_out; }
29    elsif ($param =~ /^-?-verbose/) { $Opt_Verbose=1; }
30    elsif ($param =~ /^-?-gen/) { $Opt_Gen = shift @ARGV; }
31    elsif ($param =~ /^-?-vercmd/) { $list = \@opt_vercmd; }
32    elsif ($param =~ /^-/) { die "%Error: Unexpected argument: $param,"; }
33    else {
34	push @$list, $param;
35    }
36}
37$opt_name[0] ||= $opt_cmd[0];
38$opt_vercmd[0] ||= $opt_cmd[0];
39$Opt_Verbose = 1 if $Debug;
40
41mkdir $Opt_Gen, 0777;
42
43# Hash of command, including this program args
44my $digest = Digest::SHA->new(1);
45{
46    my $str = 'toolhash_1.0';
47    $str .= '----'.join('  ',@opt_in);
48    $str .= '----'.join('  ',@opt_out);
49    $str .= '----';
50    my $i = $opt_skip_cmd;
51    foreach (@opt_cmd) { next if ($i-- > 0); $str.='  '.$_; }
52    $str .= '----';
53    print "toolhash: Hashing $str\n" if $Debug;
54    $digest->add($str);
55}
56foreach my $fn (@opt_in) {
57    print "toolhash: Hashing $fn\n" if $Debug;
58    my $fh = IO::File->new("<$fn") or die "toolhash: %Error: $! reading $fn\n";
59    $digest->addfile($fh);
60    $fh->close;
61}
62my $arcfn = $Opt_Gen."/".$opt_name[0];
63my $hash = $digest->b64digest;
64
65# Cache hit?  If so, fill as we go
66remove_out();
67my $hit = restore($hash, 1);
68if ($hit) {
69    print "toolhash: Cache hit running $opt_name[0]\n" if $Opt_Verbose;
70    exit(0);
71} else {
72    print "toolhash: Cache miss running $opt_name[0]\n" if $Opt_Verbose;
73}
74remove_named();
75my $out = run_cmd();
76encache($hash, $out);
77
78remove_out();
79$hit = restore($hash, 0);
80exit(0) if $hit;
81die "toolhash: %Error: encaching failed, didn't hit second time\n";
82
83#######################################################################
84
85sub restore {
86    my $hash = shift;
87    my $pass1 = shift;
88    if ($pass1 && $ENV{TOOLHASH_RECACHE}) {
89	print "toolhash: TOOLHASH_RECACHE set, missing\n" if $Debug;
90	return 0;
91    }
92
93    # Returns hit
94    my $hit = 1;
95    my $fh = IO::File->new("<${arcfn}-0");
96    if (!$fh) {
97	print "toolhash: Cache hash empty $arcfn\n" if $Debug;
98	return 0;
99    }
100    my $line = $fh->getline;
101    chomp $line;
102    print "toolhash: Cache hash test $arcfn $line ".$hash."\n" if $Debug;
103    if ($line ne $hash) {
104	print "toolhash: Cache hash miss\n" if $Debug;
105	return 0;
106    }
107
108    my $n = 1;
109    foreach my $fn (@opt_out) {
110	my $digout = "${arcfn}-${n}";
111	if (-r $digout) {
112	    print "toolhash: Cache hit  $digout for $fn\n" if $Debug;
113	    # Restore, assuming all hits.
114	    copy($digout, $fn) or die "toolhash: %Error: $! on 'cp $digout $fn'\n";
115	} else {
116	    print "toolhash: Cache miss $digout for $fn\n" if $Debug;
117	    $hit = 0; last;
118	}
119	$n++;
120    }
121
122    if ($hit) {
123	print "toolhash: Cache hit\n" if $Debug;
124	if (my $fh = IO::File->new("<${arcfn}-s")) {  # Dump stdout
125	    print join('',$fh->getlines);
126	    $fh->close;
127	}
128    }
129
130    return $hit;
131}
132
133sub run_cmd {
134    remove_out();
135    my $cmd = join(' ',@opt_cmd);
136    # We can't use system() as we need the output and fork() isn't portable
137    # without pulling in yet another package, so punt on spaces
138    foreach (@opt_cmd) {
139	if (/ /) { die "%Error: unsupported: spaces in command: '$cmd',"; }
140    }
141    print "\t$cmd\n" if $Debug||1;
142    my $out = `$cmd`;
143    my $status = $?;
144    print $out;
145    if ($status) {
146	remove_out();
147	# See if bison/gcc/flex --version works
148	my $vcmd = "$opt_vercmd[0] --version";
149	print "\t$vcmd\n" if $Debug;
150	`$vcmd`;
151	if ($?) {
152	    die "\n%Error: '$opt_cmd[0]' must be installed to build\n";
153	}
154	exit $status >> 8;
155    }
156    return $out;
157}
158
159sub encache {
160    my $hash = shift;
161    my $out = shift;
162
163    print "toolhash: Encache ".$hash."\n" if $Debug;
164
165    my $fh = IO::File->new(">${arcfn}-0") or die "toolhash: %Error: $! ${arcfn}-0\n";
166    $fh->print($hash);
167    $fh->close;
168
169    if ($out ne "") {
170	$fh = IO::File->new(">${arcfn}-s") or die "toolhash: %Error: $! ${arcfn}-s\n";
171	$fh->print($out);
172	$fh->close;
173    }
174
175    my $n = 1;
176    foreach my $fn (@opt_out) {
177	my $digout = "${arcfn}-${n}";
178	copy($fn, $digout) or die "toolhash: %Error: $! on 'cp $fn $digout'\n";
179	$n++;
180    }
181}
182
183sub remove_out {
184    unlink for (@opt_out);  # Ok if error
185}
186
187sub remove_named {
188    unlink for (glob $Opt_Gen."/$opt_name[0]-*"); # Ok if error
189}
190
191#######################################################################
192__END__
193
194=pod
195
196=head1 NAME
197
198toolhash - Generate and hash files to avoid installation of build tools
199
200=head1 SYNOPSIS
201
202  toolhash --in foo.c --out foo.o --cmd gcc -c -o foo.o foo.c
203
204=head1 DESCRIPTION
205
206Toolhash is used to install Verilog-Perl and other tools.  It stores a
207hash of generated files (aka the cons make utility) for distribution to
208avoid building those files from scratch.
209
210The hash isn't stored as part of the filename, so that the MANIFEST can
211remain constant.
212
213=head1 ARGUMENTS
214
215=over 4
216
217=item --cmd command args...
218
219Command and arguments to run.  All further arguments are passed to the command.
220
221=item --gen ARG
222
223Specify location of generated file cache, defaults to "gen".
224
225=item --in filenames...
226
227Input filenames.
228
229=item --name
230
231Prefix for output files, or defaults to first --cmd argument.
232
233=item --verbose
234
235Print hit/miss messages.
236
237=item --skip-cmd <num-args>
238
239Disable hashing first num-arg components of the command.  This is used to
240avoid commands like "/usr/bin/perl ...." from hash missing when the Perl
241version and thus the path changes.
242
243=item --out filenames...
244
245Output filenames.
246
247=item --vercmd command
248
249Command to run to get --version.
250
251=back
252
253=head1 ENVIRONMENT
254
255=over 4
256
257=item TOOLHASH_RECACHE
258
259Write the cache, but do not read from it.
260
261=back
262
263=head1 DISTRIBUTION
264
265This is part of the L<https://www.veripool.org/> free Verilog EDA software
266tool suite.  The latest version is available from CPAN and from
267L<https://www.veripool.org/>.
268
269Copyright 2010-2021 by Wilson Snyder.  This package is free software; you
270can redistribute it and/or modify it under the terms of either the GNU
271Lesser General Public License Version 3 or the Perl Artistic License Version 2.0.
272
273This program is distributed in the hope that it will be useful, but WITHOUT
274ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
275FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
276more details.
277
278=head1 AUTHORS
279
280Wilson Snyder <wsnyder@wsnyder.org>
281
282=head1 SEE ALSO
283
284C<make>
285
286=cut
287
288######################################################################
289### Local Variables:
290### compile-command: "echo 'void i() {}' > foo.c; ./toolhash toolhash --debug --in foo.c --out foo.o --cmd gcc -c -o foo.o foo.c ; ls -la foo.* gen/* ; rm foo.*"
291### End:
292