/usr/share/obextool/plugins/adr

###
###  Siemens address book reader 0.1
###  A plugin for the ObexTool 
###  (c) Gerhard Reithofer, Techn. EDV Reithofer, 2003-2004
###
###  mailto:gerhard.reithofer@tech-edv.co.at
###  http://www.tech-edv.co.at/programmierung/en/gplsw.html
### 
### Information mostly "stolen" from
###   the source code of the Flexmem Tool by Hendrik Sattler,
###   the programmer of the great command line tool: scmxx
###     http://www.hendrik-sattler.de/scmxx/
###     http://freshmeat.net/projects/scmxx/
###     http://sourceforge.net/projects/scmxx/
###   and from the TOT-Consult homepage
###     http://www.tot-consult.com/siemens/
### 
### Remarks:
###   I had only 1 small file for my tests, so don't expect that it
###   works really good. My handy (Siemens M50) does NOT support
###   Siemens addressbook files.
###   It seems that there ar 3 file formats currently available,
###   which may be distinguished by the file name:
###              [579]f0${version}.adr 
###   where version is 2, 7 or 8, but I'm not sure, so the user has
###   to select the correct file from the directory. The version 
###   is only handled by this book only by the number of records in
###   an address book entry.
###

namespace eval ::ADR {
  variable version 0.2

  variable top_list     .alist
  variable top_level    .adrdat
  variable label_font   {Helvetica 12}
  variable dialog_font  {Helvetica 12}
  variable listbox_font {Helvetica 12}

  variable lb_widget
	variable dataframe
  variable field_cnt
  variable label_width 15
	variable entry_width 50
  variable idxprefix "7F"
  variable export_header_line 1
  variable exportfile "obextadr.txt"
  variable dlg_title \
    "ObexTool ADR-Plugin $version - (c) Gerhard Reithofer 2003-2004"

  variable ADR_FORMAT
  variable DATA_ARR
  variable DATA_REC

  set ADR_FORMAT(19) [list \
  "Firstname" 0 "Lastname" 1 "Company" 2 \
  "Street" 3 "City" 4 "Country" 5 "ZIP" 9 \
  "Email" 7 "URL" 8 \
  "Tel. Home" 10 "Tel. Work" 11 "Tel. Mobile" 12 "Fax Nr.1" 13 \
  "NTyp Home" 14 "NTyp Work" 15 "NTyp Mobile" 16 "NTyp Fax1" 17 \
  "Revision" 18]

  set ADR_FORMAT(28) [list \
  "Firstname" 0 "Lastname" 1 "Company" 2 \
  "Street" 3 "City" 4 "Country" 5 "ZIP" 11 \
  "Email 1" 8 "Email 2" 9 "URL" 10 \
  "Tel. Home" 12 "Tel. Work" 13 "Tel. Mobile" 14 "Fax Nr.1" 15 "Fax Nr.2" 16 \
  "NTyp Home" 17 "NTyp Work" 18 "NTyp Mobile" 19 "NTyp Fax1" 20 "NTyp Fax2" 21 \
  "Birthday" 25 "Revision" 22]

  set ADR_FORMAT(29) [list \
  "Firstname" 0 "Lastname" 1 "Company" 2 \
  "Street" 3 "City" 4 "Country" 5 "ZIP" 11 \
  "Email" 8 "URL" 9 \
  "Tel. Home" 12 "Tel. Work" 13 "Tel. Mobile" 14 "Fax Nr.1" 15 "Fax Nr.2" 16 \
  "NTyp Home" 17 "NTyp Work" 18 "NTyp Mobile" 19 "NTyp Fax1" 20 "NTyp Fax2" 21 \
  "Birthday" 25 "Revision" 22]

   load_Messages adr_plug [getObexCfg config language] $version
###
### check if tolevel $which already exists
###
  proc win_check { which name args } {
    debug_out "win_check $which $name" 4
    if [winfo exists $which] {
      set msg [get_text "%s window already open!\n" adr_plug]
		  if [llength $args] {
			  append msg [lindex $args 0]
			} else {
        append msg [get_text "Please close it before opening a new one." adr_plug]
			}
      warning [format $msg $name]
      return 1
    }
    return 0
  }

