LedgerQIF

Import QIF file (the most important part of ledger.tcl - http://pdqi.com/ledger.html )


<...>
set pc(xaction:fields)  {tid tnum tpayee tmemo tsum tdate treco tacct tgroup tsched}
set pc(xaction:defs)    {{} {} {} {} 0 0 0 0 {} {}}
<...>

set fp [open $fname r]

set insplit 0
foreach j $pc(xaction:fields) k $pc(xaction:defs) {
        set p($j) $k
}
set s 0
set cnt 0

while {[set n [gets $fp str]]>0} {
        set ch [string index $str 0]
        set rest [string trim [string range $str 1 end]]
        if {[regexp {^Type} $str]} continue

        switch $ch {
                D {
                        if {[catch {set p(tdate) [clock scan $rest]}]} {
                                set p(tdate) [clock seconds]
                                puts $lf "Invalid date, using today: $str"
                        }
                  }
                T {
                        set p(tsum) $rest
                        regsub -all -- , $p(tsum) {} p(tsum)
                        set p(tsum) [expr $p(tsum)]
                  }
                C { set p(treco) 1 }
                P { set p(tpayee) $rest }
                N { set p(tnum) $rest }
                M { set p(tmemo) $rest }
                L { set p(tgroup) $rest }
                $ { 
                        regsub -all -- , $rest {} rest
                        set split(sum:$s) $rest
                  }
                S {
                        incr s
                        set split(cat:$s) $rest
                  }
                ^ {
                        set avals {}
                        if {$s} {
                                set accts {}
                                for {set i 1} {$i<=$s} {incr i} {
                                        lappend accts $split(cat:$i)
                                        lappend avals $split(cat:$i) $split(sum:$i)
                                }
                        } else {
                                set accts [list $p(tgroup)]
                                set avals [list $p(tgroup) $p(tsum)]
                        }
                        set skip 0
                        foreach i $_(impaccts) {
                                if {[lsearch $accts $i]>=0} {
                                        set skip 1
                                }
                        }
                        if {$skip} {
                                puts $lf "Already imported!: $str"
                        } elseif {$p(tsum) == 0} {
                                puts $lf "Skipping zero sum!: $str"
                        } else {
                                foreach i $accts {
                                        if {$_(-catlower)} {
                                                set i [string tolower $i]
                                        }
                                        if {[FieldLookup $__ aclist aname $i] == {}} {
                                                $__ newacct aname $i acatagory 1
                                        }
                                }
                                set p(tid) [incr _(-xaction:last)]
                                set p(tgroup) [incr _(-xaction:glast)]
                                set p(tacct) $targacct
                                set rc {}
                                foreach i $pc(xaction:fields) {
                                        lappend rc $p($i)
                                }
                                set pt($p(tid)) $rc
                                lappend pg($p(tgroup)) $p(tid)
                                
                                $__ add2field aclist $targacct attl $p(tsum) atransnums 1
                                
                                foreach {nacct nsum} $avals {
                                        if {$_(-catlower)} {
                                                set nacct [string tolower $nacct]
                                        }
                                        set nid2 [incr _(-xaction:last)]
                                        lappend pg($p(tgroup)) $nid2
                                        set pt($nid2) $pt($p(tid))
                                        set nsum [expr {-$nsum}]
                                        
                                        set nacct [FieldLookup $__ aclist aname $nacct]
                                        
                                        $__ updatetbl xaction $nid2 tacct $nacct tid $nid2 tsum $nsum
                                        $__ add2field aclist $nacct attl $nsum atransnums 1
                                }
                                foreach j $pc(xaction:fields) k $pc(xaction:defs) {
                                        set p($j) $k
                                }
                                set s 0
                                array unset split
                                if {![expr {[incr cnt]%10}]} {
                                        set _(status1) "$cnt [mc {transactions imported}]"
                                        update
                                }
                        }
                }
        }
}

set _(status1) "$cnt [mc {transactions imported}]"
close $fp
<...>