#!/packages/bin/perl -w

require 5.004;

# Set DEBUG equal to 1 to print debugging information
local ($DEBUG) = 0;
if ($DEBUG == 1) {
  $| = 1;                                       # Force prints when debugging
  use Data::Dumper;                             # Bring in the data dumper also
}

local ($VERSION) = "1.1";			# Current version
local ($COPYRIGHT) = "
Copyright (c) 1999, 2003 Xerox Corporation.  All Rights Reserved.

Permission to use, copy, modify  and  distribute  without  charge
this  software,  documentation, images, etc. is granted, provided
that this copyright and the author's name is retained.
    
A fee may be charged for this program ONLY to recover  costs  for
distribution  (i.e.  media costs).  No profit can be made on this
program.
        
The author assumes no responsibility for  disasters  (natural  or
otherwise) as a consequence of use of this software.
            
Adam Stein (adam\@scan.mc.xerox.com)
";

use vars qw($COPYRIGHT $VERSION);

use PDA::Pilot;

# Range of starting last name letters
use constant RANGES => ("ABC", "DEF", "GHI", "JKL", "MNO", "PQRS", "TUV",
			"WXYZ");

# Global variables
local ($program);				# Name of current program

# Categories to save entries from
local (@savecat) = ("Family", "Friends");

# Address fields we need to get
local ($LASTNAME) = 0;
local ($FIRSTNAME) = 1;
local ($STREET) = local ($ADDRESS_START) = 2;
local ($ADDRESS_END) = 5;
local ($PHONE_START) = 6;
local (@savefields) = ("Last name", "First name", "Address", "City", "State",
		       "Zip Code", "Phone 1", "Phone 2", "Phone 3", "Phone 4",
		       "Phone 5", "Phone 6", "Phone 7", "Phone 8");

# Order we want the phone fields to be
local ($HOME) = 0;
local (@phoneorder) = ("Home", "Work", "Mobile", "Pager", "Fax");

# Palm address database
local ($DEFDBFILE) = "$ENV{'HOME'}/.pilotmgr/Backup/LatestArchive/AddressDB.pdb";

MAIN:
{
  my (@categories),				# Categories in numerical form
  my ($dbfile),					# Address book DB filename
  my (@fields),					# Fields in numerical form
  my ($pf),					# Palm file pointer
  my (@phone),					# Phone fields in numerical form
  my (%records);				# All the records to save

  # Set name of current program
  ($program = $0) =~ s#.*/##;

  # If we have the one command line argument, then
  # that's the name of the address book DB file, otherwise
  # we go with our default.
  if (scalar(@ARGV) == 0) {
    $dbfile = $DEFDBFILE;
  } elsif (scalar(@ARGV) == 1) {
    $dbfile = $ARGV[0];
  } else {
    die "usage: $program [db_filename]\n";
  }

  # Make sure the datbase file exists
  open(DBFILE, $dbfile) || die "$program: can't open <$dbfile>\n";
  close(DBFILE);

  # Verify that the file we have is the Address Book database
  &IsAddressDB($dbfile, \$pf) ||
	die "$program: not a Palm Address Book database\n";

  # Map category names to the numbers used in the database records
  &MapCategories($pf, \@savecat, \@categories);

  # Map the fields we want to array indices used in the database records
  &MapFields($pf, \@savefields, \@fields);

  # Map the phone stuff
  &MapPhone($pf, \@phoneorder, \@phone);

  # Fetch all the addresses we are interested in
  &ReadRecords($pf, \@categories, \@fields, \@phone, \%records);

  # Create FrameMaker file
  &CreateFrameFile(\%records);
}

sub IsAddressDB {
  my ($filename) = shift,			# File to check
  my ($pf) = shift,				# Palm file pointer
  my ($info);					# Palm database file info

  $$pf = PDA::Pilot::File::open($filename);
  $info = $$pf->getDBInfo;

  return($$info{'name'} eq "AddressDB");
}

sub MapCategories {
  my ($pf) = shift,				# Palm file pointer
  my ($savecat) = shift,			# Categories to save
  my ($categories) = shift,			# Catories in numerical form
  my ($names);					# Category names (in order)

  $names = PDA::Pilot::Address::UnpackAppBlock($pf->getAppBlock)->{'categoryName'};

  foreach (@$savecat) {
    push(@$categories, &GetIndex($_, $names));
  }
}

