#!/usr/bin/env perl
# -*- perl -*-

#
# Author: Slaven Rezic
#
# Copyright (C) 2023,2024,2025,2026 Slaven Rezic. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# WWW:  https://github.com/bbbike/eserte/
#

use strict;
use warnings;
use FindBin;
use lib ("$FindBin::RealBin/..", "$FindBin::RealBin/../lib");
use utf8;

use Encode qw(decode);
use File::Glob qw(bsd_glob);
use Getopt::Long;
use I18N::Langinfo qw(langinfo CODESET);
use Time::Local qw(timelocal);

use BBBikeUtil qw(bbbike_root bbbike_aux_dir);
use Strassen::Core;

our $VERSION = '0.07';

my $bbbike_datadir = bbbike_root . '/data';
my $bbbike_miscdir = bbbike_root . '/misc';
my $bbbike_docdir  = bbbike_root . '/doc';
my $bbbike_aux_datadir = defined bbbike_aux_dir() ? bbbike_aux_dir() . '/bbd' : undef;

my $codeset = langinfo(CODESET());
$codeset = lc $codeset; # 'UTF-8' is not recognized by emacs, but 'utf-8' is
binmode STDOUT, ":encoding($codeset)";
binmode STDERR, ":encoding($codeset)";
$_ = decode($codeset, $_) for @ARGV;

# XXX should be configurable, by using both filesets and files
# element type:
# - either filename
# - or hashref with filename and encoding as fields
my @search_file_defs = (
			# following files on top, because of importance
			"$bbbike_datadir/strassen-orig",
			"$bbbike_datadir/fragezeichen-orig",
			{ encoding => 'iso-8859-1', filename => "$bbbike_datadir/temp_blockings/bbbike-temp-blockings.pl" },
			# rest of files
			(grep { !m{/(strassen|fragezeichen)-orig$} } bsd_glob("$bbbike_datadir/*-orig")),
			(map { +{ encoding => 'iso-8859-1', filename => $_ } }
			 bsd_glob("$bbbike_datadir/*.coords.data"),
			),
			"$bbbike_datadir/mudways",
			"$bbbike_datadir/zebrastreifen",
			(defined $bbbike_aux_datadir ? 
			 ("$bbbike_aux_datadir/fragezeichen_lowprio.bbd") : ()
			),
			(grep { -f $_ } "$bbbike_miscdir/webcams.bbd"),
			{ encoding => 'utf-8', filename => "$bbbike_docdir/watchsites.org" },
		       );
my @search_org_files;

my $searchterm_type = 'fixed';
my $case_insens     = 1;
my $limit;

my $with_filename = 1;
my $with_line_number;
my $with_byte_offset;

my $debug;
sub debug ($) { warn "$_[0]\n" if $debug }

Getopt::Long::Configure('noignore_case', 'noauto_abbrev', 'auto_version', 'auto_help');
GetOptions(
	   'rx|regex|regexp'       => sub { $searchterm_type = 'rx' },
	   'fixed'                 => sub { $searchterm_type = 'fixed' },
	   'case|case-sensitive|I' => sub { $case_insens = 0 },
	   'n|line-number'         => \$with_line_number,
	   'b|byte-offset'         => \$with_byte_offset,
	   'limit=i'               => \$limit,
	   'filename!'             => \$with_filename,
	   'h'                     => sub { $with_filename = 0 },
	   'add-file=s'            => sub { push @search_file_defs, $_[1] },
	   'add-file-with-encoding=s' => sub {
	       if (my($filename, $encoding) = $_[1] =~ m{^(.*):(.*)$}) {
		   push @search_file_defs, {
		       filename => $filename,
		       encoding => $encoding,
		   };
	       } else {
		   die "Unexpected format for --add-file-with-encoding value '$_[1]', should be 'filename:encoding'.\n";
	       }
	   },
	   'add-org-file=s@'       => \@search_org_files,
	   'reldir=s'              => \my $reldir,
	   'debug'                 => \$debug,
	  )
    or die "usage?";

# XXX allow multiple search terms? do or/and searches?
my $searchterm = shift
    or die "usage? searchterm missing";
my $original_searchterm = $searchterm;