  proc mem_map { path } {
    debug_out "mem_map $path" 4
    set local [ObexFile::read_file_tmp $path]
    if [string_empty $local] {
      warning [format [get_text "Unable to download file '%s'!" adr_plug] $path]
      return {}
    }
    set fd [open $local r]
    fconfigure $fd -translation binary
    set fc [read $fd]
    close $fd
    file delete $local
    return $fc
  }

  proc read_binary { bin idx which } {
  # debug_out "read_binary \$bin, $idx, $which"
  #  disp_ascii $bin
    switch -glob $which  {
      b* { set size 1 }
      s* { set size 2 }
      l* { set size 4 }
      default {
        if [string is integer $which] {
          set size $which
        } else {
				  internal_error "Invalid parameter which '%which' in read_binary"
        }
      }
    }
    set offs1 [expr $idx*$size]
    set offs2 [expr $offs1+$size-1]
    set strl [string range $bin $offs1 $offs2]
    return $strl
  }

  proc letohs { str2 } {
  # debug_out "letohs $str2"
    set res [scan $str2 "%c%c" b0 b1]
  # debug_out "letohs [format %02x $b1] [format %02x $b0]"
    if {$res < 2} { puts stderr "ERROR: letohs str2"; return 0 }
    return [expr ($b1<<8)+$b0]
  }

  proc letohl { str4 } {
    set res [scan $str4 "%c%c%c%c" b0 b1 b2 b3]
    if {$res < 4} { puts stderr "ERROR: letohl str4"; return 0 }
    if {$b3 >= 128} {
# debug_out "[format %02x $b3][format %02x $b2]\
#[format %02x $b1][format %02x $b0]"
       if {$b3==255&&$b3==255&&$b3==255&&$b3==255} {return -1}
       return [expr (($b3& 127)<<24)+($b2<<16)+($b1<<8)+$b0]
    } 
    return 0
  }

  proc encode_chars { str16 } {
  # debug_out "encode_chars !$str16!" 
  # debug_out "len str16=[string length $str16]"
    set hex00 [format "%c%c" 0 0]
    if {$str16 eq $hex00} {return ""}
  # disp_ascii $str16
    set str ""
    set slen [expr [string length $str16]/2]
    for {set i 0} {$i < $slen} {incr i} {
      set uc [read_binary $str16 $i 2]
      if {$uc eq $hex00}  break
      set res [scan $uc "%c%c" b1 b0]
      append str [format %c [expr ($b0<<8)+$b1]]
    }
    return $str
  }

  proc get_verify_offsets { filename } {
  debug_out "get_verify_offsets $filename" 2

    set fcontents [mem_map $filename]
    set flen [expr [string length $fcontents]/4] 
    debug_out "flen=$flen"

    for {set i 0} {$i < $flen} {incr i} {
      set str4 [read_binary $fcontents $i long]
      set int32 [letohl $str4]
    # debug_out "int32=0x[format %x $int32]=$int32" 4
      if $int32 { lappend ptrlist $int32 }
    }
    return $ptrlist
  }

  proc get_offsets { fields entrycount adrfile } {
    set flen [string length $adrfile]
    set counter 0
    set ptrlist {}
    set fill [format "%c" 0xdd]
    set skip [format "%c" 0xee]
    set i [expr ($fields+5)*2] 
    while {$counter < $entrycount && $i < $flen} {
      while {[read_binary $adrfile $i byte] eq $fill} {incr i}
      if {[read_binary $adrfile $i byte] eq $skip} {
        incr i
      } else {
        lappend ptrlist $i 
         set entrysize 0
        set adroffs [string range $adrfile $i end]
         for {set k 0} {$k < $fields} {incr k} {
           set str2 [read_binary $adroffs $k short]
#          debug_out "i=$i, len str2=[string length $str2]"
           set entrysize [expr $entrysize + [letohs $str2]]
         }
         set i [expr $i + (2*$fields) + $entrysize]
      }
    }
    return $ptrlist
  }

