[Tcladdressbook-commits] Contribs/Tcl/AAB AAB.tcl,NONE,1.1
Status: Alpha
Brought to you by:
bdesgraupes
|
From: Bernard D. <bde...@us...> - 2004-08-24 05:59:43
|
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 } |