#!/usr/bin/perl
#
#  papfilter - filter an abstract in prep inclusion into proceedings book
#
#  written by Raymond Plante for ADASS VIII
#
($prog = $0) =~ s!.*/!!;
#$ENV{'PERL_LIB'} = "$ENV{'HOME'}/usr/lib/perl" 
$ENV{'PERL_LIB'} = "/System/Library/Perl" 
    if ($ENV{'PERL_LIB'} eq '');

unshift(@INC, ".", $ENV{'PERL_LIB'});
require "getopts.pl";
require "texscan.pl";
require "error.pl";

@skip = ("documentstyle\\[[^]]+\\]{[^}]+}", 
	 "begin\\s*{document}", "end\\s*{document}", 
         "documentclass\\[[^]]+\\]{[^}]+}",
         "usepackage\\[[^]]+\\]{[^}]+}",
         "usepackage{[^}]+}", 
	 "email{[^}]+}", "contact{[^}]+}", "paspbook", 
	 "paspheader");
$modifier = "filt";

# process switches
&Getopts('qsvrCd:m:');
$verbose = $true if ($opt_v);
$quiet = $true if ($opt_q);
$silent = $quiet = $true if ($opt_s);
$NoComments = $true if ($opt_C);
$replace = $true if ($opt_r);
$modifier = $opt_m if ($opt_m);

$modifier = "$$" if ($replace);
$writeToFile = ($opt_d || $opt_m || $replace);

foreach $file (@ARGV) {

    &inform("Filtering $file...") if ($verbose);

    ($ifile = $file) =~ s!^.*/!!;
    open(INTEX, "$file") || &fatal("$file: $!");
    $intromatter = $true;
    @authForTOC = ();

    if ($writeToFile) {
	if ($opt_d) {
	    mkdir("$opt_d", 0755) if (! -e "$opt_d");
	    &fatal("$opt_d: Not a directory with write permission") 
		if (! -d $opt_d || ! -w $opt_d);
	}
	($ext) = ($ifile =~ /(\.[^\.]+)$/);
	($ofile = $ifile) =~ s/\.[^\.]+$//;
	$ofile = "$opt_d/$ofile" if ($opt_d);
	$ofile .= "_$modifier" if ($opt_m || ! $opt_d);
	$ofile .= $ext;

	open(OUTTEX, ">$ofile") || &fatal("$ofile: $!");
	select(OUTTEX);
#        print "{\n";
    }

    $endfound = $false;
    LINE: while ($line = <INTEX>) {

	# skip comment lines
	next LINE if ($line =~ /^\s*%/);  
	($line, $tmp) = remove_TeXcomment($line);

	# check to see if line contains a skip macro
	foreach $macro (@skip) {
	    if ($line =~ /\\$macro/) {
		($pre, $match, $post, $stat) = &grep_TeXmacro($macro, $line);
		$line = "$pre $post" if ($stat);
	    }
	}

	# do any substitutions
	$line = &substituteMacro("begin\\s*{\\s*document\\s*}", 
				 "bgroup", $line) 
	    if ($line =~ /\\begin\s*{\s*document\s*}/);

	if ($intromatter) {

	    # remember the authors' names for the table of contents
	    if ($line =~ /\\(p?aindex)/) {
		$line = &noteAuthor($1, $line);
	    }

	    # set the authors' names into the table of contents
	    if ($line =~ /\\begin{\s*abstract\s*}/) {
		$line = &setAuthorsInTOC($line);
		$intromatter = $false;
	    }
	}

	# convert keywords
	if ($line =~ /\\keywords/) {
	    $line = &convertKeywords($line);
	}

	# collapse consecutive blank lines
	if ($line =~ /^\s*$/) {
	    next LINE if ($blank);
	    $blank = $true;
	}
	elsif ($blank) {
	    $blank = $false;
	}

	if ($line =~ /\\end\s*{\s*document\s*}/) {
	    $line = "\\clearpage$line";
	    $line = &substituteMacro("end\\s*{\\s*document\\s*}", 
				     "egroup", $line);
	    $line .= "\n" if ($line !~ /\n$/);
	    $endfound = $true;
	}

	$line .= "\n" if ($line !~ /\n$/);
	print $line;
	last if ($endfound);
    }
#    print "}\n";

    close(INTEX);
    close(OUTTEX) if ($writeToFile);

    if ($replace) {
	$btin = "mv -f $ofile $file";
	inform($btin) if ($verbose);
	$btout = `$btin 2>&1`;  $stat = $?/256; chop $btout;
	&fatal("Failed to overwrite $file ($btout)\n  Result is in $ofile")
	    if ($stat);
	$btin = "chmod a-w $file";
	inform($btin) if ($verbose);
	$btout = `$btin 2>&1`;  $stat = $?/256; chop $btout;
    }
}
0;

