IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2025-02-25 18:55:30 -06:00
Code Issues Packages Projects Releases Wiki Activity

QIF Import: Fix support for multi-byte account separators.

Browse Source 
In doing so, a number of reusable Scheme string manipulation procedures were written and placed in string.scm. These are now available to all Scheme code by automatic inclusion in main.scm.

The new Scheme procedures are:
gnc:string-rcontains    (a variation on string-contains)
gnc:substring-count     (a variation on string-count)
gnc:substring-split     (a variation on string-split)
gnc:substring-replace   (search/replace a substring)
gnc:string-replace-char (search/replace a character)
gnc:string-delete-chars (delete a variety of characters)

Finally, the custom version of string-split was removed because Guile 1.4 is no longer supported and later versions come with this procedure.
BP


git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@17191 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Charles Day
2008-06-06 16:46:03 +00:00
parent 9e7438bfd5
commit e7bb4ac09f
8 changed files with 395 additions and 311 deletions
Download Patch File Download Diff File Expand all files Collapse all files

20
src/import-export/qif-import/qif-dialog-utils.scm
View File

@@ -637,11 +637,10 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (qif-import:get-account-name fullname)
(let ((lastsep (string-rindex fullname
(string-ref (gnc-get-account-separator-string)
0))))
(if lastsep
(substring fullname (+ lastsep 1))
(let* ((sep (gnc-get-account-separator-string))
(last-sep (gnc:string-rcontains fullname sep)))
(if last-sep
(substring fullname (+ last-sep (string-length sep)))
fullname)))
@@ -839,7 +838,8 @@
(let ((accts '())
(acct-tree '())
(separator (string-ref (gnc-get-account-separator-string) 0)))
(sep (gnc-get-account-separator-string)))
;; get the new accounts from the account map
(for-each
(lambda (acctmap)
@@ -849,8 +849,8 @@
(if (qif-map-entry:display? v)
(set! accts
(cons
(cons (string-split (qif-map-entry:gnc-name v)
separator)
(cons (gnc:substring-split (qif-map-entry:gnc-name v)
sep)
(qif-map-entry:new-acct? v))
accts)))
#f)
@@ -862,9 +862,7 @@
(lambda (acct)
(set! accts
(cons
(cons (string-split
(gnc-account-get-full-name acct)
separator)
(cons (gnc:substring-split (gnc-account-get-full-name acct) sep)
#f)
accts)))
(gnc-account-get-descendants-sorted (gnc-get-current-root-account)))

16
src/import-export/qif-import/qif-guess-map.scm
View File

@@ -97,6 +97,11 @@
(set! qif-security-list (safe-read))
(set! saved-sep (safe-read))
;; Convert the separator to a string if necessary.
;; It was a character prior to 2.2.6.
(if (char? saved-sep)
(set! saved-sep (string saved-sep)))
;; Process the QIF account mapping.
(if (not (list? qif-account-list))
(set! qif-account-hash (make-hash-table 20))
@@ -162,8 +167,8 @@
(define (qif-import:read-map tablist tab-sep)
(let* ((table (make-hash-table 20))
(sep (string-ref (gnc-get-account-separator-string) 0))
(changed-sep? (and (char? tab-sep) (not (char=? tab-sep sep)))))
(sep (gnc-get-account-separator-string))
(changed-sep? (and (string? tab-sep) (not (string=? tab-sep sep)))))
(for-each
(lambda (entry)
@@ -175,8 +180,9 @@
(let ((acct-name (qif-map-entry:gnc-name value)))
(if (string? acct-name)
(qif-map-entry:set-gnc-name! value
(string-map (lambda (c) (if (char=? c tab-sep) sep c))
acct-name)))))
(gnc:substring-replace acct-name
tab-sep
sep)))))
(qif-map-entry:set-display?! value #f)
(hash-set! table key value)))
@@ -295,7 +301,7 @@
(display ";;; GnuCash separator used in these mappings")
(newline)
(write (string-ref (gnc-get-account-separator-string) 0))
(write (gnc-get-account-separator-string))
(newline)))))

6
src/import-export/qif-import/qif-parse.scm
View File

@@ -553,7 +553,7 @@
(define (qif-parse:parse-number/format value-string format)
(case format
((decimal)
(let* ((filtered-string (string-remove-chars value-string ",$'"))
(let* ((filtered-string (gnc:string-delete-chars value-string ",$'"))
(read-val (with-input-from-string filtered-string
(lambda () (read)))))
(if (number? read-val)
@@ -564,8 +564,8 @@
GNC-RND-ROUND))
(gnc-numeric-zero))))
((comma)
(let* ((filtered-string (string-replace-char
(string-remove-chars value-string ".$'")
(let* ((filtered-string (gnc:string-replace-char
(gnc:string-delete-chars value-string ".$'")
#\, #\.))
(read-val (with-input-from-string filtered-string
(lambda () (read)))))

501
src/import-export/qif-import/qif-to-gnc.scm
View File

File diff suppressed because it is too large Load Diff

25
src/import-export/qif-import/qif-utils.scm
View File

@@ -5,7 +5,7 @@
;;; Bill Gribble <grib@billgribble.com> 20 Feb 2000
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(use-modules (srfi srfi-13))
(use-modules (ice-9 regex))
(define (simple-filter pred list)
@@ -49,33 +49,11 @@
(regexp-substitute/global #f rexpstr str 'pre 'post)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; string-remove-chars
;;
;; Removes all characters in string "chars" from string "str".
;; Example: (string-remove-chars "abcd" "cb") returns "ad".
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (string-remove-chars str chars)
(string-delete str (lambda (c) (string-index chars c))))
(define (string-char-count str char)
(length (simple-filter (lambda (elt) (eq? elt char))
(string->list str))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; string-replace-char
;;
;; Replaces all occurrences of char "old" with char "new".
;; Example: (string-replace-char "foo" #\o #\c) returns "fcc".
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (string-replace-char str old new)
(string-map (lambda (c) (if (char=? c old) new c)) str))
(define (string-replace-char! str old new)
(let ((rexpstr
(if (not (eq? old #\.))
@@ -89,4 +67,3 @@
(string-downcase
(string-remove-leading-space
(string-remove-trailing-space str)))))

1
src/scm/Makefile.am
View File

@@ -7,6 +7,7 @@ gncscmmoddir = ${GNC_SHAREDIR}/guile-modules/gnucash
gncscmmod_DATA = main.scm price-quotes.scm
gnc_regular_scm_files = \
string.scm \
command-line.scm \
doc.scm \
fin.scm \

16
src/scm/main.scm
View File

@@ -37,6 +37,7 @@
;; files we can load from the top-level because they're "well behaved"
;; (these should probably be in modules eventually)
(load-from-path "string.scm")
(load-from-path "doc.scm")
(load-from-path "main-window.scm") ;; depends on app-utils (N_, etc.)...
(load-from-path "fin.scm")
@@ -56,7 +57,6 @@
(export gnc:safe-strcmp) ;; only used by aging.scm atm...
(re-export hash-fold)
(re-export string-split)
;; from command-line.scm
(export gnc:*doc-path*)
@@ -127,20 +127,6 @@
(cons joinstr (cons (car remaining-elements)
(loop (cdr remaining-elements)))))))))
(define (string-split str char)
(let ((parts '())
(first-char #f))
(let loop ((last-char (string-length str)))
(set! first-char (string-rindex str char 0 last-char))
(if first-char
(begin
(set! parts (cons (substring str (+ 1 first-char) last-char)
parts))
(loop first-char))
(set! parts (cons (substring str 0 last-char) parts))))
parts))
(define (gnc:backtrace-if-exception proc . args)
(define (dumper key . args)
(let ((stack (make-stack #t dumper)))

121
src/scm/string.scm Normal file
View File

@@ -0,0 +1,121 @@
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2 of
;; the License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, contact:
;;
;; Free Software Foundation Voice: +1-617-542-5942
;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
;; Boston, MA 02110-1301, USA gnu@gnu.org
(use-modules (srfi srfi-13))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; gnc:string-rcontains
;;
;; Similar to string-contains, but searches from the right.
;;
;; Example: (gnc:string-rcontains "foobarfoobarf" "bar")
;; returns 9.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-public (gnc:string-rcontains s1 s2)
(let ((s2len (string-length s2)))
(let loop ((i (string-contains s1 s2))
(retval #f))
(if i
(loop (string-contains s1 s2 (+ i s2len)) i)
retval))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; gnc:substring-count
;;
;; Similar to string-count, but searches for a substring rather
;; than a single character.
;;
;; Example: (gnc:substring-count "foobarfoobarfoo" "bar")
;; returns 2.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-public (gnc:substring-count s1 s2)
(let ((s2len (string-length s2)))
(let loop ((i (string-contains s1 s2))
(retval 0))
(if i
(loop (string-contains s1 s2 (+ i s2len)) (+ 1 retval))
retval))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; gnc:substring-split
;;
;; Similar to string-split, but the delimiter is a string
;; rather than a single character.
;;
;; Example: (gnc:substring-split "foobarfoobarf" "bar") returns
;; ("foo" "foo" "f").
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-public (gnc:substring-split s1 s2)
(let ((i (string-contains s1 s2)))
(if i
(cons (substring s1 0 i)
(gnc:substring-split (substring s1 (+ i (string-length s2))) s2))
(list s1))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; gnc:substring-replace
;;
;; Search for all occurrences in string "s1" of string "s2" and
;; replace them with string "s3".
;;
;; Example: (gnc:substring-replace "foobarfoobar" "bar" "xyz")
;; returns "fooxyzfooxyz".
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-public (gnc:substring-replace s1 s2 s3)
(let ((s2len (string-length s2)))
(let loop ((start1 0)
(i (string-contains s1 s2)))
(if i
(string-append (substring s1 start1 i)
s3
(loop (+ i s2len) (string-contains s1 s2 (+ i s2len))))
(substring s1 start1)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; gnc:string-replace-char
;;
;; Replaces all occurrences in string "s" of character "old"
;; with character "new".
;;
;; Example: (gnc:string-replace-char "foo" #\o #\c) returns
;; "fcc".
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-public (gnc:string-replace-char s old new)
(string-map (lambda (c) (if (char=? c old) new c)) s))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; gnc:string-delete-chars
;;
;; Filter string "s", retaining only those characters that do not
;; appear in string "chars".
;;
;; Example: (gnc:string-delete-chars "abcd" "cb") returns "ad".
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-public (gnc:string-delete-chars s chars)
(string-delete s (lambda (c) (string-index chars c))))