if ($searchterm_type eq 'fixed') {
    $searchterm = quotemeta($searchterm);
}
# maybe do this conditional/with option?
# str. <-> straße
$searchterm =~ s{(?<=[sS]tr)\\\.}{(\\.|aße)}g;
$searchterm =~ s{(?<=[sS]tr)aße}{(\\.|aße)}g;
if ($searchterm ne $original_searchterm) {
    debug "searchterm was changed from '$original_searchterm' to '$searchterm'";
}
my $search_rx = $case_insens ? qr{$searchterm}i : qr{$searchterm};

if ($reldir) {
    require File::Spec;
}

debug "search $searchterm (case " . ($case_insens ? "in" : "") . "sensitive) ($searchterm_type)...";
my $errors = 0;
my $hits = 0;
my $file_hits = 0;
my @removed_lines;

sub do_search {
    my($fh, $outfile);
    my $format_output = sub {
	my $line = shift;
	my $prefix = shift;

	my $out;
	if ($with_filename) {
	    $out .= "$outfile:";
	}
	if ($with_line_number) {
	    $out .= "$.:";
	}
	if ($with_byte_offset) {
	    $out .= tell($fh) - bytes::length($line) - 1 + $-[0]; # - 1 because of chomp
	    $out .= ':';
	}
	if (defined $prefix) {
	    $out .= $prefix;
	}
	$out .= "$line\n";

	$out;
    };

    for my $search_file_def (@search_file_defs) {
	my($filename, $encoding);
	if (ref $search_file_def) {
	    ($filename, $encoding) = @{$search_file_def}{qw(filename encoding)};
	} else {
	    $filename = $search_file_def;
	}
	debug "  $filename...";
	if (!defined $encoding) {
	    my $dir = Strassen->get_global_directives($filename); # XXX can this throw an exception?
	    $encoding = $dir->{encoding}->[0] || 'iso-8859-1';
	}
	my $is_temp_blockings_pl = $filename =~ m{bbbike-temp-blockings\.pl$};
	my $is_temp_blockings_pl_preamble = $is_temp_blockings_pl ? 1 : undef;
	my $local_hits = 0;
	open $fh, $filename
	    or do {
		warn "ERROR: Can't open $filename ($!), skipping...\n";
		$errors++;
		next;
	    };
	binmode $fh, ":encoding($encoding)";
	$outfile = defined $reldir ? File::Spec->abs2rel($filename, $reldir) : $filename;

	my $until_time_spec; # currently used only for $is_temp_blockings_pl files
	my $until_time_spec_check = sub {
	    if ($until_time_spec =~ /^undef/) {
		return 0;
	    } elsif ($until_time_spec =~ /^(\d{9,})/) { # match epoch seconds since 1973
		if ($1 <= time) {
		    return 1;
		} else {
		    #warn "DEBUG: $1 is not over yet...\n";
		}
	    } elsif ($until_time_spec =~ /isodate2epoch->\("(\d+)-(\d+)-(\d+)\s+(\d+):(\d+):(\d+)/) {
		my $epoch = eval { timelocal($6,$5,$4,$3,$2-1,$1) };
		if (!defined $epoch) {
		    warn "WARNING: Cannot parse '$until_time_spec' as ISO-like date: $@";
		} elsif ($epoch <= time) {
		    return 1;
		} else {
		    #warn "DEBUG: $epoch is not over yet...\n";
		}
	    } elsif ($until_time_spec =~ /Time::Local::timelocal/) {
		# likely to be inactive; this style not used anymore since 2008
		return 1;
	    } else {
		warn "WARNING: Cannot parse '$until_time_spec' at all";
	    }
	    0;
	};

	while(<$fh>) {
	    if ($_ =~ $search_rx) {
		chomp;
		my $line = $_;
		if ($until_time_spec && $until_time_spec_check->()) {
		    push @removed_lines, $format_output->("INACTIVE: $line");
		} else {
		    my $out = $format_output->($line);
		    if ($line =~ /^#\s*REMOVED/) {
			push @removed_lines, $out;
		    } else {
			print $out;
		    }
		}
		$local_hits++;
		last if defined $limit && $local_hits + $hits >= $limit; # limit this file
	    } elsif ($is_temp_blockings_pl) {
		if ($is_temp_blockings_pl_preamble) {
		    if (/^\@temp_blocking\s*=/) {
			$is_temp_blockings_pl_preamble = 0;
		    }
		}
		if (/from\s*=>/) {
		    $until_time_spec = undef;
		} elsif (/until\s*=>\s*(.*)/) {
		    $until_time_spec = $1;
		}
	    }
	}
	close $fh;

	if ($local_hits) {
	    $file_hits++;
	    $hits += $local_hits;
	    last if defined $limit && $hits >= $limit; # limit all files
	}
    }

    for my $org_filename (@search_org_files) {
	debug "  $org_filename...";
	my $local_hits = 0;
	open $fh, $org_filename
	    or do {
		warn "ERROR: Can't open $org_filename ($!), skipping...\n";
		$errors++;
		next;
	    };
	binmode $fh, ':utf8'; # unconditional utf8
	$outfile = defined $reldir ? File::Spec->abs2rel($org_filename, $reldir) : $org_filename;
	my $current_title = '<no title>';
	my $state = '';
	while(<$fh>) {
	    if ($state eq 'skip_to_title') {
		if (/^\*/) {
		    $state = '';
		} else {
		    next;
		}
	    }

	    if (/^\*+\s+\S+\s+(.*)/) {
		$current_title = $1;
	    };
	    if ($_ =~ $search_rx) {
		my $out = $format_output->($_, "$current_title: ");
		if (/^#\s*REMOVED/) {
		    push @removed_lines, $out;
		} else {
		    print $out;
		}
		$local_hits++;
		last if defined $limit && $local_hits + $hits >= $limit; # limit this file
	    }
	}
	close $fh;

	if ($local_hits) {
	    $file_hits++;
	    $hits += $local_hits;
	    last if defined $limit && $hits >= $limit; # limit all files
	}
    }
}

do_search();

if (@removed_lines) {
    print @removed_lines;
}

if ($debug) {
    debug "\nStatistics:";
    debug "  Hits:               $hits";
    debug "  File hits:          $file_hits";
    debug "  Removed lines hits: " . scalar(@removed_lines);
}

if ($errors) {
    exit 2;
} elsif (!$hits) {
    exit 1;
} else {
    exit 0;
}

__END__

=head1 NAME

bbbike-grep - specialized grep for bbbike data

=head1 SYNOPSIS

    bbbike-grep [--rx|--fixed] [--case-sensitive] [-n] [--add-file file] [--add-file-with-encoding file:encoding] [--add-org-file file] [--debug] searchterm

=head1 DESCRIPTION

A commandline tool for searching in BBBike data files. It's modelled
after traditional L<grep(1)>, but with some differences:

=over

=item * By default it searches in BBBike data files, in the same
repository as C<bbbike-grep> itself. It's possible to add further
files for search (see L</--add-file> and L</--add-file-with-encoding>).

=item * It knows about the encoding of BBBike data files, and
automatically switches between C<iso-8859-1>, C<utf-8>, or whatever is
specified. It also knows the encoding of the current terminal, and
handles input parameters and output correctly.

=item * Regexps (like traditional grep) or fixed strings (like fgrep)
may be used. The default is "fixed", unlike grep.

=item * By default the search is done in a case insenitive way (unlike
grep).

=item * Lines beginning with a "REMOVED" comment will be listed at the end.

=back

=head2 OPTIONS

=over

=item C<--rx> (aliases: C<--regex>, C<--regexp>)

Specify that search term should be treated as a Perl regular
expression, similar like C<grep -P>.

=item C<--fixed>

Specify that search term should be treated as a fixed string, similar
like L<fgrep(1)>. This is the default.

=item C<--case-sensitive> (aliases: C<--case>, C<-I>)

Specify that the search term should be used in a case sensitive way.
By default it is case insensitive. Note that this differs from
traditional L<grep(1)>.

=item C<-h> (alias: C<--no-filename>)

Do not output filename of search hits.

=item C<-n> (alias: C<--line-number>)

Output also line number of search hits after the filename. Useful for
editors and IDEs, e.g. for emacs' grep-mode.

=item C<-b> (alias: C<--byte-offset>)

Output also the byte offset of search hits after the filename.

=item C<--add-file I<filename>>

Specify another bbd file to search, additionally to the standard set
of files.

=item C<--add-file-with-encoding I<filename>:I<encoding>>

Specify another possibly non-bbd file to search, together with an
encoding like C<utf-8> or C<iso-8859-1>, additionally to the standard
set of files.

=item C<--add-org-file I<filename>>

Specify an org-mode file to search, additionally to the standard set
of files.

=item C<--debug>

Enable debug mode.

=back

=head1 EXAMPLES

    bbbike-grep "brandenburger tor"

=head1 SEE ALSO

L<grep(1)>, L<fgrep(1)>, L<Strassen::Core>.

=cut
