#!/usr/bin/perl

# ptags - create a perl language tags file for use with vi
# Steve Kinzler, steve@kinzler.com, Oct 93/Sep 98/Dec 08
# https://kinzler.com/me/home.html#vi

use Getopt::Std;	$Getopt::Std::STANDARD_HELP_VERSION = 1;

$usage = "usage: $0 [ -anNsvw ] [ -f tagsfile ] [ file ... ]
	-a	append output to the tagsfile, which remains unsorted
	-n	tag files with their basenames at line 1
	-N	tag files with their basenames but no tag address
	-s	include a 'tag file sorted' flag if appropriate
	-v	tag variables assigned at the beginning of a line
	-w	suppress warning diagnostics
	-f	use the given tagsfile (default ./tags)
Warning, with -N, having no tag address creates an invalid tagsfile,
but vim may still accept it after giving an error message, and then
proceed to jump to the file at the line number in any saved view.\n";

die $usage if ! getopts('hanNsvwf:') || $opt_h;

$file = (defined $opt_f) ? $opt_f : 'tags';

while (<>) {
	chop;
	if (($opt_n || $opt_N) && $. == 1 && $ARGV ne '-') {
		$argv =  $ARGV;
		$argv =~ s,.*/,,;
		$argv =~ s,\..*,,;
		&save($argv, ($opt_N) ? '' : 1) if $argv ne '';
	}
	&save($2, $_) if /^\s*sub\s+(\w*')?(\w+)/;
	&save($1, $_) if /^\s*(\w+):/;
	&save($2, $_) if $opt_v &&
			 /^(chom?p\s*\(\s*)?[%\@\$](\w+)\s*=([^=!~]|$)/;
	close ARGV if eof || /^__END__$/;
}

open(TAGS, (($opt_a) ? '>> ' : '> ') . $file) ||
	die "$0: cannot open $file ($!)";
print TAGS "!_TAG_FILE_SORTED\t1\t1\n" if $opt_s && ! $opt_a;
foreach $tag (sort keys %output) {
	foreach (split(/\n/, $output{$tag})) {
		print TAGS "$tag\t$_\n";
	}
}
close TAGS;

sub save {
	($tag, $_) = @_;

	warn "$0: warning, duplicate entry for $tag in $ARGV line $.\n"
		if $output{$tag} && ! $opt_w;

	s,[\*\./\[\\\]],\\$&,g;
	$_ = "/^$_\$/" unless /^\d*$/;
	$output{$tag} .= (($output{$tag}) ? "\n" : '') . "$ARGV\t$_";
}