path: root/cgi-bin/search.cgi

#!/usr/bin/perl

use strict;
use warnings;
use Storable qw(retrieve);
use Encode qw(decode_utf8 encode_utf8);
use URI::Escape qw(uri_unescape);
use HTML::Escape qw(escape_html);

# --- Configuration ---
my $max_parallel   = 50;
my $lock_timeout    = 30;
my $max_results     = 20;
my $sa_file         = 'sa.bin';
my $cp_file         = 'corpus.bin';
my $map_file        = 'file_map.dat';
my $lock_dir        = '/tmp/search_locks';

binmode(STDOUT, ":utf8");

# --- Concurrency control ---
mkdir $lock_dir, 0777 unless -d $lock_dir;
my $active_count = 0;
my $now = time();

opendir(my $dh, $lock_dir);
while (my $file = readdir($dh)) {
	next unless $file =~ /\.lock$/;
	my $path = "$lock_dir/$file";
	my $mtime = (stat($path))[9] || 0;
	($now - $mtime > $lock_timeout) ? unlink($path) : $active_count++;
}
closedir($dh);

my $lock_file = "$lock_dir/$$.lock";
my $fh_lock;

# Busy check
if ($active_count >= $max_parallel) {
	render_html("<p>Server busy. Please try again in a few seconds.</p>", "");
}

# Create semaphore lock
open($fh_lock, '>', $lock_file) or die "Cannot create lock: $!";

my $search_text = '';
if (($ENV{QUERY_STRING} || '') =~ /^q=([^&]*)/) {
	my $raw_q = $1;
	$raw_q =~ tr/+/ /;
	$search_text = uri_unescape($raw_q);
	$search_text = decode_utf8($search_text // "");
	$search_text =~ s/\P{Print}//g; 
	$search_text = substr($search_text, 0, 64);
	$search_text =~ s/^\s+|\s+$//g;
}

my $safe_search_text = escape_html($search_text);

if ($search_text eq '') {
	render_html("<p>Please enter a search term above.</p>", "");
}

# --- Suffix array binary search ---
my @results;
my $query = encode_utf8(lc($search_text));
my $query_len = length($query);

if (-f $sa_file && -f $cp_file) {
	open(my $fh_sa, '<', $sa_file) or die $!;
	open(my $fh_cp, '<', $cp_file) or die $!;
	binmode($fh_sa);
	binmode($fh_cp);

	my $file_map = retrieve($map_file);
	my $total_suffixes = (-s $sa_file) / 4;

	# Find left boundary
	my ($low, $high) = (0, $total_suffixes - 1);
	my $first_hit = -1;

	while ($low <= $high) {
		my $mid = int(($low + $high) / 2);
		seek($fh_sa, $mid * 4, 0);
		read($fh_sa, my $bin_off, 4);
		my $off = unpack("L", $bin_off);
		seek($fh_cp, $off, 0);
		read($fh_cp, my $text, $query_len);
		
		my $cmp = $text cmp $query;
		if ($cmp >= 0) {
			$first_hit = $mid if $cmp == 0;
			$high = $mid - 1;
		} else {
			$low = $mid + 1;
		}
	}

	# Collect results
	if ($first_hit != -1) {
		my $last_hit = $first_hit;
		($low, $high) = ($first_hit, $total_suffixes - 1);
		
		# Find right boundary
		while ($low <= $high) {
			my $mid = int(($low + $high) / 2);
			seek($fh_sa, $mid * 4, 0);
			read($fh_sa, my $bin_off, 4);
			my $off = unpack("L", $bin_off);
			seek($fh_cp, $off, 0);
			read($fh_cp, my $text, $query_len);
			
			if (($text cmp $query) <= 0) {
				$last_hit = $mid if $text eq $query;
				$low = $mid + 1;
			} else {
				$high = $mid - 1;
			}
		}

		my %seen;
		for my $i ($first_hit .. $last_hit) {
			seek($fh_sa, $i * 4, 0);
			read($fh_sa, my $bin_off, 4);
			my $offset = unpack("L", $bin_off);

			foreach my $m (@$file_map) {
				if ($offset >= $m->{start} && $offset < $m->{end}) {
					if (!$seen{$m->{path}}++) {
						# Grab context window around the match byte offset
						my $grab_start = ($offset > 150) ? $offset - 150 : $m->{start};
						if ($grab_start < $m->{start}) { $grab_start = $m->{start}; }
						
						my $grab_len = ($offset - $grab_start) + 300; 
						if ($grab_start + $grab_len > $m->{end}) {
							$grab_len = $m->{end} - $grab_start;
						}

						seek($fh_cp, $grab_start, 0);
						read($fh_cp, my $raw_chunk, $grab_len);
						
						my $is_start = ($grab_start == $m->{start});
						my $is_end   = ($grab_start + $grab_len >= $m->{end});

						my $snippet = trim_and_clean_snippet($raw_chunk, $is_start, $is_end);

						my $clean_path = $m->{path};
						$clean_path =~ s|^\.\./_site/||;

						push @results, {
							path    => $clean_path,
							title   => $m->{title},
							snippet => $snippet
						};
					}
					last;
				}
			}
			last if scalar @results >= $max_results;
		}
	}
	close($fh_sa);
	close($fh_cp);
}

# Prepare output
my $list_html = "";
if (@results == 0) {
	$list_html = "<p>No results found for \"<b>$safe_search_text</b>\".</p>";
} else {
	$list_html = "<ul>" . join('', map { 
		"<li><a href=\"/$_->{path}\">$_->{title}</a><br><small>$_->{snippet}</small></li>" 
	} @results) . "</ul>";
}

render_html($list_html, $safe_search_text);

sub trim_and_clean_snippet {
	my ($raw_chunk, $is_start, $is_end) = @_;

	# Decode and normalize
	my $text = decode_utf8($raw_chunk, Encode::FB_QUIET) // $raw_chunk;
	$text =~ s/\s+/ /g;
	$text =~ s/^\s+|\s+$//g;

	# Front-end trim: remove partial leading word
	if (!$is_start) {
		$text =~ s/^[^\s]*\s//;
	}

	# Length control: target ~160 characters
	my $show_ellipsis = !$is_end;
	if (length($text) > 160) {
		$text = substr($text, 0, 160);
		if ($text =~ s/\s+[^\s]*$//) {
			$show_ellipsis = 1;
		}
	}

	# Clean leading punctuation, then capitalize
	$text =~ s/^[:;,.?!\s]+//;
	$text = ucfirst($text);

	my $html = escape_html($text);
	if ($show_ellipsis && $text !~ /[.!?]$/) {
		$html .= "...";
	}
	return $html;
}

sub render_html {
	my ($content, $q_val) = @_;

	print "Content-Type: text/html; charset=UTF-8\n\n";
	print <<"HTML";
<!DOCTYPE html>
<html lang="en-us">
<head>
	<meta charset="utf-8">
	<meta name="viewport" content="width=device-width, initial-scale=1">
	<title>Journal | Search</title>
	<link rel="stylesheet" href="/assets/css/main.css">
</head>
<body>
	<header>
		<h1><a href="/">Journal</a></h1> / 
		<h1><a href="/cgi-bin/search.cgi">Search</a></h1>
	</header>
	<article>
		<form id="search-bar" action="" method="GET">
			<input id="search-box" type="text" name="q" value="$q_val">
			<input id="search-btn" type="submit" value="Search">
		</form>
		$content
	</article>
</body>
</html>
HTML

	# Final cleanup and exit
	if (defined $fh_lock) { 
		close($fh_lock); 
		unlink($lock_file) if -e $lock_file; 
	}
	exit;
}