sub MapFields {
  my ($pf) = shift,				# Palm file pointer
  my ($savefields) = shift,			# Fields to save
  my ($fields) = shift,				# Fields in numerical form
  my ($indx),					# Index thru phone labels
  my ($labels),					# Field labels
  my ($plabels);				# Phone labels

  $labels = PDA::Pilot::Address::UnpackAppBlock($pf->getAppBlock)->{'label'};
  $plabels = PDA::Pilot::Address::UnpackAppBlock($pf->getAppBlock)->{'phoneLabel'};

  $indx = 0;
  foreach (@$savefields) {
    if (/Phone/) {
      push(@$fields, &GetIndex($$plabels[$indx++], $labels));
    } else {
      push(@$fields, &GetIndex($_, $labels));
    }
  }
}

sub MapPhone {
  my ($pf) = shift,				# Palm file pointer
  my ($phoneorder) = shift,			# Phone fields in order
  my ($phone) = shift,				# Phone fields in numerical form
  my ($labels);					# Phone labels

  $labels = PDA::Pilot::Address::UnpackAppBlock($pf->getAppBlock)->{'phoneLabel'};

  foreach (@$phoneorder) {
    push(@$phone, &GetIndex($_, $labels));
  }
}

sub ReadRecords {
  my ($pf) = shift,				# Palm file pointer
  my ($categories) = shift,			# Categories to save
  my ($fields) = shift,				# Fields in numerical form
  my ($phone) = shift,				# Phone fields in numerical form
  my ($records) = shift,			# All the records to save
  my ($address),				# Address of person(s)
  my ($name),					# Name to use as hash key
  my ($numbers),				# Phone numbers, email, etc.
  my ($pindx),					# Index into phone array
  my ($range),					# Letter range name is in
  my ($recnum),					# Record number
  my ($record);					# Database record

  for($recnum = 0;$recnum < $pf->getRecords;++$recnum) {
    $record = PDA::Pilot::Address::Unpack($pf->getRecord($recnum));

    if (grep {$record->{'category'} == $_} @$categories) {
      $entry = $record->{'entry'};

      # Construct the name (to be used as the hash key)
      $name = "";	# In case we don't nave a name

      $name = $$entry[$$fields[$LASTNAME]]
	if(defined($$entry[$$fields[$LASTNAME]]));

      # Need to quote "'" characters to NOT confuse FrameMaker
      $name = quotemeta($name);

      &AddOnField($$entry[$$fields[$LASTNAME]],
		  $$entry[$$fields[$FIRSTNAME]], \$name);

      # Construct the address
      $address = "";	# In case we don't have an address

      $address .= $$entry[$$fields[$STREET]]
	if (defined($$entry[$$fields[$STREET]]));

      for($loop = $ADDRESS_START + 1;$loop < ($ADDRESS_END + 1);++$loop) {
        &AddOnField($$entry[$$fields[$loop - 1]], $$entry[$$fields[$loop]],
		    \$address);
      }

      # Change any newlines to ", "
      $address =~ s/\n/, /g;

      # Construct list of phone numbers in order
      $numbers = "";			# In case we don't have any

      for($pindx = 0;$pindx < scalar(@$phone);++$pindx) {
        $indx = 0;

	foreach $label (@{$record->{'phoneLabel'}}) {
	  if ($label == $$phone[$pindx]) {
	    # Add phone numbers to list
	    if (defined($$entry[$$fields[$PHONE_START + $indx]])) {
	      $numbers .= "\n" if ($numbers ne "");

	      if ($pindx == $HOME) {
	        $numbers .= $$entry[$$fields[$PHONE_START + $indx]];
	      } else {
		$numbers .= &FixNumID($$entry[$$fields[$PHONE_START + $indx]],
				      $phoneorder[$pindx]);
	      }
	    }
	  }

	  ++$indx;
	}
      }

      # Figure out which range this record belongs in
      if (substr($name, 0, 1) =~ /(a|b|c)/i) {
	$range = "ABC";
      } elsif (substr($name, 0, 1) =~ /(d|e|f)/i) {
	$range = "DEF";
      } elsif (substr($name, 0, 1) =~ /(g|h|i)/i) {
	$range = "GHI";
      } elsif (substr($name, 0, 1) =~ /(j|k|l)/i) {
	$range = "JKL";
      } elsif (substr($name, 0, 1) =~ /(m|n|o)/i) {
	$range = "MNO";
      } elsif (substr($name, 0, 1) =~ /(p|q|r|s)/i) {
	$range = "PQRS";
      } elsif (substr($name, 0, 1) =~ /(t|u|v)/i) {
	$range = "TUV";
      } elsif (substr($name, 0, 1) =~ /(w|x|y|z)/i) {
	$range = "WXYZ";
      } else {
	$range = "UNKNOWN";
      }

      # Store record
      $$records{$range}{$name} = "$address|$numbers";
    }
  }
}

