diff options
Diffstat (limited to 'lib/PublicInbox/XapHelperCxx.pm')
-rw-r--r-- | lib/PublicInbox/XapHelperCxx.pm | 141 |
1 files changed, 141 insertions, 0 deletions
diff --git a/lib/PublicInbox/XapHelperCxx.pm b/lib/PublicInbox/XapHelperCxx.pm new file mode 100644 index 00000000..74852ad1 --- /dev/null +++ b/lib/PublicInbox/XapHelperCxx.pm @@ -0,0 +1,141 @@ +# Copyright (C) all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> + +# Just-ahead-of-time builder for the lib/PublicInbox/xap_helper.h shim. +# I never want users to be without source code for repairs, so this +# aims to replicate the feel of a scripting language using C++. +# The resulting executable is not linked to Perl in any way. +package PublicInbox::XapHelperCxx; +use v5.12; +use PublicInbox::Spawn qw(run_die run_qx run_wait which); +use PublicInbox::IO qw(try_cat write_file); +use PublicInbox::Search; +use Fcntl qw(SEEK_SET); +use Config; +use autodie; +my $cxx = which($ENV{CXX} // 'c++') // which('clang') // die 'no C++ compiler'; +my $dir = substr("$cxx-$Config{archname}", 1); # drop leading '/' +$dir =~ tr!/!-!; +my $idir; +if ((defined($ENV{XDG_CACHE_HOME}) && -d $ENV{XDG_CACHE_HOME}) || + (defined($ENV{HOME}) && -d $ENV{HOME})) { + $idir = ($ENV{XDG_CACHE_HOME} // + (($ENV{HOME} // die('HOME unset')).'/.cache') + ).'/public-inbox/jaot'; +} +$idir //= $ENV{PERL_INLINE_DIRECTORY} // + die 'HOME and PERL_INLINE_DIRECTORY unset'; +substr($dir, 0, 0) = "$idir/"; +my $bin = "$dir/xap_helper"; +my ($srcpfx) = (__FILE__ =~ m!\A(.+/)[^/]+\z!); +my @srcs = map { $srcpfx.$_ } qw(xh_mset.h xh_cidx.h xap_helper.h); +my @pm_dep = map { $srcpfx.$_ } qw(Search.pm CodeSearch.pm); +my $ldflags = '-Wl,-O1'; +$ldflags .= ' -Wl,--compress-debug-sections=zlib' if $^O ne 'openbsd'; +my $xflags = ($ENV{CXXFLAGS} // '-Wall -ggdb3 -pipe') . ' ' . + ' -DTHREADID=' . PublicInbox::Search::THREADID . + ' -DXH_SPEC="'.join('', + map { s/=.*/:/; $_ } @PublicInbox::Search::XH_SPEC) . '" ' . + ($ENV{LDFLAGS} // $ldflags); +substr($xflags, 0, 0, '-O2 ') if !defined($ENV{CXXFLAGS}) && !-w __FILE__; +my $xap_modversion; + +sub xap_cfg (@) { + my $cmd = [ $ENV{PKG_CONFIG} // 'pkg-config', @_, 'xapian-core' ]; + chomp(my $ret = run_qx($cmd, undef, { 2 => \(my $err) })); + return $ret if !$?; + die <<EOM; +@$cmd failed: Xapian development files missing? (\$?=$?) +$err +EOM +} + +sub needs_rebuild () { + my $prev = try_cat("$dir/XFLAGS") or return 1; + chomp $prev; + return 1 if $prev ne $xflags; + + $prev = try_cat("$dir/xap_modversion") or return 1; + chomp $prev; + + $xap_modversion = xap_cfg('--modversion'); + $xap_modversion ne $prev; +} + +sub build () { + if (!-d $dir) { + require File::Path; + eval { File::Path::make_path($dir) }; + if (!-d $dir && defined($ENV{PERL_INLINE_DIRECTORY})) { + $dir = $ENV{PERL_INLINE_DIRECTORY}; + File::Path::make_path($dir); + } + } + require PublicInbox::CodeSearch; + require PublicInbox::Lock; + my ($prog) = ($bin =~ m!/([^/]+)\z!); + my $lk = PublicInbox::Lock->new("$dir/$prog.lock")->lock_for_scope; + write_file '>', "$dir/$prog.cpp", qq{#include "xap_helper.h"\n}, + PublicInbox::Search::generate_cxx(), + PublicInbox::CodeSearch::generate_cxx(); + + # xap_modversion may be set by needs_rebuild + $xap_modversion //= xap_cfg('--modversion'); + my $fl = xap_cfg(qw(--libs --cflags)); + + # Using rpath seems acceptable/encouraged in the NetBSD packaging world + # since /usr/pkg/lib isn't searched by the dynamic loader by default. + # Not sure if other OSes need this, but rpath seems fine for JAOT + # binaries (like this one) even if other distros discourage it for + # distributed packages. + $^O eq 'netbsd' and $fl =~ s/(\A|[ \t])\-L([^ \t]+)([ \t]|\z)/ + "$1-L$2 -Wl,-rpath=$2$3"/egsx; + my @xflags = split(' ', "$fl $xflags"); # ' ' awk-mode eats leading WS + my @cflags = ('-I', $srcpfx, grep(!/\A-(?:Wl|l|L)/, @xflags)); + run_die([$cxx, '-o', "$dir/$prog.o", '-c', "$dir/$prog.cpp", @cflags]); + + # xapian on Alpine Linux (tested 3.19.0) is linked against libstdc++, + # and clang needs to be told to use it (rather than libc++): + my @try = rindex($cxx, 'clang') >= 0 ? qw(-lstdc++) : (); + my @cmd = ($cxx, '-o', "$dir/$prog.tmp", "$dir/$prog.o", @xflags); + while (run_wait(\@cmd) and @try) { + warn("# attempting to link again with $try[0]...\n"); + push(@cmd, shift(@try)); + } + die "# @cmd failed: \$?=$?" if $?; + unlink "$dir/$prog.cpp", "$dir/$prog.o"; + write_file '>', "$dir/XFLAGS.tmp", $xflags, "\n"; + write_file '>', "$dir/xap_modversion.tmp", $xap_modversion, "\n"; + undef $xap_modversion; # do we ever build() twice? + # not quite atomic, but close enough :P + rename("$dir/$_.tmp", "$dir/$_") for ($prog, qw(XFLAGS xap_modversion)); +} + +sub check_build () { + use Time::HiRes qw(stat); + my $ctime = 0; + my @bin = stat($bin) or return build(); + for (@srcs, @pm_dep) { + my @st = stat($_) or die "stat $_: $!"; + if ($st[10] > $ctime) { + $ctime = $st[10]; + return build() if $ctime > $bin[10]; + } + } + needs_rebuild() ? build() : 0; +} + +# returns spawn arg +sub cmd { + die 'PI_NO_CXX set' if $ENV{PI_NO_CXX}; + check_build(); + my @cmd; + if (my $v = $ENV{VALGRIND}) { + $v = 'valgrind -v' if $v eq '1'; + @cmd = split(/\s+/, $v); + } + push @cmd, $bin; + \@cmd; +} + +1; |