#!/usr/local/bin/perl4.036
# -*- perl -*-
#
# rolodex front end, by Andy Rabagliati <andyr@wizzy.com>
# http://www.wizzy.com/andyr/
# Do what you like with this code, but I would appreciate it if
# you kept my name in it as the original author.
#
# deals with a file like this :-

# Firstname: Andy
# Lastname: Rabagliati
# Email: andyr@wizzy.com
# ----

# and can select records by keyword, and print any combination of fields.
# Any keywords can be used - just no colons: in it.

$PAGETOP = 600;				# for Postscript
$pointsize = 10;

$HOME = $ENV{'HOME'};

$ROLODEX = "$HOME/.rolo";		# default database name

# COPYDEFAULT is the way an entry appears in the main database.
# purely for editing convenience, the keys can appear in any order.
# This is used with the command switch -copy.

@COPYDEFAULT =("lastname","firstname","homephone",
	         "workphone","address","city","state","zip",
	         "all","line","ret");

# LISTDEFAULT is the no-parameter output list, for those quick searches.

@LISTDEFAULT =('firstname', 'lastname', 'homephone');

# This is how entries are sorted in the main database
# They are sorted alphabetically, in this order.

# this should be an attempt at uniqueness - a number would work fine.

# You can also put another entry in the database, with the same values
# for these keys. In this case, rololist attempts to merge the two entries.
# It will flag conflicts with the -dups switch.

# if the records cannot be merged (identical key with diffreent values)
# then two records are created.

@MAINKEYS = ('lastname', 'firstname');

# Parse arguments.

sub Usage {

    printf(STDERR "Usage: $0 { -<switch> } { +<key> } { --<key> }\\\n");
    printf(STDERR "\t\t\t\t\t{ rolofiles }\n");
    printf(STDERR "\tPlaintext database lister, switches :-\n\n");
    printf(STDERR "\t-copy\t\toutput in format to create another database\n");
    printf(STDERR "\t-ret\t\tOutput keys on separate lines\n");
    printf(STDERR "\t-indent:n\tIndent everything by n\n");
    printf(STDERR "\t-dups\t\tFlag any duplicates\n");
    printf(STDERR "\t-ps:n\t\tPrint using PostScript, pointsize n, column in points\n");
    printf(STDERR "\t+<key>\t\tturns on printing for this key\n");
    printf(STDERR "\t+<key>:n\ttries to print exactly to column n\n");
    printf(STDERR "\t++<key>\t\tturns on printing in Italic for this key\n");
    printf(STDERR "\t++<key>:n\ttries to print Italic exactly to column n\n");
    printf(STDERR "\t+ret\t\tPut carriage return at this point in the output stream\n");
    printf(STDERR "\t+all\t\tPrint out all other keys, in any order, with keywords\n");
    printf(STDERR "\t--<key>\t\tselects only records with this field present\n");
    printf(STDERR "\t--<key>=<value>\tkey must contain substring value\n");
    exit(0);
}

foreach (@ARGV) {
    tr/A-Z/a-z/;		# lowercase all parameters
    if (/^\+\+([^:]+):([-0-9]+)$/) { # width specifier
	$printwidth{$1} = $2;
	push(@prints, $1);
	$format{$1} = "I";
    } elsif (/^\+([^:]+):([-0-9]+)$/) { # width specifier
	$printwidth{$1} = $2;
	push(@prints, $1);
	$format{$1} = "R";
    } elsif (/^\+\+([^:]+)$/) {	# no width specifier
	push(@prints, $1);
	$format{$1} = "I";
    } elsif (/^\+([^:]+)$/) {	# no width specifier
	push(@prints, $1);
	$format{$1} = "R";
    } elsif (/^--([^=]+)=(.*)$/) { # select on key=value
	$key = $1;
	$value = $2;
	$select{$key} = $value;
    } elsif (/^--([^=]+)$/) {	# select on key
	$key = $1;
	$select{$key} = "";
    } elsif (/^-indent:(\d+)/) { # indent everything
	$printindent = $1;
    } elsif (/^-info/) {
	$printinfo = 1;
    } elsif (/^-append=(\w+)/) {
	$append = $1;		# only append one thing at a time
    } elsif (/^-dups/) {
	$duplicates = 1;
	@prints = ('');
    } elsif (/^-ps:(\d+)/) {
	$postscript = 1;
	$pointsize = $1;
    } elsif (/^-copy/) {
	$printret = 1;
	$printkeys = 1;
	(!defined(@prints)) && (@prints = @COPYDEFAULT);
    } elsif (/^-ret/) {
	$printret = 1;
    } elsif (/^-keys/) {
	$printkeys = 1;
    } elsif (/^-$/) {
	push(@files,"stdin");
    } elsif (/^-/) {
	print STDERR "Unknown switch $_\n\n";
	&Usage();
    } else {
	push(@files, $_);
    }
}

if (!defined(@files)) {
    @files = ($ROLODEX);
}

if (! defined(@prints)) { @prints = @LISTDEFAULT; }

if ($printinfo) {
    print "Printing: ", join (" ", @prints),  "\n";
    print "Selecting: ", join (" ", keys (%select)), "\n";
    if (defined $append) { print "Appending: $append\n"; }
}
 
$/ = "\n----";			# separator
$* = 1;				# multi-line matches
$filecount = 0;			# treat first as master