sub GetIndex {
  my ($string) = shift,				# String to find
  my ($array) = shift,				# Array to search thru
  my ($indx);					# Index into category array

  # Return the index of the array entry that matches $string
  for($indx = 0;$indx < scalar(@$array);++$indx) {
    last if ($string eq $$array[$indx]);
  }

  return($indx);
}

sub AddOnField {
  my ($prev) = shift,				# Previous field
  my ($next) = shift,				# Next field
  my ($value) = shift;				# Field values

  if (defined($next)) {
    if (defined($prev)) {
      $$value .= ", $next";
    } else {
      $$value .= $next;
    }
  }
}

sub FixNumID {
  my ($entry) = shift,				# Phone number entry to fix
  my ($id) = shift,				# Phone number identifier
  my ($numwithid);				# Phone number with ID

  # Add the ID in brackets.  If there is already brackets,
  # add it as the last word within the brackets
  if ($entry =~ /^([^[]*)\[([^]]*)/) {
    $numwithid = "[$2 $id]\n$1";
  } else {
    $numwithid = "[$id]\n" . $entry;
  }

  return($numwithid);
}

sub CreateFrameFile {
  my ($records) = shift,			# All the saved records
  my (@labels),					# Lables to put on page
  my ($loop),					# Loop thru tables
  my (@tlist);					# List of table IDs

  @labels = RANGES;

  print "<MIFFile 6.00>\n";

  # Set up formats
  &ParagraphFormats;
  &TableFormats;

  # Set up the table lists with data
  &TableList($records, \@tlist);

  # Master Page description
  &MasterPage;

  # Pages
  foreach $loop (0..$#tlist) {
    &Page($loop + 1, $labels[$loop]);
  }

  # Text flows on each page
  foreach $loop (0..$#tlist) {
    &TextFlow($loop + 1, $tlist[$loop]) if ($tlist[$loop] != -1);
  }

  # Create page header
  &Header;

  print "# End of MIFFile\n";
}

sub ParagraphFormats {
  # Paragraph formats
  print "<PgfCatalog\n",
	" <Pgf\n",
	"  <PgfTag `CellHeading'>\n",
	"  <PgfAlignment Center>\n",
	"  <PgfFont\n",
	"   <FWeight `Bold'>\n",
	"   <FSize 14.0 pt>\n",
	"  > # end of PgfFont\n",
	" > # end of Pgf\n",
	" <Pgf\n",
	"  <PgfAlignment Left>\n",
	"  <PgfTag `CellBody'>\n",
	"  <PgfFont\n",
	"   <FWeight `Regular'>\n",
	"   <FSize 12.0 pt>\n",
	"  > # end of PgfFont\n",
	" > # end of Pgf\n",
	"> # end of PgfCatalog\n";
}

sub TableFormats {
  # Table formats
  print "<TblCatalog\n",
	"<TblFormat\n",
	" <TblTag `Phone List'>\n",
	" <TblColumn\n",
	"  <TblColumnNum 0>\n",
	"  <TblColumnWidth  2.156\">\n",
	"  <TblColumnH\n",
	"   <PgfTag `CellHeading'>\n",
	"  > # end of TblColumnH\n",
	"  <TblColumnBody\n",
	"   <PgfTag `CellBody'>\n",
	"  > # end of TblColumnBody\n",
	" > # end of TblColumn\n",
	" <TblColumn\n",
	"  <TblColumnNum 1>\n",
	"  <TblColumnWidth  3.437\">\n",
	"  <TblColumnH\n",
	"   <PgfTag `CellHeading'>\n",
	"  > # end of TblColumnH\n",
	"  <TblColumnBody\n",
	"   <PgfTag `CellBody'>\n",
	"  > # end of TblColumnBody\n",
	" > # end of TblColumn\n",
	" <TblColumn\n",
	"  <TblColumnNum 2>\n",
	"  <TblColumnWidth  1.297\">\n",
	"  <TblColumnH\n",
	"   <PgfTag `CellHeading'>\n",
	"  > # end of TblColumnH\n",
	"  <TblColumnBody\n",
	"   <PgfTag `CellBody'>\n",
	"  > # end of TblColumnBody\n",
	" > # end of TblColumn\n",
	" <TblAlignment Right>\n",
	" <TblPlacement Anywhere>\n",
	" <TblLRuling `Thick'>\n",
	" <TblBRuling `Thick'>\n",
	" <TblRRuling `Thick'>\n",
	" <TblTRuling `Thick'>\n",
	" <TblColumnRuling `Thick'>\n",
	" <TblXColumnRuling `Thick'>\n",
	" <TblBodyRowRuling `Thin'>\n",
	" <TblXRowRuling `Thin'>\n",
	" <TblHFRowRuling `Thin'>\n",
	" <TblSeparatorRuling `Thick'>\n",
	" <TblRulingPeriod 4>\n",
	" <TblLastBRuling No>\n",
	" > # end of TblFormat\n",
	"> # end of TblCatalog\n";
}

sub TableList {
  my ($records) = shift,			# All the saved records
  my ($tlist) = shift,				# List of Table IDs
  my ($indx),					# Index into ranges
  my ($range),					# Range of first letter in name
  my (@ranges),					# Ranges of letters
  my ($tableID);				# Table ID

  $indx = 0;
  $tableID = 1;
  @ranges = RANGES;

  foreach $range (sort(keys(%$records))) {
    # Mark as missing those ranges not found
    while ($range ne $ranges[$indx]) {
      $$tlist[$indx++] = $tableID;

      &Table(undef, $tableID++);
    }

    $$tlist[$indx++] = $tableID;

    &Table($$records{$range}, $tableID++);
  }
}

sub Table {
  my ($records) = shift,			# All the saved records
  my ($tableID) = shift,			# Table ID
  my ($addr),					# Address
  my ($name),					# Name
  my ($phone);					# Phone number(s)

  # Table list
  print "<Tbls\n",
	" <Tbl\n",
	"  <TblID $tableID>\n",
	"  <TblTag `Phone List'>\n",
	"  <TblNumColumns 3>\n",
	"  <Unique ", 990000+$tableID, ">\n",
	"  <TblH\n",
	"   <Row\n",
	"    <Cell\n",
	"     <CellContent\n",
	"      <Para\n",
	"       <Unique 998211>\n",
	"	<PgfTag `CellHeading'>\n",
	"       <ParaLine\n",
	"        <String `Name'>\n",
	"       > # end of ParaLine\n",
	"      > # end of Para\n",
	"     > # end of CellContent\n",
	"    > # end of Cell\n",
	"    <Cell\n",
	"     <CellContent\n",
	"      <Para\n",
	"       <Unique 998213>\n",
	"	<PgfTag `CellHeading'>\n",
	"       <ParaLine\n",
	"        <String `Address'>\n",
	"       > # end of ParaLine\n",
	"      > # end of Para\n",
	"     > # end of CellContent\n",
	"    > # end of Cell\n",
	"    <Cell\n",
	"     <CellContent\n",
	"      <Para\n",
	"       <Unique 998215>\n",
	"	<PgfTag `CellHeading'>\n",
	"       <ParaLine\n",
	"        <String `Telephone'>\n",
	"       > # end of ParaLine\n",
	"      > # end of Para\n",
	"     > # end of CellContent\n",
	"    > # end of Cell\n",
	"   > # end of Row\n",
	"  > # end of TblH\n",
	"  <TblBody\n";

  # Insert info into table
  if (defined($records)) {
    foreach $name (sort(keys(%$records))) {
      ($addr, $phone) = split(/\|/, $$records{$name});

      &BodyRow($addr, $name, $phone);
    }
  } else {
    my ($loop);

    foreach $loop (0..19) {
      &BodyRow("", "", "");
    }
  }

  print "  > # end of TblBody\n",
	" > # end of Tbl\n",
	"> # end of Tbls\n";
}

sub BodyRow {
  my ($addr) = shift,				# Address
  my ($name) = shift,				# Name
  my ($phone) = shift;				# Phone number(s)

  print "   <Row\n",
	"    <Cell\n",
	"     <CellContent\n";

  foreach (split(/\n/, $name)) {
    &CellBody($_);
  }

  print	"     > # end of CellContent\n",
	"    > # end of Cell\n",
	"    <Cell\n",
	"     <CellContent\n";

  foreach (split(/\n/, $addr)) {
    &CellBody($_);
  }

  print	"     > # end of CellContent\n",
	"    > # end of Cell\n",
	"    <Cell\n",
	"     <CellContent\n";

  foreach (split(/\n/, $phone)) {
    &CellBody($_);
  }

  print	"     > # end of CellContent\n",
	"    > # end of Cell\n",
	"   > # end of Row\n";
}

sub CellBody {
  my ($text) = shift;				# Text to put into paragraph

  print	"      <Para\n",
	"	<PgfTag `CellBody'>\n",
	"       <ParaLine\n",
	"        <String `$text'>\n",
	"       > # end of ParaLine\n",
	"      > # end of Para\n",
}

sub MasterPage {
  # Master Page description
  print "<Page\n",
	" <Unique 94658>\n",
	" <PageType RightMasterPage>\n",
	" <PageTag `Right'>\n",
	" <PageSize 8.5\" 11.0\">\n",
	" <PageOrientation Portrait>\n",
	" <PageAngle 0.0>\n",
	" <TextRect\n",
	"  <ID 12>\n",
	"  <Unique 998189>\n",
	"  <Pen 15>\n",
	"  <Fill 15>\n",
	"  <ShapeRect 0.75\" 0.5\" 7.0\" 0.139\">\n",
	" > # end of TextRect\n",
	" <TextRect\n",
	"  <ID 13>\n",
	"  <Unique 998186>\n",
	"  <ShapeRect 0.75\" 1.0\" 7.0\" 9.0\">\n",
	" > # end of TextRect\n",
	" <TextRect\n",
	"  <ID 14>\n",
	"  <Unique 998183>\n",
	"  <ShapeRect 1.0\" 10.407\" 6.5\" 0.139\">\n",
	" > # end of TextRect\n",
	"> # end of Page\n";
}

sub Header {
  # Text flow for the header
  print "<TextFlow\n",
	" <Para\n",
	"  <Font\n",
	"   <FFamily `Palatino'>\n",
	"   <FWeight `Bold'>\n",
	"   <FSize 14.0 pt>\n",
	"  > # end of Font\n",
	"  <ParaLine\n",
	"   <TextRectID 12>\n",
	"   <String `TELEPHONE/ADDRESS FINDER'>\n",
	"  > # end of ParaLine\n",
	" > # end of Para\n",
	"> # end of TextFlow\n",
	"<TextFlow\n",
	" <TFTag `A'>\n",
	" <TFAutoConnect Yes>\n",
	" <Para\n",
	"  <ParaLine\n",
	"   <TextRectID 13>\n",
	"  > # end of ParaLine\n",
	" > # end of Para\n",
	"> # end of TextFlow\n",
	"<TextFlow\n",
	" <Para\n",
	"  <Pgf\n",
	"   <TabStop\n",
	"    <TSX 3.25\">\n",
	"    <TSType Center>\n",
	"   > # end of TabStop\n",
	"  > # end of Pgf\n",
	"  <ParaLine\n",
	"   <TextRectID 14>\n",
	"   <String \\t>\n",
	"   <Variable\n",
	"    <VariableName `Current Page #'>\n",
	"   > # end of Variable\n",
	"  > # end of ParaLine\n",
	" > # end of Para\n",
	"> # end of TextFlow\n";
}

sub Page {
  my ($pagenum) = shift,			# Page number
  my ($range) = shift;				# Range of letters used in page

  # Body Page description
  print "<Page\n",
	" <Unique ", 996720+$pagenum, ">\n",
	" <PageType BodyPage>\n",
	" <PageBackground `Right'>\n",
	" <TextRect\n",
	"  <ID ", 20+$pagenum, ">\n",
	"  <ShapeRect  0.75\" 1.0\" 7.0\" 9.0\">\n",
	" > # end of TextRect\n";

  if (defined($range)) {
    print " <TextLine\n",
	  "  <Font\n",
	  "   <FFamily `Palatino'>\n",
	  "   <FSize 14>\n",
	  "   <FBold Yes>\n",
	  "  > # end of Font\n",
	  "  <TLOrigin 7.301\" 0.628\">\n",
	  "  <String `$range'>\n",
	  " > # end of TextLine\n";
  }

  print "> # end of Page\n";
}

sub TextFlow {
  my ($pagenum) = shift,			# Page number
  my ($tableID) = shift;			# ID of table for this page

  print "<TextFlow\n",
	" <TFTag `A'>\n",
	" <TFAutoConnect Yes>\n",
	" <Para\n",
	"  <Unique ", 998197+$pagenum, ">\n",
	"  <PgfTag `Body'>\n",
	"  <ParaLine\n",
	"   <TextRectID ", 20+$pagenum, ">\n",
	"   <ATbl $tableID>\n",
	"  > # end of ParaLine\n",
	" > # end of Para\n",
	"> # end of TextFlow\n";
}

