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;