#!/usr/bin/perl -w
use strict;
#use diagnostics;

# Written by Frederick Dean 
# v1.1   June 17, 2002

############################
my $addressFile = '/path/to/address/address.dat'; # or aba file
#my $passwd = "";   # for no password operation
my $passwd = undef;
#my $passwd = "pick-a-better-password";
my $debug = "";  # parse,task,
my $showPrivate = 1;  
##############################

#
#      Copyright (c) 2001 by Frederick Dean <software@fdd.com>
#
#  This program is free software; you can redistribute it and/or
#  modify it under the terms of the Artistic License, a copy of which
#  can be found with the Perl distribution.
#
#  This code is distributed in the hope that it will be useful, but
#  WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
#  Artistic License for more details.
#

=head1 webpda.cgi

  This script will let you see into a palmdesk's address book from
  a web page.

  You can enable Apache for just one CGI file with
     <File "/home/httpd/html/webpda.cgi">
        Options +ExecCGI
     </File>
     AddHandler cgi-script .cgi

  The home page for this script is ...
  http://fdd.com/software/palm/

  Special thanks to Scott Leighton <helphand@pacbell.net>.
  http:///www.geocities.com/Heartland/Acres/3216/address_dat.htm

=cut

print("content-type: text/plain\n\n") if $debug; 

# Decode the escaping of a URL
sub urlUnquote {
   my ($tounquote) = (@_);
   $tounquote =~ tr/+/ /;       # pluses become spaces
   $tounquote =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge;
   return $tounquote;
}

# Quotify a string, suitable for putting into a URL.
sub urlQuote {
   my($toencode) = (@_);
   $toencode=~s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg;
   return $toencode;
}

sub Fatal {
   my ($error) = (@_);

   print( "content-type: text/html\n\n".
         "  <br><font color=red size=+2>Fatal Error</font><br>\n".
         "<font color=red>" . htmlQuote($error) . "</font>\n" .
         "</td></tr></table>");
   exit(1);
}

my %form;  # This is the has of form data submitted
           # The keys are the "name=" of the HTML form

# useful for debugging.  Prints %form 
sub PrintFormHash {
   print("<hr>\n<font color=blue>\n");
   for my $key (keys(%form)) {
      print("$key => $form{$key}<br>\n"); 
   }
   print("</font>\n");
}

# Here we parse the data from apache into a hash
sub MakeFormHash {
   my $queryString = "";
   if(defined($ENV{"REQUEST_METHOD"}) and $ENV{"REQUEST_METHOD"} eq "POST") {
      read(STDIN,$queryString,$ENV{"CONTENT_LENGTH"});
   } elsif(defined($ENV{"QUERY_STRING"})) {
      $queryString = $ENV{"QUERY_STRING"};
   }
   # $queryString looks like pw=passwd&name=rick+dean
   my @pairs = split('&',$queryString);
   for my $pair (@pairs) {
      if($pair =~ /([^=]*)=(.*)/) {
         $form{$1} = urlUnquote($2);
      };
   }
}

# useful for debugging
sub PrintEnv {
   print("<hr>\n");
   for my $key (keys(%ENV)) {
      print("$key => $ENV{$key}<br>\n"); 
   }
}

# This makes a new URL being smart about the state we want to keep.
# The args are a list of "value=param" or "value1=param1&value2=param2"
sub Link 
{
   my @params = @_;

   my %answer;
   my @keepers = qw{ pw sort };
   for my $keeper (@keepers) {  # for every keeper
      if(defined($form{$keeper})) {
         $answer{$keeper} = $form{$keeper};
      };
   };
   for my $parampair (@params) {   # for every new parameter
      for my $param (split("&",$parampair)) {
         $param =~ m/(.*?)=(.*)/;
         $answer{$1} = $2;
      };
   };
   my $answer = "";
   for my $key (keys(%answer)) {  # for every answer param
      $answer .= "$key=" . urlQuote($answer{$key}) . '&'; # append
   }
   chop($answer); # kill trailing '&'
   my $progname = $ENV{'REQUEST_URI'} || $0;
   $progname =~ s|\?.*||; # trim the question mark and beyond
   $progname =~ s|.*/||; # trim everything up to last slash
   return("<a href=\"$progname?$answer\">");
}

