Posted to tcl by jeremy_c at Fri Sep 10 07:02:11 GMT 2010view raw
- namespace eval ::adif {}
- proc ::adif::parse {args} {
- set raw {}
- set dataCmd {}
- set tagRegexp {<([A-Z0-9_/]+)(:([0-9]+))?([A-Z])?>}
- foreach {arg val} $args {
- switch -- $arg {
- -string {
- set raw $val
- }
- -filename {
- try {
- set fh [open $val r]
- fconfigure $fh -encoding utf-8
- set raw [read $fh]
- close $fh
- } on error args {
- error "Could not read file '$val': $args"
- }
- }
- -command {
- set dataCmd $val
- }
- default {
- error "::adif::parse Invalid option '$arg' passed"
- }
- }
- }
- if {$raw eq {}} {
- error "::adif::parse [-string str] [-filename filename]"
- }
- set pos 0
- set record [dict create]
- if { [regexp -indices -nocase <eoh> $raw whole] } {
- lassign $whole eohPos pos
- regexp -indices -nocase $tagRegexp $raw whole
- if {[lindex $whole 0] < $eohPos} {
- set eohPos [lindex $whole 0]
- set pos $eohPos
- incr eohPos -1
- dict set record comment [string trim [string range $raw 0 $eohPos]]
- }
- }
- set records [list]
- set matches [regexp -inline -all -indices -nocase -start $pos $tagRegexp $raw]
- foreach {whole name _len len typ} $matches {
- set fieldValue {}
- set fieldName [string tolower [string range $raw {*}$name]]
- if {$len != {-1 -1}} {
- set len [string range $raw {*}$len]
- set startPos [lindex $whole 1]
- incr startPos
- set fieldValue [string range $raw $startPos $startPos+$len]
- }
- if {$fieldName eq "eor" || $fieldName eq "eoh"} {
- lappend records $record
- set record [dict create]
- } else {
- dict set record $fieldName $fieldValue
- }
- }
- return $records
- }
- proc ::adif::test {} {
- set raw {This is a header comment
- <EOH>
- <ADDRESS:47>SCOTT D SOMEONEL
- 1043 KRUMROY RD
- 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>
- }
- puts [time {::adif::parse -string $raw} 1000]
- }
- ::adif::test