guile repl access to full api

bindings/engine.i

@@ -201,6 +201,41 @@ QofBook * qof_session_get_book (QofSession *session);
 // TODO: Unroll/remove
 const char *qof_session_get_url (QofSession *session);
 
+/* note: copied from qofsession.h -- maintain manually until
+ qofsession can be %included properly */
+typedef enum
+{
+ SESSION_NORMAL_OPEN = 0,
+ SESSION_NEW_STORE = 2,
+ SESSION_NEW_OVERWRITE = 3,
+ SESSION_READ_ONLY = 4,
+ SESSION_BREAK_LOCK = 5
+} SessionOpenMode;
+
+%inline {
+static void qof_session_save_quiet ()
+{
+ QofSession *session = gnc_get_current_session();
+ qof_session_save (session, [](const char* message, double percent){});
+}
+
+static bool qof_session_load_quiet (const char *filename, SessionOpenMode mode)
+{
+ gnc_clear_current_session();
+ QofSession *session = gnc_get_current_session();
+ qof_session_begin (session, filename, mode);
+ auto io_error = qof_session_get_error (session);
+ if (io_error != ERR_BACKEND_NO_ERR)
+ {
+ PWARN ("Loading error: %s", qof_backend_get_error_string (io_error));
+ return false;
+ }
+ qof_session_load (session, [](const char* message, double percent){});
+ return true;
+}
+
+}
+
 %ignore qof_print_date_time_buff;
 %ignore gnc_tm_free;
 %newobject qof_print_date;