sub CheckForPasswd {
   if(!defined($passwd)) {
      Fatal("Someone needs to set up the password by editing the " .
            "top of the CGI script.");
   };
   if($passwd eq "") {  # no password (public database?)
      return;
   };
   $passwd = crypt($passwd,"xA");
   if(defined($form{'passwd'})) {
      $form{'pw'} = crypt($form{'passwd'},"xA");
   };
   if(!defined($form{'pw'}) or $form{'pw'} ne $passwd) {
      PrintHeader("WebPDA Login");
      if(defined($form{'pw'})) {
         sleep(2);  # make exhaustive searches more annoying
         print("<h2><font color=red>Password Incorrect</font></h2>\n");
      };
      print("<form name=\"rick\" action=$ENV{REQUEST_URI} method=\"POST\">\n".
            "  Please enter your password:<br>\n".
            "  <input type=\"password\" name=\"passwd\">\n".
            "  <input type=\"submit\" value=\"submit\">\n".
            "</form>\n".
            "</body></html>\n");
      exit();
   };
}


# returns a string converted to html
# double spaces and newlines are not processed
sub htmlQuote {
   my ($html) = (@_);
   $html =~ s/\&/\&amp;/g;
   $html =~ s/</\&lt;/g;
   $html =~ s/>/\&gt;/g;
   $html =~ s/\n/\n<br>/g;
   return $html;
}
# Create a new has of everythin html quoted
sub htmlQuoteHash {
   my ($orig) = (@_);

   my %quoted;
   for my $key (keys(%$orig)) {
      $quoted{$key} = htmlQuote($$orig{$key});
   };
   return \%quoted;
}

# Palm stores some stuff as CStrings
# If the string is less than 255 chars long, it is one byte
# of length then the string, otherwise it is a 0xff byte,
# two bytes of length (LSB first) and then the data.
#
# Palm apparently first wrote the PalmDesk using MFC,
# and stored the data as MFC packed streamed data, which puts
# four bytes of zeros before the string.
sub ReadCString {
   my ($fh,$comment,$noGarbageFlag) = (@_);

   if(!$noGarbageFlag) {
      read($fh,my $garbage,4) or return undef;
   };
   my $tell = tell($fh);
   read($fh,my $lengthByte,1) or return undef;
   my $length = unpack("C",$lengthByte);
   if($length == 0xff) {
      # we read the integer as two byte explicitly to avoid endian problems
      read($fh,$lengthByte,1) or return undef;
      $length = unpack("C",$lengthByte);
      read($fh,$lengthByte,1) or return undef;
      $length = ($length << 8) + unpack("C",$lengthByte);
   };
   my $string;
   if($length == 0) {
      $string = "";
   } else {
      read($fh,$string,$length) or return undef;
   };
   printf("tell=$tell %25s length=$length string=$string\n",$comment) if $debug =~ /parse/;
   return $string;
}

# Read a 32-bit integer.
# We read the integer as explicit bytes to avoid endian problems.
sub ReadLongInt {
   my ($fh,$comment) = (@_);

   my $tell = tell($fh);
   read($fh,my $byte1,1) or return undef;
   read($fh,my $byte2,1) or return undef;
   read($fh,my $byte3,1) or return undef;
   read($fh,my $byte4,1) or return undef;
   my $int = (unpack("C",$byte4) << 24) + 
             (unpack("C",$byte3) << 16) + 
             (unpack("C",$byte2) << 8) +
              unpack("C",$byte1);
   printf("tell=$tell %25s int=$int (0x%08x)\n",$comment,$int) if $debug =~ /parse/;
   return $int;
}
sub ReadShortInt {
   my ($fh,$comment) = (@_);

   my $tell = tell($fh);
   read($fh,my $byte,1) or return undef;
   my $int = unpack("C",$byte);
   read($fh,$byte,1) or return undef;
   $int = $int + (unpack("C",$byte) << 8);
   printf("tell=$tell %25s int=$int (0x%04x) \n",$comment,$int) if $debug =~ /parse/;
   return $int;
}


# We store the addresses as a list of hash references
# Each record (person) has his own hash.
my @records;
# We are inefficient that we load all of this into RAM every time no matter
# if we are only using one record.
my(%categories,%revCategories);
# The key is categoryNum and the value is the number of records found
my %numRecordsInCategory;