  proc process_all_data { fields adrfile adr_list } {
    variable field_cnt $fields
    variable ADR_FORMAT
    variable DATA_ARR

    set cnt 0
    set rval {}
    set field_names {}

    if ![info exists ADR_FORMAT($fields)] {
      internal_error \
			 "Unexpected file format error:\nNo ADR_FORMAT($fields) found!"
    }

    foreach [list idx val] $ADR_FORMAT($fields) { 
      if ![regexp "^NTyp" $idx] { lappend field_names $idx }
    }
    set numrecs [llength $adr_list]
    set adrlist [concat $adr_list [string length $adrfile]]
    for {set i 0} {$i < $numrecs} {incr i} {
      set offs1 [lindex $adrlist $i]
      set offs2 [lindex $adrlist [expr $i+1]]
####  debug_out "record $i: [format %x $offs1] .. [format %x $offs2]" 5
      set adr [string range $adrfile $offs1 $offs2]
      process_data $adr $fields 
      set row {}
      foreach field $field_names {
        if [info exists DATA_ARR($field)] {
          lappend row $DATA_ARR($field)
        } else {
          lappend row ""
        }
      }
      lappend rval [concat [incr cnt] $row]
    }
    return $rval
  }

  proc read_date_rec { num } {
    variable DATA_REC 
  # debug_out "print_rec $pref $args"
    set val [lindex $DATA_REC $num]
    set rec [ObexFile::format_date $val]
    return $rec
  }
  proc read_data_rec { idx } {
    variable DATA_REC
    set val [lindex $DATA_REC $idx]
    set rec [encode_chars $val]
##  debug_out "read_data_rec $idx => $rec" 5
    return $rec
  }

  proc read_teln_rec { type field } {
    variable DATA_REC 
    set bnum [lindex $DATA_REC $field]  
    set ttyp [lindex $DATA_REC $type] 

    set hexff [format "%c" 0xff]
    if {$field eq $hexff||$ttyp eq $hexff} { return {} }

    scan $ttyp %c ntyp

#   debug_out "ntyp=$ntyp" 4
    if {$ntyp == 145} { set num "+" } else { set num "" }

    set i -1
    append bnum $hexff

    while {$hexff != [set byte [read_binary $bnum [incr i] byte]]} {
      scan $byte %c tnum
      set inum [format %d [expr $tnum&0xf]]
      append num $inum
      if {$tnum<=0xf0} {
        set inum [format %d [expr ($tnum>>4)&0xf]]
        append num $inum
      }
    }
##  debug_out "read_teln_rec $type $field => $num" 4
    return $num
  }

  proc process_data { adr1 fields } {
    variable ADR_FORMAT
    variable DATA_ARR
    variable DATA_REC
#   debug_out "process_data \$adr1 $fields" 4
    
    if ![info exists ADR_FORMAT($fields)] {
      internal_error \
			  "Unexpected file format error:\nNo ADR_FORMAT($fields) found!"
    }

### array set addrarr $ADR_FORMAT($fields)
    set plen 0
    set DATA_REC {}
    set addr {}
    set sizes {}
    for {set i 0} {$i < $fields} {incr i} {
      set str2 [read_binary $adr1 $i short]
      set rlen [letohs $str2]
      lappend sizes $rlen
      incr plen $rlen
    }
    set adrdata [string range $adr1 [expr $fields*2] end]

#   debug_out "sizeof adrdata: [string length $adrdata], datalen: $plen" 5
    set addr 0
    for {set i 0} {$i < $fields} {incr i} {
      set size [lindex $sizes $i]
      set offs [expr $addr+$size-1]
      set rec [string range $adrdata $addr $offs]
      lappend DATA_REC $rec
      incr addr $size
    }
    
		array set addr_arr $ADR_FORMAT($fields)
    foreach idx [array names addr_arr] {
#     debug_out "idx=$idx" 5
      switch -glob $idx {
        "Birthday" -
        "Revision" { set DATA_ARR($idx) [read_date_rec $addr_arr($idx)] }
        "Tel.*" -
				"Fax*" { 
          if {$fields == 19} { set typoffs 4 } else { set typoffs 5 } 
          set typidx $addr_arr($idx)
          set numidx [expr $typidx + $typoffs]
          set DATA_ARR($idx) [read_teln_rec $numidx $typidx]
        }
        default {
          set DATA_ARR($idx) [read_data_rec $addr_arr($idx)]
        }
      }
    }
  }

