#!/usr/bin/perl -w

# Copyright (C) 2000-2008 Simon Huggins
# merge merges the sig and the tag but also merges the sig and the new style
# plugin things (i.e. all those silly files in $cfg{'tmpdir'}

# This program is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 2 of the License, or (at your option)
# any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with this program; if not, write to the Free Software Foundation, Inc., 59
# Temple Place, Suite 330, Boston, MA 02111-1307  USA

use strict;
use Text::Wrap;
use Encode;

$Text::Wrap::columns=defined $cfg{'maxlinelen'} ? $cfg{'maxlinelen'} : 72;
$cfg{'first'}  ||= "";
$cfg{'leader'} ||= "";

# Work out the correct locale to use if there is one otherwise we assume
# UTF-8 which shouldn't kill ascii people and anyone else should have
# correctly set locale.
my $fromcharset = 'UTF-8';
my $tocharset = 'UTF-8';

my @all_encodings = Encode->encodings(":all");
my $locale;
if (defined $ENV{'LC_ALL'}) {
	$locale = $ENV{'LC_ALL'};
} elsif (defined $ENV{'LC_CTYPE'}) {
	$locale = $ENV{'LC_CTYPE'};
} elsif (defined $ENV{'LANG'}) {
	$locale = $ENV{'LANG'};
}
if ($locale) {
	$locale =~ s/.*\.//;
	$locale = lc $locale;
	foreach (@all_encodings) {
		if ($locale eq lc $_) {
			$tocharset = $fromcharset = $_;
			last;
		}
	}
}

my $anal_merge_debug=0;

sub remove_space($) {
        my $text=shift;

# Remove whitespace at the end of lines but not newlines themselves.
# And don't remove the space if it comes directly after a -- which is
# anchored at the beginning of a line.

	$text =~ s/(?<!^--)[ 	]*$//mg;

# Remove any newlines from the very end of the string.
	$text =~ s/\n*$//;
        return $text;
}

sub merge($$) {
	my ($tag,$sig) = @_;
	my $chunk;
	my $notag=1;

	chomp($tag);
	$tag =~ s/\t/ /g;
	
	my ($plugin,$len,$align,$wascr);
	$wascr=0;

	while ($sig =~ /@([A-Za-z]?)(\*|(?:[1-9][0-9]*))([RC]?)@/) {
		# Ick.
		if (defined $3) {
			$plugin = $1;
			$len	= $2;
			$align	= $3;
		} elsif (not defined $2) {
			$len	= $1;
			$plugin = "";
			$align	= "L";
		} elsif ($2 =~ /^[RC]$/) {
			$plugin = "";
			$len 	= $1;
			$align	= $2;
		} else {
			$plugin = $1;
			$len	= $2;
			$align 	= "L";
		}
			
print STDERR "plugin,len,type = #$plugin#,#$len#,#$align#\n" if $anal_merge_debug;
		if ($plugin ne "") {
			$chunk = getplugin($plugin);
			print STDERR "Got plugin $plugin and $chunk\n"
				if $anal_merge_debug;
			$len = quotemeta $len; # escape * if it is *
			$sig =~ s/\@$plugin$len[RC]?@/$chunk/;
			print STDERR "Sig is now:\n$sig" if $anal_merge_debug;
			$chunk = "";
		} else {
			my $extra;
			$notag=0;
			if ($len ne "*") {
				$chunk =  substr $tag, 0, $len;
print STDERR "chunk,tag = #$chunk#,#$tag#".length($tag)." ".length($chunk)."\n"
	if $anal_merge_debug;
				if ($chunk =~ s/^([^\n]+)\n+(.*)$/$1/s) {
					$extra = $2;
					print STDERR "\$extra = [$extra]\n"
						if $anal_merge_debug;
				}
				if (length($chunk) < $len) {
					print STDERR "length(chunk) < $len\n"
						if $anal_merge_debug;
					$chunk=&chunksizealign($chunk,$len,$align);
					print STDERR "chunk = #$chunk#\n"
						if $anal_merge_debug;
				}
				if (length($tag) < $len + 1) {
					$tag= $extra ? $extra : "";
print STDERR "length(tag) < $len + 1, tag now = #$tag#(extra = #$extra#)\n"
	if $anal_merge_debug;
				} elsif (substr $tag, 0,  $len + 1 eq ' ') {
					$tag=substr $tag, $len + 1;
					$tag=$extra . $tag if defined $extra;
print STDERR "substr tag, 0, $len + 1 was a space.  tag now = #$tag#\n"
	if $anal_merge_debug;
				} else {
					$tag=substr $tag, $len;
					### Back up a word in $chunk
					$tag=$extra . $tag if defined $extra;
print STDERR "didn't break at space.  Backing up word.  tag now = #$tag#\n"
	if $anal_merge_debug;
					if ($chunk =~ s/(.*) (.*)$/$1/) {
						$tag=$2 . $tag;
						$chunk=&chunksizealign($chunk,$len,$align);
					}
print STDERR "If space in chunk then change chunk and add word to tag.".
"Reformat chunk now = #$chunk# (tag = #$tag#)\n" if $anal_merge_debug;
				}
			} else {
				$chunk = $tag;
				$tag = "";
			}
			$len = quotemeta $len; # escape * if it's *
			$sig =~ s/\@$plugin$len[RC]?@/$chunk/;
		}
	}
	$sig =~ s/@([0-9]+)[RC]?@/" " x $1/eg;
	$sig =~ s/@\*[RC]?@//g;
	$cfg{'notag'} = $notag;
	if ($tag and not $notag) {
		return undef;
	}
	return &remove_space($sig);
}

