#!/usr/bin/perl

use strict;
use warnings;

use FindBin;
use lib "$FindBin::Bin/lib";

use LXRng ROOT => $FindBin::Bin;
use LXRng::Context;
use LXRng::Lang;
use LXRng::Index;
use LXRng::Parse::Simple;

use Carp;
use Data::Dumper;
use IO::Handle;
use Fcntl;

$SIG{'INT'}  = sub { die "SIGINT: please wait, flushing caches...\n"; };
$SIG{'QUIT'} = sub { die "SIGQUIT: please wait, flushing caches...\n"; };
$SIG{'TERM'} = sub { die "SIGTERM: please wait, flushing caches...\n"; };

autoflush STDOUT 1;
autoflush STDERR 1;

my $cols = 0;
sub progress_mark {
    my ($mark) = @_;

    if ($cols > 79) {
	print("\n");
	$cols = 0;
    }
    print(STDERR $mark);
    $cols++;
}

sub progress_info {
    my ($msg) = @_;
    print(STDERR "\n") if $cols > 0;
    print(STDERR "$msg\n");
    $cols = 0;
}

sub make_add_ident {
    my ($index, $fileid) = @_;

    my $last_func;
    my %identcache;

    my $add_ident;
    $add_ident = sub {
	my ($symbol, $info) = @_;
	
	if ($$info{'kind'} eq 'f') {
	    $last_func = $symbol;
	}
	if ($$info{'kind'} eq 'l') {
	    $$info{'context'} = $identcache{$last_func};
	}
	if (exists $$info{'class'}) {
	    $$info{'context'} = $identcache{$$info{'class'}};
	}
	if (exists $$info{'struct'}) {
	    $$info{'context'} = $identcache{$$info{'struct'}};
	}

	$identcache{$symbol} = 
	    $index->add_ident($fileid, $$info{'line'},
			      $symbol, $$info{'kind'},
			      $$info{'context'});
    
	if ($$info{'kind'} eq 'f' and exists $$info{'signature'}) {
	    # This needs to be more robust.  Perhaps ctags ought to do it.
	    
	    foreach my $v (split(/,/, $$info{'signature'})) {
		next if 
		    $v !~ /([a-zA-Z_0-9]+)[^a-zA-Z_0-9]*$/ or
		    $1 eq 'void';

		$add_ident->($1, {'kind' => 'l', 'line' => $$info{'line'}});
	    }
	}
    }
}

sub index_file {
    my ($context, $index, $tree, $file, $fileid) = @_;

    my $lang = LXRng::Lang->new($file);

    unless ($index->to_index($fileid)) {
	progress_mark("*");
	return;
    }
    return unless $lang->doindex();

    my $add_ident = make_add_ident($index, $fileid);
   
    progress_info("indexing ".$file->name."[".$file->revision."] ".
		  $file->size." bytes ($lang)...");

    my @extra_flags = ('-IEXPORT_SYMBOL+', '-I__initcall+');

    my $path = $file->phys_path;

    my $ctags;
    my $pid = open($ctags, '-|');
    die $! unless defined $pid;
    
    if ($pid == 0) {
	exec('ctags-exuberant',
	     @extra_flags,
	     '--fields=+aifmknsSz', '--sort=no',
	     '--excmd=number', '-f', '-',
	     '--language-force='.$lang->ctagslangname,
	     $lang->ctagsopts,
	     $path);

	# Still here?
	warn $!;
	kill(9, $$);
    }

    LXRng::Index::transaction {
	while (<$ctags>) {
	    chomp;
	    my ($symbol, $file, $excmd, @info) = split(/\t/);
	    my %info = map { split(/:/, $_, 2) } @info;
	    
	    $add_ident->($symbol, \%info);
	}
    } $index;

    $path = undef;
}

