· 7 years ago · Dec 14, 2018, 10:50 AM
1package require Tk 8.6
2package require sqlite3
3
4sqlite3 db expenses.db
5
6db eval {
7 PRAGMA auto_vacuum='incremental';
8}
9
10db eval {
11 CREATE TABLE IF NOT EXISTS expenses (
12 id INTEGER PRIMARY KEY,
13 vendor TEXT,
14 date TEXT,
15 reimbursement TEXT,
16 amount REAL,
17 paid INTEGER,
18 receipt BLOB,
19 receipt_extension TEXT
20 )
21}
22
23proc db-update {} {
24 event generate . <<DbUpdate>>
25}
26
27proc save-entry {input existing} {
28 set vendor [$input.place get]
29 set amount [$input.amount get]
30 set reimbursement [$input.txn get]
31 set date [$input.date get]
32
33 if {$existing == ""} {
34 db eval {
35 INSERT INTO expenses (vendor, amount, reimbursement, date) VALUES
36 (:vendor, :amount, :reimbursement, :date)
37 }
38 } else {
39 db eval {
40 UPDATE expenses SET
41 vendor = :vendor,
42 amount = :amount,
43 reimbursement = :reimbursement,
44 date = :date
45 WHERE id == :existing
46 }
47 }
48
49 if {[info commands $input.file] != {}} {
50 set infile [$input.file get]
51 } else {
52 set infile ""
53 }
54 if {$infile != ""} {
55 set inhandle [open $infile]
56 fconfigure $inhandle -translation binary
57 set receipt [read $inhandle]
58 set receipt_extension [file extension $infile]
59 if {$existing != ""} {
60 set row $existing
61 } else {
62 set row [db last_insert_rowid]
63 }
64 db eval {
65 UPDATE expenses SET
66 receipt = :receipt,
67 receipt_extension = :receipt_extension
68 WHERE id == :row
69 }
70 set continued " with receipt"
71 } else {
72 set continued ""
73 }
74 db-update
75 tk_messageBox -type ok -message "Saved payment to $vendor on $date$continued"
76 destroy [winfo parent $input]
77}
78
79proc render-input {existing} {
80 set parent [toplevel .inputparent]
81 wm title $parent "Expense Input"
82 set input [
83 ttk::labelframe $parent.inputs -labelanchor n -text "Expense input"
84 ]
85
86 set row 1
87
88 ttk::label $input.placelabel -text "Location"
89 grid $input.placelabel -row $row -column 0 -sticky e
90 ttk::entry $input.place
91 grid $input.place -row $row -column 1 -columnspan 2
92
93 incr row
94
95 ttk::label $input.amountlabel -text "Amount"
96 grid $input.amountlabel -row $row -column 0 -sticky e
97 ttk::entry $input.amount
98 grid $input.amount -row $row -column 1 -columnspan 2
99
100 incr row
101
102 ttk::label $input.datelabel -text "Date"
103 grid $input.datelabel -row $row -column 0 -sticky e
104 ttk::entry $input.date
105 $input.date insert 0 [
106 clock format [clock seconds] -format {%G-%m-%d}
107 ]
108 grid $input.date -row $row -column 1 -columnspan 2
109
110 incr row
111
112 ttk::label $input.txnlabel -text "Payment ID"
113 grid $input.txnlabel -row $row -column 0 -sticky e
114 ttk::entry $input.txn
115 grid $input.txn -row $row -column 1 -columnspan 2
116
117 incr row
118
119 ttk::label $input.filelabel -text "Receipt image"
120 grid $input.filelabel -row $row -column 0 -sticky e
121 ttk::entry $input.file -textvariable receiptfile_in
122 grid $input.file -row $row -column 1 -columnspan 2
123 ttk::button $input.filepick -text "Select" -command {
124 set ::receiptfile_in [tk_getOpenFile]
125 }
126 grid $input.filepick -row $row -column 3
127
128 incr row
129
130 ttk::button $input.save -text "Save" -command [list save-entry $input $existing]
131 grid $input.save -row $row -columnspan 4
132
133 if {$existing != {}} {
134 $input.date delete 0 end
135 foreach column {vendor amount date reimbursement} \
136 field {place amount date txn} {
137 $input.$field insert 0 [
138 db onecolumn "
139 SELECT $column FROM expenses WHERE id == :existing
140 "
141 ]
142 }
143 }
144
145 pack $input
146}
147
148proc update-table {expense_table} {
149 foreach id [db eval {SELECT id FROM expenses}] {
150 lassign [db eval {
151 SELECT date, vendor, amount, reimbursement, (receipt IS NOT NULL)
152 FROM expenses WHERE id == :id
153 }] date vendor amount reimbursement has_receipt
154 set has_receipt [expr {$has_receipt?"Yes":"No"}]
155 if {[$expense_table exists $id]} {
156 $expense_table item $id -text $date -values [
157 list $vendor $amount $reimbursement $has_receipt
158 ]
159 } else {
160 $expense_table insert {} end -id $id -text $date -values [
161 list $vendor $amount $reimbursement $has_receipt
162 ]
163 }
164 }
165 foreach id [$expense_table children {}] {
166 if {![db exists {SELECT 1 FROM expenses WHERE id == :id}]} {
167 $expense_table delete $id
168 }
169 }
170}
171
172proc edit-entry {expense_table} {
173 render-input [lindex [$expense_table selection] 0]
174}
175
176proc delete-entry {expense_table} {
177 set rowid [lindex [$expense_table selection] 0]
178 db eval {
179 DELETE FROM expenses WHERE id == :rowid
180 }
181 db-update
182}
183
184proc selected-dl {expense_table dl_button} {
185 set rowid [lindex [$expense_table selection] 0]
186 set receipt [db onecolumn {
187 SELECT (receipt IS NOT NULL) FROM expenses WHERE id == :rowid
188 }]
189 set state [expr {$receipt?"normal":"disabled"}]
190 $dl_button configure -state $state
191}
192
193proc dl-image {expense_table} {
194 set rowid [lindex [$expense_table selection] 0]
195 set extension [db onecolumn {
196 SELECT receipt_extension FROM expenses WHERE id == :rowid
197 }]
198 set save_file [tk_getSaveFile -initialfile receipt$extension]
199 set outhandle [open $save_file w]
200 fconfigure $outhandle -translation binary
201 set blobhandle [db incrblob -readonly expenses receipt $rowid]
202 fconfigure $blobhandle -translation binary
203 set bytes [fcopy $blobhandle $outhandle]
204 close $outhandle
205 close $blobhandle
206 tk_messageBox -type ok -message "Saved receipt image to $save_file ($bytes bytes)"
207}
208
209proc quit-app {} {
210 db eval {PRAGMA incremental_vacuum}
211 destroy .
212}
213
214set top [
215 ttk::labelframe .top -labelanchor n -text "Expense management"
216]
217wm title . "Expense Management"
218pack $top -anchor n -fill x
219
220set tablecols {vendor amount reimbursement has_reciept}
221set tablelabel {Date Vendor Amount {Reimbursement Txn} {Has Receipt?}}
222set expense_table [
223 ttk::treeview $top.table -columns $tablecols -selectmode browse
224]
225foreach column [linsert $tablecols 0 {#0}] label $tablelabel {
226 $expense_table heading $column -text $label
227}
228pack $expense_table
229
230update-table $expense_table
231bind . <<DbUpdate>> [list update-table $expense_table]
232
233set buttons [ttk::frame $top.buttons]
234ttk::button $buttons.new -text "New" -command [list render-input {}]
235ttk::button $buttons.edit -text "Edit" -command [list edit-entry $expense_table]
236ttk::button $buttons.download -text "Download Receipt" \
237 -command [list dl-image $expense_table] -state disabled
238ttk::button $buttons.delete -text "Delete" -command [list delete-entry $expense_table]
239ttk::button $buttons.quit -text "Quit" -command quit-app
240pack $buttons.new $buttons.edit $buttons.download \
241 $buttons.delete $buttons.quit -side left
242pack $buttons -anchor s
243
244bind all <<TreeviewSelect>> [list selected-dl $expense_table $buttons.download]