  proc label_entry { w name dname dval args } {
    variable label_font
    variable dialog_font
    variable label_width
	  variable entry_width
    debug_out "label_entry $w $dname $dval" 5

    set name $w.$name 
    set entr [LabelEntry $name -label $dname -justify left\
                -labelwidth $label_width -labelfont $label_font\
								-text $dval -entrybg white -width $entry_width\
								-font $dialog_font]
		pack $entr
		if [llength $args] { $entr configure -state [lindex $args 0] }
    return $entr 
  }

  proc select_row { args } {
    variable top_list 
    variable lb_widget
    variable field_cnt
		variable dataframe
    debug_out "select_row $args" 4

    set selidx [$lb_widget curselection]
    if [string_empty $selidx] return

    $lb_widget selection clear $selidx
    if ![llength $args] return

    set inc [lindex $args 0]
    set newidx [ expr $selidx + $inc]
    set max [expr [$lb_widget size]-1]
    if {$newidx > $max||$newidx < 0} {
      set newidx $selidx
    }
    
    $lb_widget selection set $newidx
    $lb_widget see $newidx
    set selected [$lb_widget get $newidx]
    
		set flen [$lb_widget columncount]
		for {set i 0} {$i<$flen} {incr i} {
		  set field [$lb_widget columncget $i -title]
			$dataframe.entr$i configure -text [lindex $selected $i]
    }
  }

  proc show_single { } {
    variable top_list  
    variable top_level 
    variable field_cnt
    variable lb_widget
    variable dlg_title
		variable dataframe
    variable label_font
    variable dialog_font
    variable label_width
	  variable entry_width
    debug_out "show_single" 4

    if [win_check $top_level [get_text "Address detail view" adr_plug]] return

    set selidx [$lb_widget curselection]
    if [string_empty $selidx] {
      warning [get_text "No record selected for displaying!" adr_plug]
      return
    }
    set selected [$lb_widget get $selidx]

    set buttons [list [get_text "&Backward" adr_plug] \
		                    [get_text "Go to previous address record" adr_plug]\
		                    "[namespace current]::select_row -1"\
                      [get_text "&Close" adr_plug]\
											  [get_text "Close detail view" adr_plug]\
											  "after idle {destroy $top_level}"\
                      [get_text "&Forward" adr_plug]\
											  [get_text "Go to next address record" adr_plug]\
											  "[namespace current]::select_row 1"]

    set title [get_text "Address book entry" adr_plug]
    set dataframe [new_window $top_level $dlg_title $title $buttons 1 $top_list]

		debug_out "selected=$selected" 4
		set flen [$lb_widget columncount]
		for {set i 0} {$i<$flen} {incr i} {
		  set field [$lb_widget columncget $i -title]
			set value [lindex $selected $i]
      pack [LabelEntry $dataframe.entr$i -label "$field:"\
                  -labelwidth $label_width -labelfont $label_font\
				  				-text $value -entrybg white -justify left\
									-width $entry_width -font $dialog_font]
    }

		BWidget::place $top_level 0 0 center $top_list
		wm deiconify $top_level
  }
 