sub reference_file {
    my ($context, $index, $tree, $file, $fileid) = @_;

    my $lang = LXRng::Lang->new($file);

    unless ($index->to_reference($fileid)) {
	progress_mark(".");
	return;
    }
    return unless $lang->doindex();

    my $parse = new LXRng::Parse::Simple($file->handle, 8,
					 @{$lang->parsespec});

    progress_info("referencing ".$file->name.", ".
		  $file->size." bytes ($lang)...");

    my $res = $lang->reserved();

    my $re = qr(
		(?m:^|[^a-zA-Z0-9_])		# Non-symbol chars.
		(_*[a-zA-Z][a-zA-Z0-9_]*)	# The symbol.
		\b
		)x;

    my $line = 1;
    while (1) {
	my ($btype, $frag) = $parse->nextfrag;
    
	last unless defined $frag;
	$btype ||= 'code';
	if ($btype eq 'code') {
	    
	    while ($frag =~ /\G.*?(?:(\n)|$re)/gc) {
		$line++ && next if defined $1;

		my $id = $2;

		next if $$res{$id};

		$index->add_usage($fileid, $line, $id);
	    }
	}
	else {
	    if ($btype eq 'include') {
		my @paths = 
		    $lang->resolve_include($context, $file, $frag);

		foreach my $path (@paths) {
		    $index->add_include($fileid, $path);
		}
	    }
	    $line += $frag =~ tr/\n/\n/;
	}
    }
}

sub hash_file {
    my ($context, $index, $hash, $tree, $file, $fileid, $rels) = @_;

    my $docid;
    if ($index->to_hash($fileid)) {
	my $handle = $file->handle();
	progress_info("hashing ".$file->name."[".$file->revision."] ".
		      $file->size." bytes...");
	my $doc = $hash->new_document($file->name);
	while (<$handle>) {
	    my $pos = 0;
	    # Latin-1 word characters.
	    foreach my $term (/([0-9a-zA-Z\300-\326\330-\366\370-\377]+)/g) {
		if ($term =~ /^[A-Z][^A-Z]*$/) {
		    $term = 'R'.lc($term);
		}
		else {
		    $term = lc($term);
		}
		next if length($term) > 128;
		$doc->add_posting($term, $.*100 + $pos++);
	    }
	}

	$docid = $hash->add_document($doc, [map {
	    $index->release_id($tree, $_) } @$rels]);
	$index->add_hashed_document($fileid, $docid);
    }
    else {
	$docid = $index->get_hashed_document($fileid);
	my $changed = $hash->add_release($docid, [map {
	    $index->release_id($tree, $_) } @$rels]);
	progress_mark($changed ? "+" : "-");
    }
}


my $tree = shift(@ARGV);
my @versions = @ARGV;

my $context = LXRng::Context->new('tree' => $tree);
LXRng::Lang->init($context);

my $index   = $context->config->{'index'};
my $hash    = $context->config->{'search'};
my $rep     = $context->config->{'repository'};

sub inventory_release {
    my ($tree, $version) = @_;

    print("\nrecording all files for $version...\n");

    my $iter = $rep->iterator($version);
    LXRng::Index::transaction {
	my $root = $rep->node('/', $version) or die "bad root";

	my $node;
	while (defined($node = $iter->next)) {
	    next if $node->name =~ /\.o$/;
	    my $fileid = $index->rfile_id($node, 1);
	    $index->add_filerelease($tree, $version, $fileid);
	}
    } $index;
}

sub index_pending {
    my ($tree) = @_;
    my $pending = $index->pending_files($tree);

    print("\nindexing ".(0+@$pending)." outstanding files...\n");
    LXRng::Index::transaction {
 	foreach my $p (@$pending) {
 	    my ($fileid, $path, $rev) = @$p;
 	    my $rels = $index->new_releases_by_file($fileid);
 	    next unless @$rels;
 	    my $node = $rep->node($path, $$rels[0], $rev);
 	    next unless $node;

 	    hash_file($context, $index, $hash, $tree, $node, $fileid, $rels);
 	    index_file($context, $index, $tree, $node, $fileid);
 	}
    } $index;

    print("\nreferencing ".(0+@$pending)." outstanding files...\n");
    LXRng::Index::transaction {
	foreach my $p (@$pending) {
	    my ($fileid, $path, $rev) = @$p;
	    my $rels = $index->new_releases_by_file($fileid);
	    next unless @$rels;
	    $context->release($$rels[0]); # Needed for include resolution.
	    my $node = $rep->node($path, $$rels[0], $rev);
	    next unless $node;
	    
	    LXRng::Index::transaction {
		reference_file($context, $index, $tree, $node, $fileid, $rels);
	    } $index;
	}
    } $index;

    my $done = $index->update_indexed_releases($tree);

    progress_info("releases ".join(", ", @$done)." done") if
	@$done;
}

if (@versions) {
    foreach my $version (@versions) {
	inventory_release($tree, $version);
    }
}
else {
    foreach my $version (reverse @{$context->all_releases}) {
	next if $index->_get_release($index->tree_id($tree), $version);
	inventory_release($tree, $version);
    }
}

index_pending($tree);
$hash->flush();