Posted to tcl by jeremy_c at Fri Sep 10 07:02:11 GMT 2010view raw

  1. namespace eval ::adif {}
  2.  
  3. proc ::adif::parse {args} {
  4. set raw {}
  5. set dataCmd {}
  6. set tagRegexp {<([A-Z0-9_/]+)(:([0-9]+))?([A-Z])?>}
  7.  
  8. foreach {arg val} $args {
  9. switch -- $arg {
  10. -string {
  11. set raw $val
  12. }
  13. -filename {
  14. try {
  15. set fh [open $val r]
  16. fconfigure $fh -encoding utf-8
  17. set raw [read $fh]
  18. close $fh
  19. } on error args {
  20. error "Could not read file '$val': $args"
  21. }
  22. }
  23. -command {
  24. set dataCmd $val
  25. }
  26. default {
  27. error "::adif::parse Invalid option '$arg' passed"
  28. }
  29. }
  30. }
  31.  
  32. if {$raw eq {}} {
  33. error "::adif::parse [-string str] [-filename filename]"
  34. }
  35.  
  36. set pos 0
  37. set record [dict create]
  38. if { [regexp -indices -nocase <eoh> $raw whole] } {
  39. lassign $whole eohPos pos
  40.  
  41. regexp -indices -nocase $tagRegexp $raw whole
  42. if {[lindex $whole 0] < $eohPos} {
  43. set eohPos [lindex $whole 0]
  44. set pos $eohPos
  45.  
  46. incr eohPos -1
  47. dict set record comment [string trim [string range $raw 0 $eohPos]]
  48. }
  49. }
  50.  
  51. set records [list]
  52. set matches [regexp -inline -all -indices -nocase -start $pos $tagRegexp $raw]
  53.  
  54. foreach {whole name _len len typ} $matches {
  55. set fieldValue {}
  56. set fieldName [string tolower [string range $raw {*}$name]]
  57. if {$len != {-1 -1}} {
  58. set len [string range $raw {*}$len]
  59. set startPos [lindex $whole 1]
  60. incr startPos
  61.  
  62. set fieldValue [string range $raw $startPos $startPos+$len]
  63. }
  64.  
  65. if {$fieldName eq "eor" || $fieldName eq "eoh"} {
  66. lappend records $record
  67. set record [dict create]
  68. } else {
  69. dict set record $fieldName $fieldValue
  70. }
  71. }
  72.  
  73. return $records
  74. }
  75.  
  76. proc ::adif::test {} {
  77. set raw {This is a header comment
  78. <EOH>
  79.  
  80. <ADDRESS:47>SCOTT D SOMEONEL
  81. 1043 KRUMROY RD
  82. AKRON, OH 44306 <A_INDEX:1>0 <ARRL_SECT:2>OH <BAND:3>10m <BAND_RX:3>10m <CALL:6>KB8KSU <CNTY:9>OH,Summit <CONT:2>NA <COUNTRY:13>United States <CQZ:1>4 <EQSL_QSLSDATE:8>20100703 <EQSL_QSL_RCVD:1>R <EQSL_QSL_SENT:1>Y <FREQ:6>28.405 <FREQ_RX:6>28.405 <GRIDSQUARE:6>EN91ga <ITUZ:1>8 <K_INDEX:1>0 <LAT:4>42.4 <LON:4>73.5 <LOTW_QSLRDATE:8>20100703 <LOTW_QSL_RCVD:1>R <LOTW_QSL_SENT:1>Y <MODE:3>SSB <MY_CITY:10>Doylestown <MY_CNTY:5>Wayne <MY_CQ_ZONE:1>4 <MY_GRIDSQUARE:6>EN90ew <MY_ITU_ZONE:1>8 <MY_LAT:9>40.945042 <MY_LON:9>-81.66589 <MY_NAME:6>Jeremy <MY_POSTAL_CODE:5>44230 <MY_STATE:2>OH <MY_STREET:17>38211 Clinton Rd. <NAME:5>Scott <OPERATOR:6>KB8LFA <QSL_RCVD:1>Y <QSLRDATE:8>20050723 <QSL_SENT:1>Y <QSO_COMPLETE:1>Y <QSO_DATE:8>19910109 <TIME_ON:6>201000 <QSO_DATE_OFF:8>19910110 <TIME_OFF:6>194000 <QTH:9>Akron, OH <RST_SENT:2>59 <RST_RCVD:2>59 <SFI:1>0 <STATE:2>OH <TX_PWR:3>100 <APP_SMARTLOG_ENTITY:13>United States <APP_SMARTLOG_EQSL_LOCATION:15>Doylestown Home <APP_SMARTLOG_LOTW_LOCATION:15>Doylestown Home <APP_SMARTLOG_PRIMARY_PREFIX:1>K <APP_SMARTLOG_UTC_OFFSET:1>5 <EOR>
  83. }
  84.  
  85. puts [time {::adif::parse -string $raw} 1000]
  86. }
  87.  
  88. ::adif::test