@@ -356,6 +391,12 @@ void qof_book_set_string_option(QofBook* book, const char* opt_name, const char*
  SET_ENUM("HOOK-REPORT");
  SET_ENUM("HOOK-SAVE-OPTIONS");
 
+ SET_ENUM("SESSION-NORMAL-OPEN");
+ SET_ENUM("SESSION-NEW-STORE");
+ SET_ENUM("SESSION-NEW-OVERWRITE");
+ SET_ENUM("SESSION-READ-ONLY");
+ SET_ENUM("SESSION-BREAK-LOCK");
+
  //SET_ENUM("GNC-ID-ACCOUNT");
  SET_ENUM("QOF-ID-BOOK-SCM");
  //SET_ENUM("GNC-ID-BUDGET");

doc/examples/book-to-hledger.scm

@@ -0,0 +1,62 @@
+;; this file is meant to be run via the gnucash-cli interface: --script simple-book-add-txn.scm
+;;
+;; gnucash-cli book.gnucash --script simple-book-add-txn.scm
+;;
+
+(use-modules (gnucash core-utils))
+(use-modules (gnucash engine))
+(use-modules (gnucash app-utils))
+(use-modules (gnucash report))
+(use-modules (ice-9 match))
+
+(define iso-date (qof-date-format-get-string QOF-DATE-FORMAT-ISO))
+(define book (gnc-get-current-book))
+(define root (gnc-get-current-root-account))
+(define query (qof-query-create-for-splits))
+(qof-query-set-book query (gnc-get-current-book))
+(xaccQueryAddAccountMatch query (gnc-account-get-descendants root) QOF-GUID-MATCH-ANY QOF-QUERY-AND)
+(qof-query-set-sort-order
+ query
+ (list SPLIT-TRANS TRANS-DATE-POSTED)
+ '()
+ (list QUERY-DEFAULT-SORT))
+
+(define (dump-transaction trans)
+ (format #t "~a ~a\n"
+ (gnc-print-time64 (xaccTransGetDate trans) iso-date)
+ (xaccTransGetDescription trans))
+ (define (split->account s)
+ (gnc-account-get-full-name (xaccSplitGetAccount s)))
+ (define (split->amount s)
+ (format #f "~a ~a"
+ (exact->inexact (xaccSplitGetAmount s))
+ (gnc-commodity-get-mnemonic (xaccAccountGetCommodity (xaccSplitGetAccount s)))))
+ (define max-width
+ (let lp ((splits (xaccTransGetSplitList trans)) (maximum 0))
+ (match splits
+ (() (+ maximum 2))
+ ((s . rest)
+ (lp rest (max maximum (+ (string-length (split->account s))
+ (string-length (split->amount s)))))))))
+ (for-each
+ (lambda (s)
+ (define txn (xaccSplitGetParent s))
+ (define acc-name (split->account s))
+ (define amt-str (split->amount s))
+ (format #t " ~a~a~a\n"
+ acc-name
+ (make-string (- max-width (string-length acc-name) (string-length amt-str)) #\space)
+ amt-str))
+ (xaccTransGetSplitList trans)))
+
+(define split-has-no-account? (compose null? xaccSplitGetAccount))
+
+(let lp ((splits (xaccQueryGetSplitsUniqueTrans query)))
+ (newline)
+ (match splits
+ (() #f)
+ (((? split-has-no-account?) . rest) (lp rest))
+ ((split . rest) (dump-transaction (xaccSplitGetParent split)) (lp rest))))
+
+(qof-query-destroy query)
+(gnc-clear-current-session)

doc/examples/simple-book-add-txn.scm

@@ -0,0 +1,139 @@
+;; this file is meant to be run via the gnucash-cli interface: --script simple-book-add-txn.scm
+;;
+;; gnucash-cli book.gnucash --script simple-book-add-txn.scm
+;;
+;; the book will be considered "valid" if it has a basic hierarchy such as the following
+;; Assets
+;; |-Current
+;; | |- Bank
+;; Expenses
+;; |-Govt
+;; | |- Taxes
+;; |-Personal
+;; |-Medical
+
+(use-modules (gnucash core-utils))
+(use-modules (gnucash engine))
+(use-modules (gnucash app-utils))
+(use-modules (gnucash report))
+(use-modules (ice-9 rdelim))
+(use-modules (ice-9 match))
+
+(define (get-line prompt)
+ (format #t "\x1b[1;33m~a:\x1b[m " prompt)
+ (let ((rv (read-line)))
+ (if (eof-object? rv) "" rv)))
+
+(define (get-amount prompt)
+ (let ((amount (gnc-numeric-from-string (get-line prompt))))
+ (if (number? amount)
+ amount
+ (get-amount prompt))))
+
+(define (get-item-from-list lst elt->string prompt)
+ (define (get-amount-line) (get-amount prompt))
+ (let lp ((idx 1) (lst lst))
+ (unless (null? lst)
+ (format #t "~a. ~a\n" idx (elt->string (car lst)))
+ (lp (1+ idx) (cdr lst))))
+ (let lp ((idx (get-amount-line)))
+ (cond
+ ((and (integer? idx) (positive? idx))
+ (let lp1 ((idx (1- idx)) (lst lst))
+ (cond
+ ((null? lst) (lp (get-amount-line)))
+ ((zero? idx) (car lst))
+ (else (lp1 (1- idx) (cdr lst))))))
+ (else (lp (get-amount-line))))))
+
+(define (get-account prompt parent)
+ (define descendants (gnc-account-get-descendants-sorted parent))
+ (get-item-from-list descendants gnc-account-get-full-name "Select account by index"))
+
+(define (get-binary-response prompt)
+ (match (get-line prompt)
+ ((or "Y" "y") #t)
+ ((or "N" "n") #f)
+ (else (get-binary-response prompt))))
+
+(define (add-to-transaction book txn account amount memo)
+ (let ((split (xaccMallocSplit book)))
+ (xaccSplitSetAccount split account)
+ (xaccSplitSetAmount split amount)
+ (xaccSplitSetValue split amount)
+ (xaccSplitSetMemo split memo)
+ (xaccSplitSetParent split txn)))
+
+(define (quit-program exitlevel)
+ (gnc-clear-current-session)
+ (exit exitlevel))
+
+(define (get-new-uri session)
+ (define filepath (get-line "please input correct path, or leave blank to abort"))
+ (gnc-clear-current-session)
+ (cond
+ ((string-null? filepath) (quit-program 1))
+ ((qof-session-load-quiet filepath SESSION-NORMAL-OPEN) #f) ;success
+ (else (get-new-uri session))))
+
+(define session (gnc-get-current-session))
+(define root (gnc-get-current-root-account))
+
+(let check-book-loop ()
+ (cond
+ ((or (null? (gnc-account-lookup-by-full-name root "Assets:Current:Bank"))
+ (null? (gnc-account-lookup-by-full-name root "Expenses"))
+ (null? (gnc-account-lookup-by-full-name root "Expenses:Govt:Taxes")))
+ (display "\n\n\nWARNING: It doesn't seem the correct book is loaded.\n")
+ (get-new-uri session)
+ (check-book-loop))))
+
+(define book (gnc-get-current-book))
+(define acc-BANK (gnc-account-lookup-by-full-name root "Assets:Current:Bank"))
+(define acc-EXP (gnc-account-lookup-by-full-name root "Expenses"))
+(define acc-EXP-TAX (gnc-account-lookup-by-full-name root "Expenses:Govt:Taxes"))
+(define acc-EXP-LEAF (get-account "Expense leaf account" acc-EXP))
+
+(define (accounts-action action-fn)
+ (action-fn acc-BANK)
+ (action-fn acc-EXP-LEAF)
+ (action-fn acc-EXP-TAX))
+
+(define description (get-line "Description"))
+
+(let lp ()
+ (define txn (xaccMallocTransaction book))
+ (define net-amount (get-amount "Amount, without tax"))
+ (define tax-amount (* net-amount 1/10))
+ (define total-amount (+ tax-amount net-amount))
+
+ (xaccTransBeginEdit txn)
+ (xaccTransSetCurrency txn (xaccAccountGetCommodity acc-BANK))
+ (xaccTransSetDatePostedSecsNormalized txn (current-time))
+ (xaccTransSetDescription txn description)
+ (add-to-transaction book txn acc-BANK (- total-amount) "from bank")
+ (add-to-transaction book txn acc-EXP-LEAF net-amount "expense net")
+ (add-to-transaction book txn acc-EXP-TAX tax-amount "tax paid")
+ (newline)
+ (gnc:dump-transaction txn)
+
+ (cond
+ ((not (xaccTransIsBalanced txn))
+ (display "WARNING: transaction is not balanced. Try again.\n")
+ (xaccTransRollbackEdit txn)
+ (xaccTransDestroy txn)
+ (lp))
+ ((get-binary-response "Please confirm transaction [YN]")
+ (accounts-action xaccAccountBeginEdit)
+ (xaccTransCommitEdit txn)
+ (accounts-action xaccAccountCommitEdit))
+ (else
+ (xaccTransRollbackEdit txn)
+ (xaccTransDestroy txn))))
+
+;; (gnc:dump-book)
+(when (qof-book-session-not-saved book)
+ (display "Saving book...\n")
+ (qof-session-save-quiet))
+
+(quit-program 0)

gnucash/CMakeLists.txt

@@ -111,6 +111,7 @@ target_link_libraries (gnucash
  gnc-bi-import gnc-customer-import gnc-report
  PkgConfig::GTK3 ${GUILE_LDFLAGS} PkgConfig::GLIB2
  ${Boost_LIBRARIES}
+ ${Python3_LIBRARIES}
 )
 
 set(gnucash_cli_SOURCES
@@ -137,15 +138,20 @@ endif()
 
 add_dependencies (gnucash-cli gnucash)
 
-target_compile_definitions(gnucash-cli PRIVATE -DG_LOG_DOMAIN=\"gnc.bin\")
+target_compile_definitions(gnucash-cli PRIVATE
+ -DG_LOG_DOMAIN=\"gnc.bin\"
+ $<$<BOOL:${WITH_PYTHON}>:HAVE_PYTHON_H>)
 
 target_link_libraries (gnucash-cli
  gnc-app-utils
  gnc-engine gnc-core-utils gnucash-guile gnc-report
  ${GUILE_LDFLAGS} PkgConfig::GLIB2
  ${Boost_LIBRARIES}
+ ${Python3_LIBRARIES}
 )
 
+target_include_directories (gnucash-cli PRIVATE ${Python3_INCLUDE_DIRS})
+
 if (BUILDING_FROM_VCS)
  target_compile_definitions(gnucash PRIVATE -DGNC_VCS=\"git\")
  target_compile_definitions(gnucash-cli PRIVATE -DGNC_VCS=\"git\")

gnucash/gnucash-cli.cpp

@@ -62,6 +62,12 @@ namespace Gnucash {
  boost::optional <std::string> m_namespace;
  bool m_verbose = false;
 
+ boost::optional <std::string> m_script;
+ std::vector<std::string> m_script_args;
+ std::string m_language;
+ bool m_interactive;
+ bool m_open_readwrite;
+
  boost::optional <std::string> m_report_cmd;
  boost::optional <std::string> m_report_name;
  boost::optional <std::string> m_export_type;
@@ -107,6 +113,17 @@ Gnucash::GnucashCli::configure_program_options (void)
  m_opt_desc_display->add (quotes_options);
  m_opt_desc_all.add (quotes_options);
 
+ bpo::options_description cli_options(_("Scripting and/or Interactive Session Options"));
+ cli_options.add_options()
+ ("script,S", bpo::value (&m_script), _("Script to run"))
+ ("script-args", bpo::value (&m_script_args), _("Script arguments"))
+ ("interactive,I", bpo::bool_switch (&m_interactive), _("Interactive session"))
+ ("language,L", bpo::value (&m_language)->default_value("guile"), _("Specify language for script or interactive session; guile (default) or python"))
+ ("readwrite,W", bpo::bool_switch (&m_open_readwrite), _("Open datafile read-write for script and/or interactive session"));
+ m_pos_opt_desc.add("script-args", -1);
+ m_opt_desc_display->add (cli_options);
+ m_opt_desc_all.add (cli_options);
+
  bpo::options_description report_options(_("Report Generation Options"));
  report_options.add_options()
  ("report,R", bpo::value (&m_report_cmd),
@@ -127,10 +144,32 @@ may be specified to describe some saved options.\n"
 }
 
 int
-Gnucash::GnucashCli::start ([[maybe_unused]] int argc, [[maybe_unused]] char **argv)
+Gnucash::GnucashCli::start (int argc, char **argv)
 {
  Gnucash::CoreApp::start();
 
+ if (m_interactive || m_script)
+ {
+ std::vector<const char*> newArgv =
+ { argc ? argv[0] : "", m_file_to_load ? m_file_to_load->c_str() : ""};
+ std::transform (m_script_args.begin(), m_script_args.end(), std::back_inserter(newArgv),
+ [](const std::string& s) { return s.c_str(); });
+ // note the vector<const char*> is valid as long as script_args's strings are not damaged!
+
+ std::cout << "\n\nScript args:";
+ for (const auto& arg : newArgv)
+ std::cout << ' ' << arg;
+ std::cout << '\n';
+ std::cout << "File to load: " << (m_file_to_load ? *m_file_to_load : "(null)") << std::endl;
+ std::cout << "Language: " << m_language << std::endl;
+ std::cout << "Script: " << (m_script ? *m_script : "(null)") << std::endl;
+ std::cout << "Readwrite: " << (m_open_readwrite ? 'Y' : 'N') << std::endl;
+ std::cout << "Interactive: " << (m_interactive ? 'Y' : 'N') << "\n\n" << std::endl;
+
+ return Gnucash::run_scripting (newArgv, m_file_to_load, m_language, m_script,
+ m_open_readwrite, m_interactive);
+ }
+
  if (!m_quotes_cmd.empty())
  {
  if (m_quotes_cmd.front() == "info")