[Tcladdressbook-commits] Contribs/Tcl/AAB AAB.tcl,NONE,1.1

SourceForge Headquarters 1320 Columbia Street Suite 310 San Diego, CA 92101 +1 (858) 422-6466

Update of /cvsroot/tcladdressbook/Contribs/Tcl/AAB
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv2068/Contribs/Tcl/AAB

Added Files:
	AAB.tcl 
Log Message:
First checkin

--- NEW FILE: AAB.tcl ---
package require addressbook 1.1
package require Tclx

package provide AAB 0.2

namespace eval ::AAB {}

# --------------------------------------------------------------------
# The main procs
# --------------------------------------------------------------------
#        AAB::getRecord
#        AAB::setRecord
#        AAB::newRecord
#        AAB::deleteRecord
#        AAB::find
#        AAB::findAnywhere
#        AAB::simpleFind
#        AAB::listAllRecords
# 
#        AAB::formatAddress

proc ::AAB::getSelect { uid args } {
    set R [getRecord $uid]
    set res [list ]
    foreach key $args {
	lappend res [keylget R $key]
    }
    return $res
}


proc ::AAB::getRecord { uid } {
    if { [catch { set record [addressbook record $uid] } err] } {
	error $err
    }
    foreach key [keylkeys record] {
	if { [addressbook property type -persons $key] == "Date" } {
	    set t [keylget record $key]
	    set t [clock format $t -format "%Y-%m-%d"]
	    keylset record $key $t
	}
    }
    return $record
}


# Set only specified keys.  To erase an existing value, use NULL.
proc ::AAB::setRecord { uid record } {
    foreach key [keylkeys record] {
	set t [keylget record $key]
	if { ![string length $t] } {
	    set $t NULL
	} elseif { [addressbook property type -persons $key] == "Date" } {
	    set t [clock scan $t]
	} 
	if { [catch { addressbook set $uid $key $t } err] } {
	    error "Could not write to record $uid. ($uid)"
	}
    }
    if { [catch { addressbook save } err] } {
	error "Could not save Addressbook. ($err)"
    }
}


proc ::AAB::newRecord { record } {
    if { [catch { addressbook create person [kelyget record Last] } uid] } {
	if { [catch { addressbook create person "" } uid] } {
	    error "Could not create new record. ($uid)"
	}
    }
    setRecord $uid $record
    return $uid
}


proc ::AAB::deleteRecord { uid } {
    if { [catch { addressbook delete $uid } err] } {
	return "Could not delete record $uid. ($err)"
    }
    if { [catch { addressbook save } err] } {
	error "Could not save Addressbook. ($err)"
    }
}


# The argument $record is a keyed list like those returned by 
# [::AAB::getRecord].  For MultiTerm types like 'Address' and 'Phone' there 
# are two ways: either form the keyed list in all detail like this:
#     keylset R Address.home.City Paris
#     ::AAB::find $R
# or form a rougher query like
#     keylset S Address Paris
#     ::AAB::find $S
# (Note that in the first form, there is one more level of list nesting than
# one would use with [addressbook search], which does not accept keyed list
# style queries.)
proc ::AAB::find { record } {
    foreach field [keylkeys record] {
	set str [keylget record $field]
	if { [string length $str] } {
	    if { [addressbook property type -persons $field] == "MultiDictionary" } {
		# Here comes a trick for handling Multidictionary:
		set strList [list ]
		if { [catch { keylkeys record $field } placeList] } {
		    # In this case the query is of the form {Address str}
		    set strList [list [list "" [list "" $str]]]
		} else {
		    # Split into separate queries, one for each specified place:
		    foreach place $placeList {
			# Split into separate queries, one for each specified subfield:
			foreach subfield [keylkeys record $field.$place] {
			    # And remove one level of braces:
			    lappend strList [list $place [list $subfield [keylget record $field.$place.$subfield]]]
			}
		    }
		}
	    } elseif { [addressbook property type -persons $field] == "MultiString" } {
		if { [catch { keylkeys record $field } placeList] } {
		    # In this case the query is of the form {Phone 1234}
		    set strList [list [list "" $str]]
		} else {
		    # Split up into separate queries, one for each specified
		    # place, and also remove one level of braces...
		    set strList [list ]
		    foreach place $placeList {
			lappend strList [list $place [keylget record $field.$place]]
		    }
		}
	    } else {
		# For all other data types, the original $str was ok:
		set strList [list $str]
	    }
	    # Now run through the list of strings --- typically there is
	    # only one entry in this list...:
	    foreach str $strList {
		set tmpMatches [simpleFind $field $str]
		if { [info exists mList] } {
		    set mList [intersect $mList $tmpMatches]
		} else {
		    set mList $tmpMatches
		}
	    }
	    
	}
    }
    # If no search criteria are given, return all indices.
    if  { ![info exists mList] } {
	set mList [listAllRecords]
    }
    if { ![llength $mList] } {
	error "No matches"
    }
    return $mList
}


proc ::AAB::simpleFind { field str } {
    if { [catch { set res \
      [addressbook search -persons -ids -nocase $field > $str] } err] } {
	error "Problem in \"addressbook search\". ($err)"
    }
    return $res
}

# Anywhere means in text fields...
proc ::AAB::findAnywhere { str } {
    set L [list ]
    foreach key [addressbook property names -persons] {
	switch -- [addressbook property type -persons $key] {
	    "MultiDictionary" {
		set searchString [list "" [list "" $str]]
	    }
	    "MultiString" {
		set searchString [list "" $str]
	    }
	    "String" {
		set searchString $str  
	    }
	    default {
		continue
	    } 
	}
	if { [catch { set res \
	  [addressbook search -persons -ids -nocase $key > $searchString] } err] } {
	    error "Problem in \"addressbook search\". ($err)"
	}
	set L [union $L $res]
    }
    return $L
}


proc ::AAB::listAllRecords {} {
    return [addressbook persons -ids]
}

# --------------------------------------------------------------------
# Auxiliary procs
# --------------------------------------------------------------------

proc keyl2arr { rec a {prefix ""} } {
    upvar 1 $a arr
    foreach key [keylkeys rec] {
	set val [keylget rec $key]
	if { [catch { keylkeys rec $key }] } {
	    set arr(${prefix}${key}) $val
	} else {
	    keyl2arr $val arr ${prefix}${key}.
	}
    }
}


proc ::AAB::formatAddress { uid } {
    set M [getRecord $uid]
    set pKeys [keylkeys M]
    
    set place "home"
    
    if { ![catch { set ABPF [keylget M ABPersonFlags] }] && $ABPF } {
	set place "work"
	if { [lcontain $pKeys Organization] } {
	    append txt "[keylget M Organization]\r"
	}
	
    } elseif { [lsearch -regexp $pKeys (First|Last)] != -1 } {
	catch { append txt "[keylget M First] " }
	catch { append txt "[keylget M Last]" }
	append txt \r
# 	if { [lcontain $pKeys Organization] } {
# 	    append txt "[keylget M Organization]\r"
# 	}
    }
    if { [lcontain $pKeys Address] } {
	# Write the addresses, if any
	if { [catch {set A [keylget M Address.$place]}] } {
	    error "No addrees found"
	}
	if { [lcontain [keylkeys A] Street] } {
	    append txt "[keylget A Street]\r"
	}
	foreach c {ZIP City Province State} {
	    if { [lcontain [keylkeys A] $c] } {
		append txt [keylget A $c] " "
	    }
	}
	if { [lcontain [keylkeys A] Country] } {
	    append txt [keylget A Country] \r
	}
    } ; # end of "Address"
    return $txt
}