#!/usr/local/bin/perl -w
#
#	srtphone
#
#	Create a printed phone list based upon the lists specified.
#

use strict;
use Getopt::Long;

use vars qw(%Args %Attr @AttrOrder $Version);

$Version = 'srtphone v0.10 regan@ao.com';

%Args =
    (
    	'columns'	=>	2,		# Number of colums for output
	'datafile'	=>	$ENV{'HOME'} . '/Notes/phone.dat',
	'lists'		=>	'NORMAL',	# Lists to print
	'width'		=>	96,		# Width in columns
	'lines'		=>	60,		# Lines on the page
	'title'		=>	'Phone Book',	# Title
    );

# List the titles we use for attributes.  If not listed, then
# we just use the tag name followed by a colon.
%Attr =
    (
    	'Name'		=>	'',
	'Address1'	=>	'Address:',
	'Address2'	=>	'',
	'WorksAt'	=>	'Works at:',
	'WorkPhone'	=>	'Work Phone:',
	'CellPhone'	=>	'Cellular Phone:',
	'Comment1'	=>	'Comment:',
	'Comment2'	=>	'',
    );
@AttrOrder = qw(Name E-mail Address1 Address2 WorksAt
		Phone WorkPhone CellPhone Pager Modem Fax
		Reference Comment1 Comment2 Anniversary);


###
###	Main program
###

    my($arg, @lines, %phone);

    GetOptions(\%Args, "columns=i", "datafile=s", "lists=s",
    	"width=i", "lines=i", "title=s");

    # Get an appropriate r.e. for matching on the list.
    # Note that a good user might be able to specify a r.e. themself.
    if (defined($ARGV[0]))
    	{
	$Args{'lists'} = "";
	for $arg (@ARGV)
	    {
	    $Args{'lists'} .= "$arg ";
	    }
	}

    $Args{'lists'} =~ s/\s+$//;			# Remove trailing whitespace.
    $Args{'lists'} =~ s/all/./;			# "all" matches anything
    $Args{'lists'} =~ s/\s+/|/g;		# Take any pattern mentioned

    # Read in the phone book
    %phone = ReadPhoneBook();

    # Create a list of lines for the phone book
    @lines = GenerateLines(%phone);

    # Print the phonebook
    PrintPhoneBook(@lines);


###
###	ReadPhoneBook
###
###	Read the phone book.
###
###	Read each record of the phone book.  If the record matches
###	the lists we want to print, keep the record, otherwise toss
###	it.
###
sub ReadPhoneBook
    {
    my(%entry, %phone, $sort);

    open(DATA, "<$Args{'datafile'}") || die "Cannot open $Args{'datafile'}: $!";
    while (<DATA>)
    	{
	chomp;
	next if (/^\s*#/ || /^\s*$/);
	if (/^%%/)
	    {
	    if (defined($entry{'Lists'}) && $entry{'Lists'} =~ /$Args{'lists'}/)
		{
		$sort = $entry{'SortAs'} || $entry{'Name'};
		$entry{'Name'} = $entry{'ResidenceName'} || $entry{'Name'};
		$phone{$sort} = join("\n", %entry);
		}
	    undef %entry;
	    }
	elsif (/^([^=]*?)\s*=(.*)/)
	    {
	    $entry{$1} = $2;
	    }
	else
	    {
	    print STDERR "Bad line: $_\n";
	    }
	}
    close DATA;
    return %phone;
    }


###
###	GenerateLines
###
###	Go through the phone book, and generate lines for each
###	entry.
###
sub GenerateLines
    {
    my(%phone) = @_;
    my($attr, %entry, $key, $lastletter, @lines, $title);

    $lastletter = " ";
    for $key (sort keys %phone)
    	{
	# Put out a title line if appropriate.
	if ($key !~ /^$lastletter/i)
	    {
	    ($lastletter = $key) =~ s/(.).*/$1/;
	    push(@lines, "    ---------- " . $lastletter x 5 . " ----------");
	    }

	%entry = split(/\n/, $phone{$key});
	for $attr (@AttrOrder)
	    {
	    $title = "$attr:";
	    $title = $Attr{$attr} if (defined($Attr{$attr}));
	    push(@lines, sprintf("%-16.16s $entry{$attr}", $title))
	    		if (defined($entry{$attr}));
	    }
	push(@lines, "");
	}
    return @lines;
    }


###
###	PrintPhoneBook
###
###	Go through the set of lines and make a listing.
###
use vars qw(@Page $CurCol $CurLine $CurPage);
sub PrintPhoneBook
    {
    my(@lines) = @_;
    my(@entry, $line);

    $CurCol = $CurLine = $CurPage = 0;

    for $line (@lines)
    	{
	if ($line eq "")
	    {
	    PrintEntry(@entry, "");
	    undef @entry;
	    }
	push(@entry, $line);
	push(@entry, "") if ($line =~ /-------/);
	}
    PrintPage();
    }


###
###	PrintEntry
###
###	Given an entry for the phone book, ensure that it gets
###	printed on a reasonable page.
###
sub PrintEntry
    {
    my(@entry) = @_;
    my($line);

    # See if this fits on the current column.  If not advance the
    # column or page as appropriate.
    if (scalar(@entry) + $CurLine > $Args{'lines'})
    	{
	$CurLine = 0;
	PrintPage() if (++$CurCol >= $Args{'columns'});
	}

    # Lay in the data for this entry.
    for $line (@entry)
    	{
	$Page[$CurCol * $Args{'lines'} + $CurLine++] = $line;
	}
    }


###
###	PrintPage
###
###	Print the information in the page buffer.
###
sub PrintPage
    {
    my($buffer, $col, $fmt, $line, $text, $width);

    # Determine the format to use
    $width = $Args{'width'} / $Args{'columns'};
    $fmt = "%-$width.${width}s ";

    $CurPage++;
    print "Page $CurPage            $Args{'title'}\n\n";

    for ($line = 0; $line < $Args{'lines'}; $line++)
    	{
	$buffer = "";
	for ($col = 0; $col < $Args{'columns'}; $col++)
	    {
	    $text = $Page[$col * $Args{'lines'} + $line] || "";
	    $buffer .= sprintf($fmt, $text);
	    }
	$buffer =~ s/\s*$//;
	print "$buffer\n";
	}

    print "\f";
    $CurCol = $CurLine = 0;
    undef @Page;
    }