sub convertKeywords {
    local($line) = @_;
    local($nxt, $tmp, $comm);
    local($pre,$match,$post,$stat);
    local($out, $val, $term);

    ($pre, $match, $post, $stat) = &grep_TeXmacro("keywords", $line);
    return $line if (! $stat);

    $out = $pre;

    $val = "";
    $nxt = $post;
    ($match, $post, $stat) = &gettexitem($nxt);
    while ($stat != 0) {
	return $line if ($stat < 0);
	return $line if (! ($nxt = <INTEX>));
	$val .= $match;
	($match, $post, $stat) = &gettexgroup($nxt);
    }
    $val .= $match;
    $val =~ s/^\s*\{\s*//;
    $val =~ s/\s*\}\s*$//;

    foreach $term (split(/\s*,\s*/, $val)) {
	# to allow a colon that doesn't indicate a sublevel, use a
	# double colon
	$term =~ s/::\s*/!!/g;
	$term =~ s/:\s*/!/g;
	$term =~ s/!!\s*/:/g;
	$out .= "\\sindex{$term}\n";
    }
    chop $out;
    $out .= $post;

    return $out;
}

sub noteAuthor {
    local($authmacro, $line) = @_;
    local($pre,$match,$post,$stat);
    local(@names) = ();
    local($name) = '';

    ($pre, $match, $post, $stat) = &TeXmacro_arg($line, $authmacro, 1, $true);
    return $line if (! $stat);
    $match = "\\textbf{MISSING AUTHOR}" if ($match =~ /^\s*$/);
    $match =~ s/^[^@]*@//;

    @names = split(/\s*,\s*/, $match);
    $name[1] = "\\textbf{MISSING FIRST NAME}" if (@names < 2);
    $name .= $names[1];
    $name .= ' ' if ($name ne '');
    $name .= $names[0];
    $name .= ", " . join(", ", @names[2 .. $#names]) if (@names > 2);
    $name =~ s/\. /.\~/g;
    push(@authForTOC, $name);

    return $line;
}

sub setAuthorsInTOC {
    local($line) = @_;
    local($pre,$match,$post,$stat);
    local($out) = '';

    return $line if (@authForTOC == 0);
    if ($line =~ /\\begin{\s*abstract\s*}/) {
	$pre = $`;
	$match = $&;
	$post = $';

	$pre = '' if ($pre =~ /^\s+$/);
	$out = $pre;
	$out .= "\n" if ($out ne '');

	$out .= "\\authortocentry{";
	$out .= join(", ", @authForTOC[0 .. $#authForTOC-1]) 
	    if (@authForTOC > 1);
	$out .= "," if (@authForTOC > 2);
	$out .= " and " if (@authForTOC > 1);
	$out .= "$authForTOC[$#authForTOC]}\n";

	$line = "$out$match$post";
    }
    return $line;
}

sub TeXmacro_arg {
#
#  extract the substring from the input line containing the requested macro.
#
    package texscan;

    $main'tex_emsg = ''; #'
    local($input,$macro,$argnum,$getmore) = @_;
    $getmore = $false if ($getmore eq '');
    local($nobrace) = $true;
    if ($argnum < 0) {
	$argnum *= -1;
	$nobrace = $false;
    }
    local($pre,$match,$post,$out,$tmp,$a,$nxt);
    local($intex) = "main'INTEX";

    ($pre, $match, $post, $stat) = &main'grep_TeXmacro($macro, $input); #'
    return ($input, '', '', -1) if (! $stat);

    $out = "$pre$match";
    $nxt = $post;
    $val = '';

    for($a=0; $a < $argnum; $a++) {
	($match, $post, $stat) = &main'gettexitem($nxt);                #'

	while ($stat != 0) {
	    return ("$out$nxt", '', '', -3) if ($stat < 0);
	    return ("$out$nxt", '', '', -2) if ($stat > 0 && ! $getmore);
	    $val .= $match;
	    return ($out, $val, '', -2) if (! ($nxt = <$intex>));
	    ($match, $post, $stat) = &main'gettexgroup($nxt);            #'
	    if ($stat == 0) {
		$tmp = &main'esc_TeXmchars($match);                      #'
		if ($nxt =~ /^$tmp([$scc{'EGROUP'}])/ ) {
		    $match .= "$1";
		}
	    }
	}
	$val .= $match;

	if ($a < $argnum-1) {
	    $out .= $val;
	    $val = '';
	}
    }

    if ($nobrace) {
	$val =~ s/^\s*\{\s*//;
	$val =~ s/\s*\}\s*$//;
    }

    return ($out, $val, $post, 1);
}

sub substituteMacro {
    local($from, $to, $line) = @_;
    local($pre, $match, $post, $stat) = &grep_TeXmacro($from, $line);

    $line = "$pre\\$to$post" if ($stat);
    return $line;
}