#!/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("

Server busy. Please try again in a few seconds.

", ""); } # 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("

Please enter a search term above.

", ""); } # --- 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 = "

No results found for \"$safe_search_text\".

"; } else { $list_html = ""; } 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"; Journal | Search

Journal

/

Search

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