{
my %plugins;
sub getplugin($) {
	my $plugin = shift;

	my $count = 0;
	$count = $plugins{$plugin} if defined $plugins{$plugin};
	open(IN, "$cfg{'tmpdir'}/$plugin") or htagdie "$0: Could not open $cfg{'tmpdir'}/$plugin: $!\n";
	my $chunk;
	while ($count > 0) {
		$chunk = <IN>;
		$count--;
	}
	$plugins{$plugin} = $count+1;
	$chunk = <IN>;
	chomp $chunk;
	return $chunk;
}
}

{
my ($tag,$sig,$newsig);
open(SIG, "<$cfg{'tmpsigfile'}") or htagdie "$0: Could not open $cfg{'tmpsigfile'}: $!\n";
while(<SIG>) {
	$sig .= decode($fromcharset, $_);
}
close(SIG);
my $ret = 0;
if (grep { /\@NOTAG\@/ } $sig) {
	$tag="";
	$ret=26;
	$sig =~ s/\@NOTAG\@\n//;
} else {
	open(TAG, "<$cfg{'tmptagfile'}") or htagdie "$1: Could not open $cfg{'tmptagfile'}: $!\n";
	while(<TAG>) {
		$tag .= decode($fromcharset, $_);
	}
	close(TAG);
}
if (defined $sig and $sig =~ /@[A-Za-z]?\*|(?:[1-9][0-9]*)[RC]?@/) {
	$sig =  merge($tag,$sig);
} else {
	my $formatted_tag = Text::Wrap::wrap($cfg{'first'},$cfg{'leader'},$tag);
	$sig .= $formatted_tag;
	$sig =  &remove_space($sig);
	$cfg{'notag'} = 0;
}
if (defined $sig) {
	$sig = encode($tocharset, $sig);
	open(SIG, ">$cfg{'tmpsigfile'}") or htagdie "$0: Could not open $cfg{'tmpsigfile'}: $!\n";
	print SIG "\n" while $cfg{'newline'}--;
	print SIG $sig;
	close(SIG);
	return $ret;
} else {
	return(10);
}
}