New function gnc:html-string-sanitize

Function to sanitize strings prior to adding to html report. This is
functionally similar to jqplot-escape-string, and is not locale sensitive.

gnucash/report/report-system/html-utilities.scm

@@ -853,3 +853,17 @@
     report-id
     (_ "No data")
     (_ "The selected accounts contain no data/transactions (or only zeroes) for the selected time period")))
+
+;; function to sanitize strings prior to sending to html
+(define (gnc:html-string-sanitize str)
+  (with-output-to-string
+    (lambda ()
+      (string-for-each
+       (lambda (c)
+         (display
+          (case c
+            ((#\&) "&")
+            ((#\<) "&lt;")
+            ((#\>) "&gt;")
+            (else c))))
+       str))))

gnucash/report/report-system/report-system.scm

@@ -119,6 +119,7 @@
 (export gnc:html-make-generic-simple-warning)
 (export gnc:html-make-empty-data-warning)
 (export gnc:html-make-options-link)
+(export gnc:html-string-sanitize)
 
 ;; report.scm
 (export gnc:menuname-reports)

gnucash/report/report-system/test/CMakeLists.txt

@@ -15,6 +15,10 @@ SET(scm_test_report_system_SOURCES
   test-list-extras.scm
   test-report-utilities.scm
 # test-test-extras.scm ;;FIXME why is this not run
+)
+
+set (scm_test_report_system_with_srfi64_SOURCES
+  test-html-utilities-srfi64.scm
   )
 
 set(GUILE_DEPENDS
@@ -29,6 +33,10 @@ set(GUILE_DEPENDS
   )
 GNC_ADD_SCHEME_TESTS(${scm_test_report_system_SOURCES})
 
+if (HAVE_SRFI64)
+  gnc_add_scheme_tests ("${scm_test_report_system_with_srfi64_SOURCES}")
+endif (HAVE_SRFI64)
+
 GNC_ADD_SCHEME_TARGETS(scm-test-report-system
   "test-extras.scm"
   gnucash/report/report-system/test
@@ -46,7 +54,7 @@ GNC_ADD_SCHEME_TARGETS(scm-test-report-system-2
 add_dependencies(check scm-test-report-system)
 SET_DIST_LIST(test_report_system_DIST
   CMakeLists.txt
-
+  ${scm_test_report_system_with_srfi64_SOURCES}
   ${scm_test_report_system_SOURCES}
   test-extras.scm
   test-link-module.c

gnucash/report/report-system/test/test-html-utilities-srfi64.scm

@@ -0,0 +1,74 @@
+(use-modules (gnucash gnc-module))
+
+(gnc:module-begin-syntax (gnc:module-load "gnucash/app-utils" 0))
+(gnc:module-begin-syntax (gnc:module-load "gnucash/report/report-system" 0))
+
+(use-modules (gnucash engine test test-extras))
+(use-modules (gnucash report report-system test test-extras))
+(use-modules (gnucash report report-system))
+(use-modules (srfi srfi-64))
+
+(define (test-runner)
+  (let ((runner (test-runner-null))
+        (num-passed 0)
+        (num-failed 0))
+    (test-runner-on-test-end! runner
+      (lambda (runner)
+        (format #t "[~a] line:~a, test: ~a\n"
+                (test-result-ref runner 'result-kind)
+                (test-result-ref runner 'source-line)
+                (test-runner-test-name runner))
+        (case (test-result-kind runner)
+          ((pass xpass) (set! num-passed (1+ num-passed)))
+          ((fail xfail)
+           (if (test-result-ref runner 'expected-value)
+               (format #t "~a\n -> expected: ~s\n -> obtained: ~s\n"
+                       (string-join (test-runner-group-path runner) "/")
+                       (test-result-ref runner 'expected-value)
+                       (test-result-ref runner 'actual-value)))
+           (set! num-failed (1+ num-failed)))
+          (else #t))))
+    (test-runner-on-final! runner
+      (lambda (runner)
+        (format #t "Source:~a\npass = ~a, fail = ~a\n"
+                (test-result-ref runner 'source-file) num-passed num-failed)
+        (zero? num-failed)))
+    runner))
+
+(define (run-test)
+  (test-runner-factory test-runner)
+  (test-begin "test-html-utilities-srfi64.scm")
+  (test-gnc:html-string-sanitize)
+  (test-end "test-html-utilities-srfi64.scm"))
+
+(define (test-gnc:html-string-sanitize)
+  (test-begin "gnc:html-string-sanitize")
+  (test-equal "null test"
+              "abc"
+              (gnc:html-string-sanitize "abc"))
+
+  (test-equal "sanitize ©"
+              "©"
+              (gnc:html-string-sanitize "©"))
+
+  (test-equal "emoji unchanged"
+              "🎃"
+              (gnc:html-string-sanitize "🎃"))
+
+  (test-equal "complex string"
+              "Smiley:\"🙂\" something"
+              (gnc:html-string-sanitize "Smiley:\"🙂\" something"))
+
+  (test-equal "sanitize <b>bold tags</b>"
+              "&lt;b&gt;bold tags&lt;/b&gt;"
+              (gnc:html-string-sanitize "<b>bold tags</b>"))
+
+  (test-equal "quotes are unchanged for html"
+              "\""
+              (gnc:html-string-sanitize "\""))
+
+  (test-equal "backslash is unchanged for html"
+              "\\"
+              (gnc:html-string-sanitize "\\"))
+
+  (test-end "gnc:html-string-sanitize"))