## -*-Tcl-*-
 # ###################################################################
 # 
 #  FILE: "addressbook2xml.tcl"
 #                                    created: 2007-01-11 16:32:54 
 #                                last update: 2007-01-12 13:48:12 
 #  Author: Frédéric Boulanger
 #  E-mail: Frederic.Boulanger@supelec.fr
 #    mail: Supélec - Département Informatique
 #          3 rue Joliot-Curie, 91192 Gif-sur-Yvette, France
 #     www: http://wwwsi.supelec.fr/fb/
 #  
 #  Description: 
 # 
 #  History
 # 
 #  modified   by  rev reason
 #  ---------- --- --- -----------
 #  2007-01-11 FBO 1.0 original
 # ###################################################################
 ##
# set suppressedFields [list \
#  ABDate \
#  ABPersonFlags \
#  ABRelatedNames \
#  AIMInstant \
#  Creation \
#  FirstPhonetic \
#  ICQInstant \
#  JabberInstant \
#  LastPhonetic \
#  MSNInstant \
#  MiddlePhonetic \
#  Modification \
#  UID \
#  YahooInstant \
# ]
proc exportAddressBook {} {
  set suppressedFields [list UID]
  
#   set expfilename [putfile "Save exported addresses to" "AddressBook-[ISOTime::ISODate].xml"]
#   if {[string length $expfilename] == 0} {
#     error "cancel"
#   }

  set expfilename "AddressBook-[clock format [clock seconds] -format "%Y-%m-%d"].xml"

  set expfile [open $expfilename "w"]
  fconfigure $expfile -encoding utf-8 -translation lf
  puts $expfile "<?xml version=\"1.0\" encoding=\"utf-8\"?>"
  puts $expfile "<addressbook>"
  
  package require addressbook
  set idlist [lsort -command compareEntries [addressbook persons -ids]]
  set gplist [lsort -command compareEntries [addressbook groups -ids]]
  
  foreach id $gplist {
    dumprecord $id $suppressedFields $expfile
    puts $expfile ""
  }
  foreach id $idlist {
    dumprecord $id $suppressedFields $expfile
    puts $expfile ""
  }
  
  puts $expfile "</addressbook>"
  close $expfile
}

proc dumprecord {id suppressedFields outfile} {
  set data [addressbook record $id]
  switch -exact -- [addressbook type $id] {
    ABPerson {set rectype "person"}
    ABGroup  {set rectype "group"}
    default {
      error "Unknown record type \"[addressbook type $id]\""
    }
  }
  puts $outfile "<$rectype>"
  foreach field $data {
    set fieldname [lindex $field 0]
    set fieldvalue [lindex $field 1]
    if {[lsearch -exact $suppressedFields $fieldname] >= 0} {
      continue
    }
    switch -exact -- [addressbook property type -${rectype}s $fieldname] {
      Date    {
        set date [clock format $fieldvalue -format "%Y-%m-%d %H:%M:%S"]
        puts $outfile "  <$fieldname>$date</$fieldname>"
      }
      Array   -
      Data    -
      Integer -
      Real    -
      String  {
        puts $outfile "  <$fieldname>[normalize $fieldvalue]</$fieldname>"
      }
      MultiDate    {
        puts $outfile "  <$fieldname>"
        foreach item $fieldvalue {
          set date [clock format [lindex $item 1] -format "%Y-%m-%d %H:%M:%S"]
          puts $outfile "    <item name=\"[lindex $item 0]\">$date</item>"
        }
        puts $outfile "  </$fieldname>"
      }
      Dictionary   -
      MultiArray   -
      MultiData    -
      MultiInteger -
      MultiReal    -
      MultiString  {
        puts $outfile "  <$fieldname>"
        foreach item $fieldvalue {
          puts $outfile "    <item name=\"[lindex $item 0]\">[normalize [lindex $item 1]]</item>"
        }
        puts $outfile "  </$fieldname>"
      }
      MultiDictionary {
        puts $outfile "  <$fieldname>"
        foreach item $fieldvalue {
          puts $outfile "    <item name=\"[lindex $item 0]\">"
          foreach subitem [lindex $item 1] {
            puts $outfile "      <[lindex $subitem 0]>[normalize [lindex $subitem 1]]</[lindex $subitem 0]>"
          }
          puts $outfile "    </item>"
        }
        puts $outfile "  </$fieldname>"
      }
      
      default {
        error "Unknown property type \"[addressbook property type -persons $field]\""
      }
    }
  }
  set parents [addressbook parents -ids $id]
  foreach p $parents {
    if {[string length $p] == 0} continue
      puts $outfile "<ingroup>[normalize [addressbook set $p GroupName]]</ingroup>"
  }
  puts $outfile "</$rectype>"
}

# proc normalize {s} {
#   regsub -- {\[Comment\][\n\r]?} $s {} s
#   regsub -- {\[Comments\][\n\r]?} $s {} s
#   regsub -- {\[Commentaires\][\n\r]?} $s {} s
#   regsub -all -- {([&_$#])} $s {\\\1} s
#   regsub -all -- {[\n\r]} $s {\\newline }
# }
proc normalize {s} {
  regsub -all -- {&} $s {\&amp;} s
  regsub -all -- {<} $s {\&lt;} s
  regsub -all -- {>} $s {\&gt;} s
  return $s
}

proc compareEntries {first second} {
  set fkey [getKeyOfEntry [addressbook record $first]]
  set skey [getKeyOfEntry [addressbook record $second]]
    
  set res [compareStrings [lindex $fkey 0] [lindex $skey 0]]
  if {$res == 0} {
    if {([llength $fkey] > 1) && ([llength $skey] > 1)} {
      set res [compareStrings [lindex $fkey 1] [lindex $skey 1]]
    }
  }
  return $res
}

proc getKeyOfEntry {record} {
  foreach item $record {
    array set data $item
  }
  if {[info exists data(Last)]} {
    lappend key $data(Last)
    if {[info exists data(First)]} {
      lappend key $data(First)
    }
  } elseif {[info exists data(Organization)]} {
    lappend key $data(Organization)
  } elseif {[info exists data(First)]} {
    lappend key $data(First)
  } else {
    lappend key ""
  }
  return $key
}


proc mapString {s} {
  string map { \
   à a á a ä a â a \
   ç c \
   è e é e ë e ê e \
   ì i í i ï i î i \
   ñ n \
   ò o ó o ö o ô o \
   ù u ú u ü u û u \
   ÿ y \
  } [string tolower $s]
}

proc compareStrings {s1 s2} {
  string compare [mapString $s1] [mapString $s2]
}

exportAddressBook