Add io wrapper handling UTF-8 BOM.

This commit is contained in:
Dominik Pantůček 2023-04-08 20:35:41 +02:00
parent 6b8bffdd41
commit d72cde9c04
5 changed files with 80 additions and 9 deletions

View file

@ -43,7 +43,7 @@ BBSTOOL-DEPS=bbstool.scm testing.import.scm listing.import.scm \
bank-fio.import.scm members-payments.import.scm \ bank-fio.import.scm members-payments.import.scm \
web-static.import.scm environment.import.scm \ web-static.import.scm environment.import.scm \
mailman.import.scm util-set-list.import.scm \ mailman.import.scm util-set-list.import.scm \
util-time.import.scm util-tag.import.scm util-time.import.scm util-tag.import.scm util-io.import.scm
BBSTOOL-OBJS=bbstool.o testing.o listing.o month.o period.o ansi.o \ BBSTOOL-OBJS=bbstool.o testing.o listing.o month.o period.o ansi.o \
dictionary.o command-line.o members-base.o utils.o primes.o \ dictionary.o command-line.o members-base.o utils.o primes.o \
@ -51,7 +51,7 @@ BBSTOOL-OBJS=bbstool.o testing.o listing.o month.o period.o ansi.o \
members-print.o member-fees.o members-dir.o csv-simple.o \ members-print.o member-fees.o members-dir.o csv-simple.o \
bank-account.o bank-fio.o members-payments.o member-parser.o \ bank-account.o bank-fio.o members-payments.o member-parser.o \
web-static.o environment.o mailman.o util-set-list.o \ web-static.o environment.o mailman.o util-set-list.o \
util-time.o util-tag.o util-time.o util-tag.o util-io.o
.PHONY: imports .PHONY: imports
imports: $(BBSTOOL-DEPS) imports: $(BBSTOOL-DEPS)
@ -199,7 +199,7 @@ members-dir.o: members-dir.import.scm
members-dir.import.scm: $(MEMBERS-DIR-SOURCES) members-dir.import.scm: $(MEMBERS-DIR-SOURCES)
CSV-SIMPLE-SOURCES=csv-simple.scm testing.import.scm \ CSV-SIMPLE-SOURCES=csv-simple.scm testing.import.scm \
progress.import.scm progress.import.scm util-io.import.scm
csv-simple.o: csv-simple.import.scm csv-simple.o: csv-simple.import.scm
csv-simple.import.scm: $(CSV-SIMPLE-SOURCES) csv-simple.import.scm: $(CSV-SIMPLE-SOURCES)
@ -256,3 +256,8 @@ UTIL-TAG-SOURCES=util-tag.scm
util-tag.o: util-tag.import.scm util-tag.o: util-tag.import.scm
util-tag.import.scm: $(UTIL-TAG-SOURCES) util-tag.import.scm: $(UTIL-TAG-SOURCES)
UTIL-IO-SOURCES=util-io.scm
util-io.o: util-io.import.scm
util-io.import.scm: $(UTIL-IO-SOURCES)

View file

@ -73,6 +73,14 @@
(num (if numrow (cadr numrow) "ERROR")) (num (if numrow (cadr numrow) "ERROR"))
(bankrow (assoc "bankId" head)) (bankrow (assoc "bankId" head))
(bank (if bankrow (cadr bankrow) "ERROR"))) (bank (if bankrow (cadr bankrow) "ERROR")))
(print head)
(print numrow)
(print bankrow)
(print (assoc (caar head) head))
(print (caar head))
(print "accountId")
(print (equal? "accountId" (caar head)))
(print (string->list (caar head)))
(make-bank-account num bank (make-bank-account num bank
(map make-fio-transaction (cdr body)))) (map make-fio-transaction (cdr body))))
(let () (let ()

View file

@ -36,11 +36,11 @@
(import scheme (import scheme
(chicken base) (chicken base)
(chicken keyword) (chicken keyword)
(chicken io)
(chicken irregex) (chicken irregex)
(chicken condition) (chicken condition)
testing testing
progress) progress
util-io)
;; Curry version of line parser with configurable cell separator and ;; Curry version of line parser with configurable cell separator and
;; string delimiter. Returns a list of lists of strings. ;; string delimiter. Returns a list of lists of strings.
@ -110,7 +110,7 @@
(lambda (ex) (lambda (ex)
(ret #f)) (ret #f))
(lambda () (lambda ()
(let ((lines (read-lines (open-input-file fn)))) (let ((lines (read-lines/no-bom (open-input-file fn))))
(apply csv-parse-lines lines args))))))) (apply csv-parse-lines lines args)))))))
;; Splits CSV into header and body based on the first empty row. ;; Splits CSV into header and body based on the first empty row.

View file

@ -86,7 +86,7 @@
;; Merges bank account statement into members payment keys. The ;; Merges bank account statement into members payment keys. The
;; payment key will be a list of transactions. ;; payment key will be a list of transactions.
(define (members-payments-process-bank mb ba last-checked) (define (members-payments-process-bank mb ba last-checked all-accounts)
(let loop ((mb mb) (let loop ((mb mb)
(transactions (bank-account-transactions ba))) (transactions (bank-account-transactions ba)))
(if (null? transactions) (if (null? transactions)
@ -104,7 +104,10 @@
(if (and (or (not last-checked) (if (and (or (not last-checked)
(> (bank-transaction-id transaction) (> (bank-transaction-id transaction)
last-checked)) last-checked))
(> (bank-transaction-amount transaction) 0)) (> (bank-transaction-amount transaction) 0)
(not (bank-accounts-member? all-accounts
(bank-transaction-account transaction)
(bank-transaction-bank transaction))))
(members-base-add-unpaired mb transaction) (members-base-add-unpaired mb transaction)
mb)) mb))
(cdr transactions)))))) (cdr transactions))))))
@ -163,7 +166,7 @@
(let () (let ()
(progress%-advance (/ idx total)) (progress%-advance (/ idx total))
(loop (if (car accounts) (loop (if (car accounts)
(members-payments-process-bank mb (car accounts) last-checked) (members-payments-process-bank mb (car accounts) last-checked accounts)
mb) mb)
(add1 idx) (add1 idx)
(cdr accounts)))))) (cdr accounts))))))

55
src/util-io.scm Normal file
View file

@ -0,0 +1,55 @@
;;
;; util-io.scm
;;
;; Special IO extensions to deal with weird stuff.
;;
;; ISC License
;;
;; Copyright 2023 Brmlab, z.s.
;; Dominik Pantůček <dominik.pantucek@trustica.cz>
;;
;; Permission to use, copy, modify, and/or distribute this software
;; for any purpose with or without fee is hereby granted, provided
;; that the above copyright notice and this permission notice appear
;; in all copies.
;;
;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
;; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
;;
(declare (unit util-io))
(module
util-io
(
read-lines/no-bom
)
(import scheme
(chicken io))
;; If given string begins with UTF-8 BOM, it is removed.
(define (remove-optional-bom str)
(if (< (string-length str) 3)
str
(let ((maybe-bom (substring str 0 3)))
(if (string=? maybe-bom "\xEF\xBB\xBF")
(substring str 3)
str))))
;; Reads lines from given input port, discarding BOM at the beginning
;; of the first line if there is any.
(define (read-lines/no-bom ip)
(let ((lines (read-lines ip)))
(if (null? lines)
lines
(cons (remove-optional-bom (car lines))
(cdr lines)))))
)