my @phoneLabels = qw{work home fax other email main pager mobile};
sub LabelRangeFix 
{
   my($id) = (@_);
   
   #$id--;
   if($id < 0 or $id > $#phoneLabels) {
      $id = 0;  
   } 
   return $id;
}

sub LoadDatFile {
   my $fh = $_[0];

   ReadLongInt($fh,"version tag");  # 0x00014241
   my $filename = ReadCString($fh,"true filename",1); # filename
   my $customLabels = ReadCString($fh,"custom labels",1); 
   my $nextId = ReadLongInt($fh,"next id"); # should be 0x00000083
   my $categoryCount = ReadLongInt($fh,"category count"); 
   while($categoryCount-- > 0) {
      my $index = ReadLongInt($fh,"category index"); 
      ReadLongInt($fh,"category id");
      ReadLongInt($fh,"category data flag"); 
      my $name = ReadCString($fh,"long category name",1);  
      ReadCString($fh,"short category name",1);  
      $categories{$index} = $name;
      $revCategories{$name} = $index;
   }
   $categories{0} = "Unfiled";
   # schema
   ReadLongInt($fh,"resource id"); 
   my $fieldsPerRow = ReadLongInt($fh,"fields per row (30)"); 
   ReadLongInt($fh,"record id position");
   ReadLongInt($fh,"record status position");
   ReadLongInt($fh,"placement position");
   my $numFields = ReadShortInt($fh,"field count");
   my @fields = ();
   while($numFields-- > 0) {
      push(@fields,ReadShortInt($fh,"field entry")); 
   };
   print($#fields+1," fields are ",join(",",@fields),"\n") if $debug =~ /parse/;
   my $numEntries = ReadLongInt($fh,"num entries");  
   print($numEntries/$fieldsPerRow," records in file\n") if $debug =~ /parse/;
   while($numEntries-- > 0) {
      my %record;
      # type: none=0 long=1 float=2 date=3 alpha=4 cstr=5 bool=6 bitflag=7 repeatevent=8
      ReadLongInt($fh,"field type");  
      last if eof($fh);
      $record{'id'} = ReadLongInt($fh,"record id"); 
      ReadLongInt($fh,"field type"); 
      # status: 0x08=pending 0x01=add 0x02=update 0x04=del 0x80=archive
      $record{'status'} = ReadLongInt($fh,"status");
      ReadLongInt($fh,"field type"); 
      $record{'position'} = ReadLongInt($fh,"position");
      ReadLongInt($fh,"field type"); 
      $record{'last'} = my $name = ReadCString($fh,"last (name)");
      ReadLongInt($fh,"field type"); 
      $record{'first'} = ReadCString($fh,"first");
      $record{'name'} = "$record{'last'}, $record{'first'}";
      $record{'id'} = "0-$record{'last'}-$record{'first'}" if $record{'id'} == 0;
      ReadLongInt($fh,"field type"); 
      $record{'title'} = ReadCString($fh,"title");
      ReadLongInt($fh,"field type"); 
      $record{'company'} = ReadCString($fh,"company");
      ReadLongInt($fh,"field type"); 
      $record{'phone1label'} = LabelRangeFix(ReadLongInt($fh,"phone1 label id")); 
      ReadLongInt($fh,"field type"); 
      $record{'phone1'} = ReadCString($fh,"phone1");
      ReadLongInt($fh,"field type"); 
      $record{'phone2label'} = LabelRangeFix(ReadLongInt($fh,"phone2 label id")); 
      ReadLongInt($fh,"field type"); 
      $record{'phone2'} = ReadCString($fh,"phone2");
      ReadLongInt($fh,"field type"); 
      $record{'phone3label'} = LabelRangeFix(ReadLongInt($fh,"phone2 label id")); 
      ReadLongInt($fh,"field type"); 
      $record{'phone3'} = ReadCString($fh,"phone3");
      ReadLongInt($fh,"field type"); 
      $record{'phone4label'} = LabelRangeFix(ReadLongInt($fh,"phone4 label id")); 
      ReadLongInt($fh,"field type"); 
      $record{'phone4'} = ReadCString($fh,"phone4");
      ReadLongInt($fh,"field type"); 
      $record{'phone5label'} = LabelRangeFix(ReadLongInt($fh,"phone5 label id")); 
      ReadLongInt($fh,"field type"); 
      $record{'phone5'} = ReadCString($fh,"phone5");
      ReadLongInt($fh,"field type"); 
      $record{'street'} = ReadCString($fh,"street");
      ReadLongInt($fh,"field type"); 
      $record{'city'} = ReadCString($fh,"city");
      ReadLongInt($fh,"field type"); 
      $record{'state'} = ReadCString($fh,"state");
      ReadLongInt($fh,"field type"); 
      $record{'zip'} = ReadCString($fh,"zip");
      ReadLongInt($fh,"field type"); 
      $record{'country'} = ReadCString($fh,"country");
      ReadLongInt($fh,"field type"); 
      $record{'note'} = ReadCString($fh,"note");
      ReadLongInt($fh,"field type"); 
      $record{'private'} = ReadLongInt($fh,"private"); 
      ReadLongInt($fh,"field type"); 
      $record{'categoryNum'} = ReadLongInt($fh,"categoryNum"); 
      $record{'category'} = $categories{$record{'categoryNum'}}; 
      ReadLongInt($fh,"field type"); 
      $record{'custom1'} = ReadCString($fh,"custom 1");
      ReadLongInt($fh,"field type"); 
      $record{'custom2'} = ReadCString($fh,"custom 2");
      ReadLongInt($fh,"field type"); 
      $record{'custom3'} = ReadCString($fh,"custom 3");
      ReadLongInt($fh,"field type"); 
      $record{'custom4'} = ReadCString($fh,"custom 4");
      ReadLongInt($fh,"field type"); 
      my $primary = ReadLongInt($fh,"primary display index"); 
      if(!defined($primary) or $primary !~ /^\d+$/ or $primary < 0 or $primary > 6) {
         $primary = 1;
      }
      $record{'primaryNum'} = $primary;
      $record{'primary'} = $record{"phone$primary"};
      next if $record{'private'} && !$showPrivate;
      $numRecordsInCategory{$record{'categoryNum'}}++;
      push(@records,\%record);  # save hash reference in list
      last if eof($fh);  # if incomplete record
   };
}

sub LoadAddresses {
   -e $addressFile or Fatal("file $addressFile doesn't exist");
   -r $addressFile or Fatal("I don't have read permission for file $addressFile");
   print("opening $addressFile\n") if $debug =~ /task/;
   if(!open(DAT,"<$addressFile")) {
      PrintHeader();
      print("<font color=red>Could not open $addressFile</font>\n");
      exit();
   }
   LoadDatFile(\*DAT);
   close(DAT);
}

sub PrintSummaryAddr {
   my ($fieldsRef) = (@_);
   print("PrintSummaryAddr()\n") if $debug =~ /task/;

   my $categoryNum;
   if(defined($form{'category'})) {
      $categoryNum = $revCategories{$form{'category'}};
   };
   print("<table>\n");
   print(" <tr>\n");
   my @fields = @$fieldsRef;
   my $firstField = shift(@fields);
   my $secondField = $fields[0];
   my $sort1 = $form{'sort'} || $firstField;  # default if not defined
   my $firstref = $records[0];
   if(!defined($$firstref{$sort1})) {
       $sort1 = $firstField; # sort must be legal field
   };
   my $sort2;
   if($sort1 eq $firstField) {
       $sort2 = $secondField;
   } else {
       $sort2 = $firstField;
   };
   my %hasField;
   for my $field ($firstField,@fields) {
      $hasField{$field} = 1;
   };
   push(@fields,$sort1) if !$hasField{$sort1};
   for my $field ($firstField,@fields) {
      print(" <td bgcolor=001199>".Link("sort=$field")."<font color=ffffff><center><b>".
            "$field</b></center></font></a></th>\n");
   };
   print(" </tr>\n");
   my $rowNum = 0;

   @records = sort { 
      (my $aa = $$a{$sort1}) =~ tr/a-z/A-Z/;  # case insensitive
      (my $bb = $$b{$sort1}) =~ tr/a-z/A-Z/;
      (my $aaa = $$a{$sort2}) =~ tr/a-z/A-Z/;
      (my $bbb = $$b{$sort2}) =~ tr/a-z/A-Z/;
      $aa cmp $bb or $aaa cmp $bbb;
   } @records;
   my $searchRE;  # search regular expression
   if(defined($form{'search'}) and $form{'search'} ne "") {
      ($searchRE = $form{'search'}) =~ s/(\W)/\\$1/g; # escape
      if($searchRE =~ /^\d+$/) {  # if search is all numeric
         ($searchRE = $form{'search'}) =~ s/(\d)/${1}\\W*/g; # ignore punctuation
      };
   };
   for my $recref (@records) {  # for every record
      if(defined($categoryNum) and $categoryNum ne $$recref{'categoryNum'}) {
         next;  # skip records not in our category (family, personal, etc)
      }
      if(defined($searchRE)) {  # if we have search pattern
         my $found;
         for my $value (values(%$recref)) {  # for every field of this record
            if($value =~ /$searchRE/i) {
               $found = 1;
               last;
            };
         };
         next if(!$found);  # didn't match search
      };
      if($rowNum & 1) {  # is odd row (for colors)
         print(" <tr>\n"); # default white
      } else {
         print(" <tr bgcolor=dddddd>\n");  # light gray
      };
      print("  <td>".Link("id=$$recref{'id'}").htmlQuote($$recref{$firstField})."</a></td>\n");
      for my $field (@fields) {
         if($$recref{$field} eq "") {
            print("  <td>&nbsp;</td>\n"); # netscape bug
         } else {
            print("  <td>".htmlQuote($$recref{$field})."</td>\n");
         };
      };
      print(" </tr>\n");
      $rowNum++;
   };
   print("</table>\n");
   print("$rowNum record" . ($rowNum == 1 ? "" : "s") . " found<br>\n");
}

sub PrintDetailedAddr {
   my ($id) = (@_);

   print("PrintDetailedAddr(id=$id)\n") if $debug =~ /task/;
   my $recref;
   for my $maybeRecref (@records) {
      if($$maybeRecref{'id'} eq $id) {
         $recref = $maybeRecref;
         last;
      }
   };
   if(!defined($recref)) {
      print("<font color=red>id #$id not found</font>\n");
      return;
   };
   $recref = htmlQuoteHash($recref);
   print("<table>\n");  
   print(" <tr><td colspan=2 bgcolor=001199><font color=ffffff><center><b>Name</b></center></font></td></tr>\n");
   print(" <tr><td align=right bgcolor=dddddd>last name:</td><td>$$recref{'last'}</td></tr>\n");
   print(" <tr><td align=right bgcolor=dddddd>first name:</td><td>$$recref{'first'}</td></tr>\n");
   print(" <tr><td align=right bgcolor=dddddd>title:</td><td>$$recref{'title'}</td></tr>\n");
   print(" <tr><td align=right bgcolor=dddddd>company:</td><td>$$recref{'company'}</td></tr>\n");

   print(" <tr><td colspan=2 bgcolor=001199><font color=ffffff><center><b>Address</b></center></font></td></tr>\n");
   print(" <tr><td align=right bgcolor=dddddd>street:</td><td>$$recref{'street'}</td></tr>\n");
   print(" <tr><td align=right bgcolor=dddddd>city:</td><td>$$recref{'city'}</td></tr>\n");
   print(" <tr><td align=right bgcolor=dddddd>state:</td><td>$$recref{'state'}</td></tr>\n");
   print(" <tr><td align=right bgcolor=dddddd>zip:</td><td>$$recref{'zip'}</td></tr>\n");
   print(" <tr><td align=right bgcolor=dddddd>country:</td><td>$$recref{'country'}</td></tr>\n");

   print(" <tr><td colspan=2 bgcolor=001199><font color=ffffff><center><b>Contact Info</b></center></font></td></tr>\n");
   my $star = $$recref{'display'} == 1 ? "*" : "";
   print(" <tr><td align=right bgcolor=dddddd>$star $phoneLabels[$$recref{'phone1label'}]:</td>".
         "<td>$$recref{'phone1'}</td></tr>\n");
   $star = $$recref{'display'} == 2 ? "*" : "";
   print(" <tr><td align=right bgcolor=dddddd>$star $phoneLabels[$$recref{'phone2label'}]:</td>".
         "<td>$$recref{'phone2'}</td></tr>\n");
   $star = $$recref{'display'} == 3 ? "*" : "";
   print(" <tr><td align=right bgcolor=dddddd>$star $phoneLabels[$$recref{'phone3label'}]:</td>".
         "<td>$$recref{'phone3'}</td></tr>\n");
   $star = $$recref{'display'} == 4 ? "*" : "";
   print(" <tr><td align=right bgcolor=dddddd>$star $phoneLabels[$$recref{'phone4label'}]:</td>".
         "<td>$$recref{'phone4'}</td></tr>\n");
   $star = $$recref{'display'} == 5 ? "*" : "";
   print(" <tr><td align=right bgcolor=dddddd>$star $phoneLabels[$$recref{'phone5label'}]:</td>".
         "<td>$$recref{'phone5'}</td></tr>\n");

   print(" <tr><td colspan=2 bgcolor=001199><font color=ffffff><center><b>Other</b></center></font></td></tr>\n");
   print(" <tr><td align=right bgcolor=dddddd>custom1:</td><td>$$recref{'custom1'}</td></tr>\n");
   print(" <tr><td align=right bgcolor=dddddd>custom2:</td><td>$$recref{'custom2'}</td></tr>\n");
   print(" <tr><td align=right bgcolor=dddddd>custom3:</td><td>$$recref{'custom3'}</td></tr>\n");
   print(" <tr><td align=right bgcolor=dddddd>custom4:</td><td>$$recref{'custom4'}</td></tr>\n");
   my $categoryNum = $$recref{'categoryNum'};
   print(" <tr><td align=right bgcolor=dddddd>category:</td><td>$categories{$categoryNum}</td></tr>\n");
   my $private = $$recref{'private'} ? "yes" : "no";
   print(" <tr><td align=right bgcolor=dddddd>private:</td><td>$private</td></tr>\n");
   print(" <tr><td align=right bgcolor=dddddd>note:</td><td>$$recref{'note'}</td></tr>\n");
   print("</table>\n");
}

sub PrintCategoryLinks {
   print(Link() . "All</a> (". ($#records +1) .")<br>");
   for my $id (sort(keys(%categories))) {
      next unless $numRecordsInCategory{$id};
      my $name = $categories{$id};
      print(Link("category=$name") . htmlQuote($name)."</a> ($numRecordsInCategory{$id})<br>");
   };
}

sub PrintHeader {
   my ($title) = (@_);

   if(!defined($title)) {
      $title = "WedPDA";
   };
   print("content-type: text/html\n\n".
         "<html><head>\n".
         "<title>$title</title>\n".
         "</head><body bgcolor=ffffff>\n".
         "  <font size=+2>$title</font><br>\n");

}

sub PrintMainTable {
   print("<table><tr><td valign=top>\n");
}

sub PrintFooter {
   print("</td><td valign=top>\n");
   print("<center><b>Addresses</b></center>\n");
   PrintCategoryLinks();
   print("<center><b>Table sorted by</b></center>\n");
   print(Link("sort=name","id=")."last name</a><br>\n");
   print(Link("sort=first","id=")."first name</a><br>\n");
   print(Link("sort=city","id=")."city</a><br>\n");
   print(Link("sort=state","id=")."state</a><br>\n");
   print(Link("sort=zip","id=")."zip</a><br>\n");
   print(Link("sort=country","id=")."country</a><br>\n");
   print(Link("sort=category","id=")."category</a><br>\n");
   print("<center><b>Search</b></center>\n");
   print("<form name=f method=GET action=>\n");
   print("<input type=text name=\"search\"");
   print(' value="' . htmlQuote($form{'search'}) . '"') if defined($form{'search'});
   print("><br>\n");
   print("<input type=submit name=\"show\"><br>\n");
   print("<input type=hidden name=\"pw\" value=$form{'pw'}>\n");
   print("</form>\n");
   print("</td></tr></table>\n");
}

MakeFormHash();
CheckForPasswd();  # may not return
print("password okay\n") if $debug =~ /task/;

PrintHeader();
PrintMainTable();

LoadAddresses();
print("loaded okay\n") if $debug =~ /task/;

if($form{'id'}) { 
   PrintDetailedAddr($form{'id'});
} else {
   PrintSummaryAddr(["name","company","primary"]);
};
PrintFooter();

#PrintFormHash();

print("done\n") if $debug =~ /task/;