while ($filecount < ($#files+1)) {
    open(FILE, "$files[$filecount]") || warn "Cannot open $files[$filecount]\n";
    $filecount++;
    while (<FILE>) {
	undef %record;
	foreach $line (split(/\n/)) {		# build record
	    if ($line =~ /([^:]*): *(.*)/) {
		$keyword = $1;
		$keyword =~ tr/A-Z/a-z/;
		$value = $2;
		if ($value ne "") {
		    $record{$keyword} = $value;
		}
	    }
	}
	$mainkey = "";
	foreach $key (@MAINKEYS) {		# create main key
	    if ($mainkey) {
		$mainkey = join('!', $mainkey, $record{$key});
	    } else {
		$mainkey = $record{$key};
	    }
	}
	if ($mainkey &&				# not an empty record
	    defined ($database{$mainkey})) {	# a duplicate ?
	    %current = split ('!', $database{$mainkey});
	    foreach $key (keys %record) {
		if (defined $current{$key} &&
				# both have this key, first one wins
		    $current{$key} ne $record{$key}) { # they are different
	            $duplicates &&
	               print "duplicate $key for $mainkey\t<",
			    $current{$key}, ">\t<", $record{$key}, ">\n" ;
		} else {
		    $current{$key} = $record{$key};
		    $database{$mainkey} = join('!', %current);
		}
	    }
	} elsif ($mainkey) {	# just add the record to the database
	    $database{$mainkey} = join('!',%record);
	}
    }
}
sub newline {
    $printcol && !$postscript && do {
	print "\n";
	print ' ' x $printindent;
	$printcol = 0;		# offset from indent
    };
    $postscript && do {
	print "NL\n";
	$printrow = $PAGETOP;
	$printcol = $printindent;
    };
}



if (defined $postscript) {
    $printrow = $PAGETOP;
    if (!defined $printindent) { $printindent = 40; }
    print qq~%! Rolodex printer

/R { /Helvetica findfont $pointsize scalefont setfont
     col row moveto show /col currentpoint pop store
} def
/Rf { /Helvetica findfont $pointsize scalefont setfont
     2 copy		    % width string width string
     stringwidth pop sub    % width string col
     row moveto		    % width string
     show		    % width
     /col exch store
} def

/I { /Helvetica-Oblique findfont $pointsize scalefont setfont
     col row moveto show /col currentpoint pop store
} def
/If { /Helvetica-Oblique findfont $pointsize scalefont setfont
     2 copy		    % width string width string
     stringwidth pop sub    % width string col
     row moveto		    % width string
     show		    % width
     /col exch store
} def

/NL { row 20 lt { showpage /row $PAGETOP store} if
     /row row $pointsize sub 1 sub store
     /col $printindent store
} def

/row $PAGETOP def
/pointsize $pointsize 1 add def
/col $printindent def
~
}

foreach $mainkey (sort {$a cmp $b} (keys %database)) {
    undef %record;
    %record = split ('!', $database{$mainkey});
    if (defined(%select)) {
	while (($key, $search) = each %select) {
				# --keyword
				# only print if keyword present
	    if (!$search && !defined($record{$key})) {
		undef %record;
	    } elsif			# --keyword=blah
				# print if blah is a substring of value
		(!defined($record{$key}) ||
		 ($search && ($record{$key} !~ /$search/i))) {
		    undef %record;
		}
	}
    }				# We don't even move if it is not here
    if (defined(%record) && defined(@prints))  {
	&newline();
	foreach $print (@prints) {
	    if ($print eq "all") {
		while (($key, $value) = each %record) {
		    $printkeys && do {
			$keyword = $key;
			$keyword =~ s/^(.)/\U$1/;
			$printcol += length($keyword)+2;
			print $keyword, ": ";
		    };
		    print $value;
		    $printcol += length($value);
		    if ($printret) {
			&newline();
		    } else {
			print " ";
			$printcol++;
		    }
		    delete $record{$key};
		}
	    }
	    elsif ($print eq "ret") { &newline(); }
	    elsif ($print eq "line") {
		(!$printret) && &newline();
		print "----\n";
	    }
	    elsif (defined($record{$print})) {
		$printkeys && do {
		    $keyword = $print;
		    $keyword =~ s/^(.)/\U$1/;
		    $printcol += length($keyword)+2;
		    print $keyword, ": ";
		};
		if ($postscript) {
		    if (defined $printwidth{$print}) {
			print "$printwidth{$print} ( $record{$print}) $format{$print}f\n";
		    } else {
			print "( $record{$print}) $format{$print}\n";
		    }
		} else {
		    if (defined $printwidth{$print}) {
			$width = $printwidth{$print} - $printcol;
			$printcol = $printwidth{$print};
		    } else {	# put no length in
			$width = "";
			$printcol += length($record{$print});
		    }
		    printf( "%${width}s", $record{$print});
		}
		delete $record{$print};
		if ($printret) {
		    &newline();
		} elsif (!$postscript) {
		    print " ";
		    $printcol++;
		}
	    } else {
		if (defined $printwidth{$print}) {
		    $width = $printwidth{$print} - $printcol;
		    $printcol = $printwidth{$print};
		} else {	# put no length in
		    $printcol += length($record{$print});
		}
		(! $postscript) && printf( "%${width}s", $record{$print});
	    }
	}		   
    }
}
!$postscript && print "\n";
 $postscript && print "showpage\n";