  proc create_listbox { fields adrfile adr_list adr_path } {
    variable ADR_FORMAT
    variable top_list
    variable dlg_title
    variable lb_widget
    variable label_font
    variable listbox_font

    if ![info exists ADR_FORMAT($fields)] {
      format_warning
      return
    }

    set field_names [list 0 [get_text "Nr." adr_plug] right]
    foreach [list idx val] $ADR_FORMAT($fields) { 
      if ![regexp "^NTyp" $idx] { 
			  lappend field_names 0 [get_text $idx adr_plug]
			}
    }

    debug_out "field_names=$field_names" 3
    set title [format [get_text "Address list: %s" adr_plug] $adr_path]
    set buttons [list [get_text "&Show" adr_plug]\
		                    [get_text "Show address detail view" adr_plug]\
                        "[namespace current]::show_single"\
                      [get_text "E&xport..." adr_plug]\
		                    [get_text "Export data to text file" adr_plug]\
											  "[namespace current]::export_data"\
                      [get_text "&Close" adr_plug]\
		                    [get_text "Close address list" adr_plug]\
												"after idle [namespace current]::close_listbox"]
    set sw [new_swindow $top_list $dlg_title $title $buttons 0]
    set lb_widget [tablelist::tablelist $sw.lbx \
                     -background white\
                     -font $listbox_font\
                     -labelrelief flat \
                     -showseparators 1 \
                     -columns $field_names \
                     -labelcommand tablelist::sortByColumn \
                     -height 15 -width 100 -stretch all]
    $lb_widget columnconfigure 0 -sortmode integer
    pack $lb_widget -expand yes -fill both
    $sw setwidget $lb_widget

    bind [$lb_widget bodypath] <Double-Button-1> \
		                "[namespace current]::show_single"
		BWidget::place $top_list 0 0 center .
		wm deiconify $top_list

    debug_out "fields=$fields ADR_FORMAT($fields)=$ADR_FORMAT($fields)" 5
    set AddrList [process_all_data $fields $adrfile $adr_list]
    debug_out "LLength AddrList=[llength $AddrList]" 5

    foreach entr $AddrList { $lb_widget insert end $entr }
  }

  proc close_listbox {} {
    variable top_list
		variable top_level

		set win [get_text "Address detail view" adr_plug]
		set msg [get_text "Close detail window before closing list" adr_plug]
    if [win_check $top_level $win $msg] return

		destroy $top_list
	}

  proc read_adr_data { filename idx_file } {
    variable ADR_FORMAT
    debug_out "adr_listbox $filename $idx_file" 5

    set indexcount 0
    set ptr_list {}

    ## read offset list of valid entries
    if [ObexFile::path_exists file $idx_file] {
      ## ptr_list = ptrlist (adr2csv H.S.)
      set ptr_list [get_verify_offsets $idx_file]
      # foreach ptr $ptr_list {puts "Offs: [format %08x $ptr]"}
      set indexcount [llength $ptr_list]
      debug_out "indexcount=$indexcount" 4
    }

    if $indexcount {
      set msg [format [get_text "%d index entries found," adr_plug] $indexcount]
    } else {
      set msg [get_text "No valid pointer file," adr_plug]
    }
		append msg [get_text " analyzing address book structure..." adr_plug]
		status_msg $msg 

    set adrfile [mem_map $filename]
    debug_out "Size of adrfile: [string length $adrfile]" 2

    ## extract the number of fields
    set fields     [letohs [read_binary $adrfile 0 short]]
    set entrycount [letohs [read_binary $adrfile 1 short]]
    debug_out "fields=$fields, entrycount=$entrycount" 6

    ## compare the number of entries of both files
    if {$indexcount && $indexcount != $entrycount} {
      set afil [file tail $filename]
      set ifil [file tail $idx_file]
      set msg \
  [get_text "Number of entries from both files do not match!" adr_plug]
      append msg \
	[get_text "\n%d entries found in '%s' and %d entries in '%s'" adr_plug]
      append msg [get_text "\nDeleted entries may be displayed." adr_plug]
      warning [format $msg $entrycount $afil $indexcount $ifil]
      set indexcount 0
      set ptr_list {}
    }

    ## adr_list = ptrlist5 (adr2csv H.S.)
    status_msg [get_text "Processing address book contents..." adr_plug]
    set adr_list [get_offsets $fields $entrycount $adrfile]
    status_msg [get_text "Processing address book contents...OK." adr_plug]

    set offsetcount [llength $ptr_list]
    debug_out "offset values: $offsetcount" 3

    ## verify that the offsets are correct
    if $indexcount {
      set tmp_list $adr_list
      set adr_list {}
      for {set counter 0} {$counter < $offsetcount} {incr counter} {
        for {set k 0} {$k < $offsetcount} {incr k} {
          set offset [lindex $tmp_list $k]
          set index  [lindex $ptr_list $k]
          if {$offset == $index} {
            set fmt "offset 0x%08x was verified by pointer list."
            lappend adr_list $offset
          } else {
            if $index {
              set fmt "offset 0x%08x was NOT found in pointer list!"
            }
          }
          status_msg [format $fmt $offset]
        }
      }
    }
    create_listbox $fields $adrfile $adr_list $filename
  }

###
### Listbox callback on selection (Edit) of an entry
###
  proc export_data {} {
    variable export_header_line
    variable exportfile
    variable lb_widget

    set def_ext [file extension $exportfile]
    set types [list [list [get_text "ASCII Text Files <TAB>" adr_plug]     \
                    [list .txt]]\
                    [list [get_text "ASCII Files <Semicolon>" adr_plug]    \
                    [list .dat]]\
                    [list [get_text "CSV Files <Comma separated>" adr_plug]\
                    [list .csv]]\
                    [list [get_text "All files" adr_plug]  [list "*"]]]
    set outn [tk_getSaveFile -parent $lb_widget\
                             -title [get_text "Export file" adr_plug] \
                             -defaultextension $def_ext\
                             -filetypes $types\
                             -initialfile $exportfile]
    if [string_empty $outn] return

debug_var outn
    set new_ext [file extension $outn]
    if [string_empty $new_ext] { set outn $outn$def_ext }

    switch $new_ext {
      .txt    { set separator "\t" }
      .dat    { set separator ";"  }
      .csv    { set separator ","  }
      default { set separator "\t" }
    }
    set numrecs 0
    set fd [open $outn "w"]
    set imax [$lb_widget columncount]
    if $export_header_line {
      set row {}
      for {set i 0} {$i<$imax} {incr i} {
        lappend row [$lb_widget columncget $i -title]
      }
      set line [join $row $separator]
      puts $fd $line
    }
    foreach row [$lb_widget get 0 end] {
      set line [join $row $separator]
      puts $fd $line
      incr numrecs
    }
    close $fd
    set msg [get_text "%d records written to file '%s'" adr_plug]
    status_msg [format $msg $numrecs $outn]
  }


  proc format_warning {} {
    set msg \
	[get_text "Invalid adress file or unsupported file format." adr_plug]
    append msg \
	[get_text "\nUsually on Siemens phones only the file" adr_plug]
    append msg \
	[get_text " called '5fxx.adr' contains the address book" adr_plug]
    append msg \
	[get_text " data. '7fxx.adr' contains the pointer list" adr_plug]
    append msg \
	[get_text " which mark deleted entities and '9fxx.adr'" adr_plug]
    append msg \
	[get_text " contains sort index entries." adr_plug]
    append msg \
	[get_text "\nTry selecting the file '5fxx.adr' for displaying" adr_plug]
    append msg \
	[get_text " the address book data." adr_plug]
    warning $msg
  }

  ### MAIN entry point ###
  proc default_handler { args } {
	  variable top_list
		variable datafile
    variable idxprefix
    variable pathname [lindex $args 0]
    variable datafile [file tail $pathname]
    variable dir_name [file dirname $pathname]
    
    if [win_check $top_list [get_text "Address list" adr_plug] ] return
		
		set indexfile "$idxprefix[string range $datafile 2 end]"
    read_adr_data $pathname "$dir_name/$indexfile"
  }

}
obextool 0.35-0ubuntu2 / usr / share / obextool / plugins / adr_plugin.tcl
