1 /********************************************************************\
2 * gnc-engine-guile.c -- engine helper functions for guile *
3 * Copyright (C) 2000 Linas Vepstas <linas@linas.org> *
4 * Copyright (C) 2001 Linux Developers Group, Inc. *
5 * *
6 * This program is free software; you can redistribute it and/or *
7 * modify it under the terms of the GNU General Public License as *
8 * published by the Free Software Foundation; either version 2 of *
9 * the License, or (at your option) any later version. *
10 * *
11 * This program is distributed in the hope that it will be useful, *
12 * but WITHOUT ANY WARRANTY; without even the implied warranty of *
13 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *
14 * GNU General Public License for more details. *
15 * *
16 * You should have received a copy of the GNU General Public License*
17 * along with this program; if not, contact: *
18 * *
19 * Free Software Foundation Voice: +1-617-542-5942 *
20 * 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652 *
21 * Boston, MA 02110-1301, USA gnu@gnu.org *
22 * *
23 \********************************************************************/
24
25 #include <config.h>
26
27 #include "swig-runtime.h"
28 #include <libguile.h>
29 #include <string.h>
30
31 #include "Account.h"
32 #include "engine-helpers.h"
33 #include "gnc-engine-guile.h"
34 #include "glib-guile.h"
35 #include "gnc-date.h"
36 #include "gnc-engine.h"
37 #include "gnc-session.h"
38 #include "guile-mappings.h"
39 #include "gnc-guile-utils.h"
40 #include <qof.h>
41 #include <qofbookslots.h>
42
43
44 #ifndef HAVE_STRPTIME
45 # include "strptime.h"
46 #endif
47
48 /** \todo Code dependent on the private query headers
49 qofquery-p.h and qofquerycore-p.h may need to be modified.
50 These files are temporarily exported for QOF 0.6.0 but
51 cannot be considered "standard" or public parts of QOF. */
52 #include "qofquery-p.h"
53 #include "qofquerycore-p.h"
54
55 #define FUNC_NAME G_STRFUNC
56
57 static QofLogModule log_module = GNC_MOD_ENGINE;
58
59
gnc_time64_to_GDate(SCM x)60 GDate gnc_time64_to_GDate(SCM x)
61 {
62 time64 time = scm_to_int64 (x);
63 return time64_to_gdate(time);
64 }
65
66 SCM
gnc_guid2scm(GncGUID guid)67 gnc_guid2scm(GncGUID guid)
68 {
69 char string[GUID_ENCODING_LENGTH + 1];
70
71 if (!guid_to_string_buff(&guid, string))
72 return SCM_BOOL_F;
73
74 return scm_from_utf8_string(string);
75 }
76
77 GncGUID
gnc_scm2guid(SCM guid_scm)78 gnc_scm2guid(SCM guid_scm)
79 {
80 GncGUID guid;
81 gchar * str;
82
83 if (!scm_is_string(guid_scm)
84 || (GUID_ENCODING_LENGTH != scm_c_string_length (guid_scm)))
85 {
86 return *guid_null();
87 }
88 str = gnc_scm_to_utf8_string (guid_scm);
89 string_to_guid(str, &guid);
90 g_free (str);
91 return guid;
92 }
93
94 int
gnc_guid_p(SCM guid_scm)95 gnc_guid_p(SCM guid_scm)
96 {
97 GncGUID guid;
98 gchar * str;
99 int return_int;
100
101 if (!scm_is_string(guid_scm))
102 return FALSE;
103
104 if (GUID_ENCODING_LENGTH != scm_c_string_length (guid_scm))
105 {
106 return FALSE;
107 }
108 str = gnc_scm_to_utf8_string (guid_scm);
109 return_int = string_to_guid(str, &guid);
110 g_free (str);
111 return return_int;
112 }
113
114
115 /********************************************************************
116 * type converters for query API
117 ********************************************************************/
118
119 /* The query scm representation is a list of pairs, where the
120 * car of each pair is one of the following symbols:
121 *
122 * Symbol cdr
123 * 'terms list of OR terms
124 * 'primary-sort scm rep of sort_type_t
125 * 'secondary-sort scm rep of sort_type_t
126 * 'tertiary-sort scm rep of sort_type_t
127 * 'primary-increasing boolean
128 * 'secondary-increasing boolean
129 * 'tertiary-increasing boolean
130 * 'max-splits integer
131 *
132 * Each OR term is a list of AND terms.
133 * Each AND term is a list of one of the following forms:
134 *
135 * ('pd-amount pr-type sense-bool amt-match-how amt-match-sign amount)
136 * ('pd-account pr-type sense-bool acct-match-how list-of-account-guids)
137 * ('pd-string pr-type sense-bool case-sense-bool use-regexp-bool string)
138 * ('pd-cleared pr-type sense-bool cleared-field)
139 * ('pd-balance pr-type sense-bool balance-field)
140 */
141
142 typedef enum
143 {
144 gnc_QUERY_v1 = 1,
145 gnc_QUERY_v2
146 } query_version_t;
147
148 /* QofCompareFunc */
149
150 static QofQueryCompare
gnc_query_scm2compare(SCM how_scm)151 gnc_query_scm2compare (SCM how_scm)
152 {
153 return scm_to_int(how_scm);
154 }
155
156 /* QofStringMatch */
157 static QofStringMatch
gnc_query_scm2string(SCM how_scm)158 gnc_query_scm2string (SCM how_scm)
159 {
160 return scm_to_int(how_scm);
161 }
162
163 /* QofDateMatch */
164 static QofDateMatch
gnc_query_scm2date(SCM how_scm)165 gnc_query_scm2date (SCM how_scm)
166 {
167 return scm_to_int(how_scm);
168 }
169
170 /* QofNumericMatch */
171 static QofNumericMatch
gnc_query_scm2numericop(SCM how_scm)172 gnc_query_scm2numericop (SCM how_scm)
173 {
174 return scm_to_int(how_scm);
175 }
176
177 /* QofGuidMatch */
178 static QofGuidMatch
gnc_query_scm2guid(SCM how_scm)179 gnc_query_scm2guid (SCM how_scm)
180 {
181 return scm_to_int(how_scm);
182 }
183
184 /* QofCharMatch */
185 static QofCharMatch
gnc_query_scm2char(SCM how_scm)186 gnc_query_scm2char (SCM how_scm)
187 {
188 return scm_to_int(how_scm);
189 }
190
191 static QofGuidMatch
gnc_scm2acct_match_how(SCM how_scm)192 gnc_scm2acct_match_how (SCM how_scm)
193 {
194 QofGuidMatch res;
195 gchar *how = gnc_scm_symbol_to_locale_string (how_scm);
196
197 if (!g_strcmp0 (how, "acct-match-all"))
198 res = QOF_GUID_MATCH_ALL;
199 else if (!g_strcmp0 (how, "acct-match-any"))
200 res = QOF_GUID_MATCH_ANY;
201 else if (!g_strcmp0 (how, "acct-match-none"))
202 res = QOF_GUID_MATCH_NONE;
203 else
204 {
205 PINFO ("invalid account match: %s", how);
206 res = QOF_GUID_MATCH_NULL;
207 }
208
209 g_free (how);
210 return res;
211 }
212
213 static QofQueryCompare
gnc_scm2amt_match_how(SCM how_scm)214 gnc_scm2amt_match_how (SCM how_scm)
215 {
216 QofQueryCompare res;
217 gchar *how = gnc_scm_symbol_to_locale_string (how_scm);
218
219 if (!g_strcmp0 (how, "amt-match-atleast"))
220 res = QOF_COMPARE_GTE;
221 else if (!g_strcmp0 (how, "amt-match-atmost"))
222 res = QOF_COMPARE_LTE;
223 else if (!g_strcmp0 (how, "amt-match-exactly"))
224 res = QOF_COMPARE_EQUAL;
225 else
226 {
227 PINFO ("invalid amount match: %s", how);
228 res = QOF_COMPARE_EQUAL;
229 }
230
231 g_free (how);
232 return res;
233 }
234
235 static int
gnc_scm2bitfield(SCM field_scm)236 gnc_scm2bitfield (SCM field_scm)
237 {
238 int field = 0;
239
240 if (!scm_is_list (field_scm))
241 return 0;
242
243 while (!scm_is_null (field_scm))
244 {
245 SCM scm;
246 int bit;
247
248 scm = SCM_CAR (field_scm);
249 field_scm = SCM_CDR (field_scm);
250
251 bit = scm_to_int(scm);
252 field |= bit;
253 }
254
255 return field;
256 }
257
258 static cleared_match_t
gnc_scm2cleared_match_how(SCM how_scm)259 gnc_scm2cleared_match_how (SCM how_scm)
260 {
261 return gnc_scm2bitfield (how_scm);
262 }
263
264 static gboolean
gnc_scm2balance_match_how(SCM how_scm,gboolean * resp)265 gnc_scm2balance_match_how (SCM how_scm, gboolean *resp)
266 {
267 gchar *how;
268
269 if (!scm_is_list (how_scm))
270 return FALSE;
271
272 if (scm_is_null (how_scm))
273 return FALSE;
274
275 /* Only allow a single-entry list */
276 if (!scm_is_null (SCM_CDR (how_scm)))
277 return FALSE;
278
279 how = gnc_scm_symbol_to_locale_string (SCM_CAR(how_scm));
280
281 if (!g_strcmp0 (how, "balance-match-balanced"))
282 *resp = TRUE;
283 else
284 *resp = FALSE;
285
286 g_free (how);
287 return TRUE;
288 }
289
290 static SCM
gnc_guid_glist2scm(const GList * account_guids)291 gnc_guid_glist2scm (const GList *account_guids)
292 {
293 SCM guids = SCM_EOL;
294 const GList *node;
295
296 for (node = account_guids; node; node = node->next)
297 {
298 GncGUID *guid = node->data;
299
300 if (guid)
301 guids = scm_cons (gnc_guid2scm (*guid), guids);
302 }
303
304 return scm_reverse (guids);
305 }
306
307 static GList *
gnc_scm2guid_glist(SCM guids_scm)308 gnc_scm2guid_glist (SCM guids_scm)
309 {
310 GList *guids = NULL;
311
312 if (!scm_is_list (guids_scm))
313 return NULL;
314
315 while (!scm_is_null (guids_scm))
316 {
317 SCM guid_scm = SCM_CAR (guids_scm);
318 GncGUID *guid = NULL;
319
320 if (guid_scm != SCM_BOOL_F)
321 {
322 guid = guid_malloc ();
323 *guid = gnc_scm2guid (guid_scm);
324 }
325
326 guids = g_list_prepend (guids, guid);
327
328 guids_scm = SCM_CDR (guids_scm);
329 }
330
331 return g_list_reverse (guids);
332 }
333
334 static inline void
gnc_guid_glist_free(GList * guids)335 gnc_guid_glist_free (GList *guids)
336 {
337 g_list_free_full (guids, (GDestroyNotify)guid_free);
338 }
339
340 static SCM
gnc_query_numeric2scm(gnc_numeric val)341 gnc_query_numeric2scm (gnc_numeric val)
342 {
343 return scm_cons (scm_from_int64 (val.num),
344 scm_from_int64 (val.denom));
345 }
346
347 static gboolean
gnc_query_numeric_p(SCM pair)348 gnc_query_numeric_p (SCM pair)
349 {
350 return (scm_is_pair (pair));
351 }
352
353 static gnc_numeric
gnc_query_scm2numeric(SCM pair)354 gnc_query_scm2numeric (SCM pair)
355 {
356 SCM denom;
357 SCM num;
358
359 num = SCM_CAR (pair);
360 denom = SCM_CDR (pair);
361
362 return gnc_numeric_create (scm_to_int64 (num),
363 scm_to_int64 (denom));
364 }
365
366 static SCM
gnc_query_path2scm(const GSList * path)367 gnc_query_path2scm (const GSList *path)
368 {
369 SCM path_scm = SCM_EOL;
370 const GSList *node;
371
372 for (node = path; node; node = node->next)
373 {
374 const char *key = node->data;
375
376 if (key)
377 path_scm = scm_cons (scm_from_utf8_string (key), path_scm);
378 }
379
380 return scm_reverse (path_scm);
381 }
382
383 GSList *
gnc_query_scm2path(SCM path_scm)384 gnc_query_scm2path (SCM path_scm)
385 {
386 GSList *path = NULL;
387
388 if (!scm_is_list (path_scm))
389 return NULL;
390
391 while (!scm_is_null (path_scm))
392 {
393 SCM key_scm = SCM_CAR (path_scm);
394 char *key;
395
396 if (!scm_is_string (key_scm))
397 break;
398
399 key = gnc_scm_to_utf8_string(key_scm);
400 path = g_slist_prepend (path, key);
401 path_scm = SCM_CDR (path_scm);
402 }
403
404 return g_slist_reverse (path);
405 }
406
407 static void
gnc_query_path_free(GSList * path)408 gnc_query_path_free (GSList *path)
409 {
410 GSList *node;
411
412 for (node = path; node; node = node->next)
413 g_free (node->data);
414
415 g_slist_free (path);
416 }
417
418
419 static SCM
gnc_queryterm2scm(const QofQueryTerm * qt)420 gnc_queryterm2scm (const QofQueryTerm *qt)
421 {
422 SCM qt_scm = SCM_EOL;
423 QofQueryPredData *pd = NULL;
424
425 qt_scm = scm_cons (gnc_query_path2scm (qof_query_term_get_param_path (qt)),
426 qt_scm);
427 qt_scm = scm_cons (SCM_BOOL (qof_query_term_is_inverted (qt)), qt_scm);
428
429 pd = qof_query_term_get_pred_data (qt);
430 qt_scm = scm_cons (scm_from_locale_symbol (pd->type_name), qt_scm);
431 qt_scm = scm_cons (scm_from_long (pd->how), qt_scm);
432
433 if (!g_strcmp0 (pd->type_name, QOF_TYPE_STRING))
434 {
435 query_string_t pdata = (query_string_t) pd;
436
437 qt_scm = scm_cons (scm_from_long (pdata->options), qt_scm);
438 qt_scm = scm_cons (SCM_BOOL (pdata->is_regex), qt_scm);
439 qt_scm = scm_cons (pdata->matchstring ? scm_from_utf8_string (pdata->matchstring) : SCM_BOOL_F, qt_scm);
440
441 }
442 else if (!g_strcmp0 (pd->type_name, QOF_TYPE_DATE))
443 {
444 query_date_t pdata = (query_date_t) pd;
445
446 qt_scm = scm_cons (scm_from_long (pdata->options), qt_scm);
447 qt_scm = scm_cons (scm_from_int64 (pdata->date), qt_scm);
448
449 }
450 else if (!g_strcmp0 (pd->type_name, QOF_TYPE_NUMERIC))
451 {
452 query_numeric_t pdata = (query_numeric_t) pd;
453
454 qt_scm = scm_cons (scm_from_long (pdata->options), qt_scm);
455 qt_scm = scm_cons (gnc_query_numeric2scm (pdata->amount), qt_scm);
456
457 }
458 else if (!g_strcmp0 (pd->type_name, QOF_TYPE_GUID))
459 {
460 query_guid_t pdata = (query_guid_t) pd;
461
462 qt_scm = scm_cons (scm_from_long (pdata->options), qt_scm);
463 qt_scm = scm_cons (gnc_guid_glist2scm (pdata->guids), qt_scm);
464
465 }
466 else if (!g_strcmp0 (pd->type_name, QOF_TYPE_INT64))
467 {
468 query_int64_t pdata = (query_int64_t) pd;
469
470 qt_scm = scm_cons (scm_from_int64 (pdata->val), qt_scm);
471
472 }
473 else if (!g_strcmp0 (pd->type_name, QOF_TYPE_DOUBLE))
474 {
475 query_double_t pdata = (query_double_t) pd;
476
477 qt_scm = scm_cons (scm_from_double (pdata->val), qt_scm);
478
479 }
480 else if (!g_strcmp0 (pd->type_name, QOF_TYPE_BOOLEAN))
481 {
482 query_boolean_t pdata = (query_boolean_t) pd;
483
484 qt_scm = scm_cons (SCM_BOOL (pdata->val), qt_scm);
485
486 }
487 else if (!g_strcmp0 (pd->type_name, QOF_TYPE_CHAR))
488 {
489 query_char_t pdata = (query_char_t) pd;
490
491 qt_scm = scm_cons (scm_from_long (pdata->options), qt_scm);
492 qt_scm = scm_cons (pdata->char_list ? scm_from_utf8_string (pdata->char_list) : SCM_BOOL_F, qt_scm);
493
494 }
495 else
496 {
497 PWARN ("query core type %s not supported", pd->type_name);
498 return SCM_BOOL_F;
499 }
500
501 return scm_reverse (qt_scm);
502 }
503
504 static QofQuery *
gnc_scm2query_term_query_v2(SCM qt_scm)505 gnc_scm2query_term_query_v2 (SCM qt_scm)
506 {
507 QofQuery *q = NULL;
508 QofQueryPredData *pd = NULL;
509 SCM scm;
510 gchar *type = NULL;
511 GSList *path = NULL;
512 gboolean inverted = FALSE;
513 QofQueryCompare compare_how;
514
515 if (!scm_is_list (qt_scm) || scm_is_null (qt_scm))
516 return NULL;
517
518 do
519 {
520 /* param path */
521 scm = SCM_CAR (qt_scm);
522 qt_scm = SCM_CDR (qt_scm);
523 if (!scm_is_list (scm))
524 break;
525 path = gnc_query_scm2path (scm);
526
527 /* inverted */
528 scm = SCM_CAR (qt_scm);
529 qt_scm = SCM_CDR (qt_scm);
530 if (!scm_is_bool (scm))
531 break;
532 inverted = scm_is_true (scm);
533
534 /* type */
535 scm = SCM_CAR (qt_scm);
536 qt_scm = SCM_CDR (qt_scm);
537 if (!scm_is_symbol (scm))
538 break;
539 type = gnc_scm_symbol_to_locale_string (scm);
540
541 /* QofCompareFunc */
542 scm = SCM_CAR (qt_scm);
543 qt_scm = SCM_CDR (qt_scm);
544 if (scm_is_null (scm))
545 break;
546 compare_how = gnc_query_scm2compare (scm);
547
548 /* Now compute the predicate */
549
550 if (!g_strcmp0 (type, QOF_TYPE_STRING))
551 {
552 QofStringMatch options;
553 gboolean is_regex;
554 gchar *matchstring;
555
556 scm = SCM_CAR (qt_scm);
557 qt_scm = SCM_CDR (qt_scm);
558 if (scm_is_null (scm)) break;
559 options = gnc_query_scm2string (scm);
560
561 scm = SCM_CAR (qt_scm);
562 qt_scm = SCM_CDR (qt_scm);
563 if (!scm_is_bool (scm)) break;
564 is_regex = scm_is_true (scm);
565
566 scm = SCM_CAR (qt_scm);
567 if (!scm_is_string (scm)) break;
568
569 matchstring = gnc_scm_to_utf8_string (scm);
570
571 pd = qof_query_string_predicate (compare_how, matchstring,
572 options, is_regex);
573 g_free (matchstring);
574 }
575 else if (!g_strcmp0 (type, QOF_TYPE_DATE))
576 {
577 QofDateMatch options;
578 time64 date;
579
580 scm = SCM_CAR (qt_scm);
581 qt_scm = SCM_CDR (qt_scm);
582 if (scm_is_null (scm))
583 break;
584 options = gnc_query_scm2date (scm);
585
586 scm = SCM_CAR (qt_scm);
587 if (scm_is_null (scm))
588 break;
589 date = scm_to_int64 (scm);
590
591 pd = qof_query_date_predicate (compare_how, options, date);
592
593 }
594 else if (!g_strcmp0 (type, QOF_TYPE_NUMERIC))
595 {
596 QofNumericMatch options;
597 gnc_numeric val;
598
599 scm = SCM_CAR (qt_scm);
600 qt_scm = SCM_CDR (qt_scm);
601 if (scm_is_null (scm))
602 break;
603 options = gnc_query_scm2numericop (scm);
604
605 scm = SCM_CAR (qt_scm);
606 if (!gnc_query_numeric_p (scm))
607 break;
608 val = gnc_query_scm2numeric (scm);
609
610 pd = qof_query_numeric_predicate (compare_how, options, val);
611
612 }
613 else if (!g_strcmp0 (type, QOF_TYPE_GUID))
614 {
615 QofGuidMatch options;
616 GList *guids;
617
618 scm = SCM_CAR (qt_scm);
619 qt_scm = SCM_CDR (qt_scm);
620 if (scm_is_null (scm))
621 break;
622 options = gnc_query_scm2guid (scm);
623
624 scm = SCM_CAR (qt_scm);
625 if (!scm_is_list (scm))
626 break;
627 guids = gnc_scm2guid_glist (scm);
628
629 pd = qof_query_guid_predicate (options, guids);
630
631 gnc_guid_glist_free (guids);
632
633 }
634 else if (!g_strcmp0 (type, QOF_TYPE_INT64))
635 {
636 gint64 val;
637
638 scm = SCM_CAR (qt_scm);
639 if (scm_is_null (scm))
640 break;
641 val = scm_to_int64 (scm);
642
643 pd = qof_query_int64_predicate (compare_how, val);
644
645 }
646 else if (!g_strcmp0 (type, QOF_TYPE_DOUBLE))
647 {
648 double val;
649
650 scm = SCM_CAR (qt_scm);
651 if (!scm_is_number (scm))
652 break;
653 val = scm_to_double (scm);
654
655 pd = qof_query_double_predicate (compare_how, val);
656
657 }
658 else if (!g_strcmp0 (type, QOF_TYPE_BOOLEAN))
659 {
660 gboolean val;
661
662 scm = SCM_CAR (qt_scm);
663 if (!scm_is_bool (scm))
664 break;
665 val = scm_is_true (scm);
666
667 pd = qof_query_boolean_predicate (compare_how, val);
668
669 }
670 else if (!g_strcmp0 (type, QOF_TYPE_CHAR))
671 {
672 QofCharMatch options;
673 gchar *char_list;
674
675 scm = SCM_CAR (qt_scm);
676 qt_scm = SCM_CDR (qt_scm);
677 if (scm_is_null (scm))
678 break;
679 options = gnc_query_scm2char (scm);
680
681 scm = SCM_CAR (qt_scm);
682 if (!scm_is_string (scm))
683 break;
684 char_list = gnc_scm_to_utf8_string (scm);
685
686 pd = qof_query_char_predicate (options, char_list);
687 g_free (char_list);
688 }
689 else
690 {
691 PWARN ("query core type %s not supported", type);
692 break;
693 }
694
695 g_free (type);
696
697 }
698 while (FALSE);
699
700 if (pd)
701 {
702 q = qof_query_create ();
703 qof_query_add_term (q, path, pd, QOF_QUERY_OR);
704 if (inverted)
705 {
706 QofQuery *outq = qof_query_invert (q);
707 qof_query_destroy (q);
708 q = outq;
709 }
710 }
711 else
712 {
713 gnc_query_path_free (path);
714 }
715
716 return q;
717 }
718
719 static QofQuery *
gnc_scm2query_term_query_v1(SCM query_term_scm)720 gnc_scm2query_term_query_v1 (SCM query_term_scm)
721 {
722 gboolean ok = FALSE;
723 gchar * pd_type = NULL;
724 gchar * pr_type = NULL;
725 gboolean sense = FALSE;
726 QofQuery *q = NULL;
727 SCM scm;
728
729 if (!scm_is_list (query_term_scm) ||
730 scm_is_null (query_term_scm))
731 {
732 PINFO ("null term");
733 return NULL;
734 }
735
736 do
737 {
738 /* pd_type */
739 scm = SCM_CAR (query_term_scm);
740 query_term_scm = SCM_CDR (query_term_scm);
741 pd_type = gnc_scm_symbol_to_locale_string (scm);
742
743 /* pr_type */
744 if (scm_is_null (query_term_scm))
745 {
746 PINFO ("null pr_type");
747 break;
748 }
749 scm = SCM_CAR (query_term_scm);
750 query_term_scm = SCM_CDR (query_term_scm);
751 pr_type = gnc_scm_symbol_to_locale_string (scm);
752
753 /* sense */
754 if (scm_is_null (query_term_scm))
755 {
756 PINFO ("null sense");
757 break;
758 }
759 scm = SCM_CAR (query_term_scm);
760 query_term_scm = SCM_CDR (query_term_scm);
761 sense = scm_is_true (scm);
762
763 q = qof_query_create_for(GNC_ID_SPLIT);
764
765 if (!g_strcmp0 (pd_type, "pd-date"))
766 {
767 gboolean use_start;
768 gboolean use_end;
769 time64 start;
770 time64 end;
771
772 /* use_start */
773 if (scm_is_null (query_term_scm))
774 {
775 PINFO ("null use_start");
776 break;
777 }
778
779 scm = SCM_CAR (query_term_scm);
780 query_term_scm = SCM_CDR (query_term_scm);
781 use_start = scm_is_true (scm);
782
783 /* start */
784 if (scm_is_null (query_term_scm))
785 break;
786
787 scm = SCM_CAR (query_term_scm);
788 query_term_scm = SCM_CDR (query_term_scm);
789 start = scm_to_int64 (scm);
790
791 /* use_end */
792 if (scm_is_null (query_term_scm))
793 break;
794
795 scm = SCM_CAR (query_term_scm);
796 query_term_scm = SCM_CDR (query_term_scm);
797 use_end = scm_is_true (scm);
798
799 /* end */
800 if (scm_is_null (query_term_scm))
801 break;
802
803 scm = SCM_CAR (query_term_scm);
804 end = scm_to_int64 (scm);
805
806 xaccQueryAddDateMatchTT (q, use_start, start, use_end, end, QOF_QUERY_OR);
807
808 ok = TRUE;
809
810 }
811 else if (!g_strcmp0 (pd_type, "pd-amount"))
812 {
813 QofQueryCompare how;
814 QofNumericMatch amt_sgn;
815 double amount;
816 gnc_numeric val;
817
818 /* how */
819 if (scm_is_null (query_term_scm))
820 break;
821 scm = SCM_CAR (query_term_scm);
822 query_term_scm = SCM_CDR (query_term_scm);
823 how = gnc_scm2amt_match_how (scm);
824
825 /* amt_sgn */
826 if (scm_is_null (query_term_scm))
827 break;
828 scm = SCM_CAR (query_term_scm);
829 query_term_scm = SCM_CDR (query_term_scm);
830 amt_sgn = gnc_query_scm2numericop (scm);
831
832 /* amount */
833 if (scm_is_null (query_term_scm))
834 break;
835 scm = SCM_CAR (query_term_scm);
836 val = gnc_numeric_create (scm_to_int64(scm_numerator(scm)),
837 scm_to_int64(scm_denominator(scm)));
838
839 if (!g_strcmp0 (pr_type, "pr-price"))
840 {
841 xaccQueryAddSharePriceMatch (q, val, how, QOF_QUERY_OR);
842 ok = TRUE;
843
844 }
845 else if (!g_strcmp0 (pr_type, "pr-shares"))
846 {
847 xaccQueryAddSharesMatch (q, val, how, QOF_QUERY_OR);
848 ok = TRUE;
849
850 }
851 else if (!g_strcmp0 (pr_type, "pr-value"))
852 {
853 xaccQueryAddValueMatch (q, val, amt_sgn, how, QOF_QUERY_OR);
854 ok = TRUE;
855
856 }
857 else
858 {
859 PINFO ("unknown amount predicate: %s", pr_type);
860 }
861
862 }
863 else if (!g_strcmp0 (pd_type, "pd-account"))
864 {
865 QofGuidMatch how;
866 GList *account_guids;
867
868 /* how */
869 if (scm_is_null (query_term_scm))
870 {
871 PINFO ("pd-account: null how");
872 break;
873 }
874
875 scm = SCM_CAR (query_term_scm);
876 query_term_scm = SCM_CDR (query_term_scm);
877 how = gnc_scm2acct_match_how (scm);
878
879 /* account guids */
880 if (scm_is_null (query_term_scm))
881 {
882 PINFO ("pd-account: null guids");
883 break;
884 }
885
886 scm = SCM_CAR (query_term_scm);
887
888 account_guids = gnc_scm2guid_glist (scm);
889
890 xaccQueryAddAccountGUIDMatch (q, account_guids, how, QOF_QUERY_OR);
891
892 gnc_guid_glist_free (account_guids);
893
894 ok = TRUE;
895
896 }
897 else if (!g_strcmp0 (pd_type, "pd-string"))
898 {
899 gboolean case_sens;
900 gboolean use_regexp;
901 gchar *matchstring;
902
903 /* case_sens */
904 if (scm_is_null (query_term_scm))
905 break;
906
907 scm = SCM_CAR (query_term_scm);
908 query_term_scm = SCM_CDR (query_term_scm);
909 case_sens = scm_is_true (scm);
910
911 /* use_regexp */
912 if (scm_is_null (query_term_scm))
913 break;
914
915 scm = SCM_CAR (query_term_scm);
916 query_term_scm = SCM_CDR (query_term_scm);
917 use_regexp = scm_is_true (scm);
918
919 /* matchstring */
920 if (scm_is_null (query_term_scm))
921 break;
922
923 scm = SCM_CAR (query_term_scm);
924 matchstring = gnc_scm_to_utf8_string (scm);
925
926 if (!g_strcmp0 (pr_type, "pr-action"))
927 {
928 xaccQueryAddActionMatch (q, matchstring, case_sens, use_regexp,
929 QOF_COMPARE_CONTAINS, QOF_QUERY_OR);
930 ok = TRUE;
931
932 }
933 else if (!g_strcmp0 (pr_type, "pr-desc"))
934 {
935 xaccQueryAddDescriptionMatch (q, matchstring, case_sens,
936 use_regexp, QOF_COMPARE_CONTAINS, QOF_QUERY_OR);
937 ok = TRUE;
938
939 }
940 else if (!g_strcmp0 (pr_type, "pr-memo"))
941 {
942 xaccQueryAddMemoMatch (q, matchstring, case_sens, use_regexp,
943 QOF_COMPARE_CONTAINS, QOF_QUERY_OR);
944 ok = TRUE;
945
946 }
947 else if (!g_strcmp0 (pr_type, "pr-num"))
948 {
949 xaccQueryAddNumberMatch (q, matchstring, case_sens, use_regexp,
950 QOF_COMPARE_CONTAINS, QOF_QUERY_OR);
951 ok = TRUE;
952
953 }
954 else
955 {
956 PINFO ("Unknown string predicate: %s", pr_type);
957 }
958 g_free (matchstring);
959
960 }
961 else if (!g_strcmp0 (pd_type, "pd-cleared"))
962 {
963 cleared_match_t how;
964
965 /* how */
966 if (scm_is_null (query_term_scm))
967 break;
968
969 scm = SCM_CAR (query_term_scm);
970 how = gnc_scm2cleared_match_how (scm);
971
972 xaccQueryAddClearedMatch (q, how, QOF_QUERY_OR);
973 ok = TRUE;
974
975 }
976 else if (!g_strcmp0 (pd_type, "pd-balance"))
977 {
978 gboolean how;
979
980 /* how */
981 if (scm_is_null (query_term_scm))
982 break;
983
984 scm = SCM_CAR (query_term_scm);
985 if (gnc_scm2balance_match_how (scm, &how) == FALSE)
986 break;
987
988 xaccQueryAddBalanceMatch (q, how, QOF_QUERY_OR);
989 ok = TRUE;
990
991 }
992 else if (!g_strcmp0 (pd_type, "pd-guid"))
993 {
994 GncGUID guid;
995 QofIdType id_type;
996
997 /* guid */
998 if (scm_is_null (query_term_scm))
999 break;
1000
1001 scm = SCM_CAR (query_term_scm);
1002 query_term_scm = SCM_CDR (query_term_scm);
1003 guid = gnc_scm2guid (scm);
1004
1005 /* id type */
1006 scm = SCM_CAR (query_term_scm);
1007 id_type = (QofIdType) gnc_scm_to_utf8_string (scm);
1008
1009 xaccQueryAddGUIDMatch (q, &guid, id_type, QOF_QUERY_OR);
1010 g_free ((void *) id_type);
1011 ok = TRUE;
1012
1013 }
1014 else
1015 {
1016 PINFO ("Unknown Predicate: %s", pd_type);
1017 }
1018
1019 g_free (pd_type);
1020 g_free (pr_type);
1021
1022 }
1023 while (FALSE);
1024
1025 if (ok)
1026 {
1027 QofQuery *out_q;
1028
1029 if (sense)
1030 out_q = q;
1031 else
1032 {
1033 out_q = qof_query_invert (q);
1034 qof_query_destroy (q);
1035 }
1036
1037 return out_q;
1038 }
1039
1040 qof_query_destroy (q);
1041 return NULL;
1042 }
1043
1044 static QofQuery *
gnc_scm2query_term_query(SCM query_term_scm,query_version_t vers)1045 gnc_scm2query_term_query (SCM query_term_scm, query_version_t vers)
1046 {
1047 switch (vers)
1048 {
1049 case gnc_QUERY_v1:
1050 return gnc_scm2query_term_query_v1 (query_term_scm);
1051 case gnc_QUERY_v2:
1052 return gnc_scm2query_term_query_v2 (query_term_scm);
1053 default:
1054 return NULL;
1055 }
1056 }
1057
1058 static SCM
gnc_query_terms2scm(const GList * terms)1059 gnc_query_terms2scm (const GList *terms)
1060 {
1061 SCM or_terms = SCM_EOL;
1062 const GList *or_node;
1063
1064 for (or_node = terms; or_node; or_node = or_node->next)
1065 {
1066 SCM and_terms = SCM_EOL;
1067 GList *and_node;
1068
1069 for (and_node = or_node->data; and_node; and_node = and_node->next)
1070 {
1071 QofQueryTerm *qt = and_node->data;
1072 SCM qt_scm;
1073
1074 qt_scm = gnc_queryterm2scm (qt);
1075
1076 and_terms = scm_cons (qt_scm, and_terms);
1077 }
1078
1079 and_terms = scm_reverse (and_terms);
1080
1081 or_terms = scm_cons (and_terms, or_terms);
1082 }
1083
1084 return scm_reverse (or_terms);
1085 }
1086
1087 static QofQuery *
gnc_scm2query_and_terms(SCM and_terms,query_version_t vers)1088 gnc_scm2query_and_terms (SCM and_terms, query_version_t vers)
1089 {
1090 QofQuery *q = NULL;
1091
1092 if (!scm_is_list (and_terms))
1093 return NULL;
1094
1095 while (!scm_is_null (and_terms))
1096 {
1097 SCM term;
1098
1099 term = SCM_CAR (and_terms);
1100 and_terms = SCM_CDR (and_terms);
1101
1102 if (!q)
1103 q = gnc_scm2query_term_query (term, vers);
1104 else
1105 {
1106 QofQuery *q_and;
1107 QofQuery *q_new;
1108
1109 q_and = gnc_scm2query_term_query (term, vers);
1110
1111 if (q_and)
1112 {
1113 q_new = qof_query_merge (q, q_and, QOF_QUERY_AND);
1114 qof_query_destroy (q_and);
1115
1116 if (q_new)
1117 {
1118 qof_query_destroy (q);
1119 q = q_new;
1120 }
1121 }
1122 }
1123 }
1124
1125 return q;
1126 }
1127
1128 static QofQuery *
gnc_scm2query_or_terms(SCM or_terms,query_version_t vers)1129 gnc_scm2query_or_terms (SCM or_terms, query_version_t vers)
1130 {
1131 QofQuery *q = NULL;
1132
1133 if (!scm_is_list (or_terms))
1134 return NULL;
1135
1136 q = qof_query_create_for(GNC_ID_SPLIT);
1137
1138 while (!scm_is_null (or_terms))
1139 {
1140 SCM and_terms;
1141
1142 and_terms = SCM_CAR (or_terms);
1143 or_terms = SCM_CDR (or_terms);
1144
1145 if (!q)
1146 q = gnc_scm2query_and_terms (and_terms, vers);
1147 else
1148 {
1149 QofQuery *q_or;
1150 QofQuery *q_new;
1151
1152 q_or = gnc_scm2query_and_terms (and_terms, vers);
1153
1154 if (q_or)
1155 {
1156 q_new = qof_query_merge (q, q_or, QOF_QUERY_OR);
1157 qof_query_destroy (q_or);
1158
1159 if (q_new)
1160 {
1161 qof_query_destroy (q);
1162 q = q_new;
1163 }
1164 }
1165 }
1166 }
1167
1168 return q;
1169 }
1170
1171 static SCM
gnc_query_sort2scm(const QofQuerySort * qs)1172 gnc_query_sort2scm (const QofQuerySort *qs)
1173 {
1174 SCM sort_scm = SCM_EOL;
1175 GSList *path;
1176
1177 path = qof_query_sort_get_param_path (qs);
1178 if (path == NULL)
1179 return SCM_BOOL_F;
1180
1181 sort_scm = scm_cons (gnc_query_path2scm (path), sort_scm);
1182 sort_scm = scm_cons (scm_from_int (qof_query_sort_get_sort_options (qs)), sort_scm);
1183 sort_scm = scm_cons (SCM_BOOL (qof_query_sort_get_increasing (qs)), sort_scm);
1184
1185 return scm_reverse (sort_scm);
1186 }
1187
1188 static gboolean
gnc_query_scm2sort(SCM sort_scm,GSList ** path,gint * options,gboolean * inc)1189 gnc_query_scm2sort (SCM sort_scm, GSList **path, gint *options, gboolean *inc)
1190 {
1191 SCM val;
1192 GSList *p;
1193 gint o;
1194 gboolean i;
1195
1196 g_return_val_if_fail (path && options && inc, FALSE);
1197 g_return_val_if_fail (*path == NULL, FALSE);
1198
1199 /* This is ok -- it means we have an empty sort. Don't do anything */
1200 if (scm_is_bool (sort_scm))
1201 return TRUE;
1202
1203 /* Ok, this had better be a list */
1204 if (!scm_is_list (sort_scm))
1205 return FALSE;
1206
1207 /* Parse the path, options, and increasing */
1208 val = SCM_CAR (sort_scm);
1209 sort_scm = SCM_CDR (sort_scm);
1210 if (!scm_is_list (val))
1211 return FALSE;
1212 p = gnc_query_scm2path (val);
1213
1214 /* options */
1215 val = SCM_CAR (sort_scm);
1216 sort_scm = SCM_CDR (sort_scm);
1217 if (!scm_is_number (val))
1218 {
1219 gnc_query_path_free (p);
1220 return FALSE;
1221 }
1222 o = scm_to_int (val);
1223
1224 /* increasing */
1225 val = SCM_CAR (sort_scm);
1226 sort_scm = SCM_CDR (sort_scm);
1227 if (!scm_is_bool (val))
1228 {
1229 gnc_query_path_free (p);
1230 return FALSE;
1231 }
1232 i = scm_is_true (val);
1233
1234 /* EOL */
1235 if (!scm_is_null (sort_scm))
1236 {
1237 gnc_query_path_free (p);
1238 return FALSE;
1239 }
1240 *path = p;
1241 *options = o;
1242 *inc = i;
1243
1244 return TRUE;
1245 }
1246
1247 SCM
gnc_query2scm(QofQuery * q)1248 gnc_query2scm (QofQuery *q)
1249 {
1250 SCM query_scm = SCM_EOL;
1251 SCM pair;
1252 QofQuerySort *s1, *s2, *s3;
1253
1254 if (!q) return SCM_BOOL_F;
1255
1256 /* terms */
1257 pair = scm_cons (gnc_query_terms2scm (qof_query_get_terms (q)), SCM_EOL);
1258 pair = scm_cons (scm_from_locale_symbol ("terms"), pair);
1259 query_scm = scm_cons (pair, query_scm);
1260
1261 /* search-for */
1262 pair = scm_cons (scm_from_locale_symbol (qof_query_get_search_for (q)), SCM_EOL);
1263 pair = scm_cons (scm_from_locale_symbol ("search-for"), pair);
1264 query_scm = scm_cons (pair, query_scm);
1265
1266 /* sorts... */
1267 qof_query_get_sorts (q, &s1, &s2, &s3);
1268
1269 /* primary-sort */
1270 pair = scm_cons (gnc_query_sort2scm (s1), SCM_EOL);
1271 pair = scm_cons (scm_from_locale_symbol ("primary-sort"), pair);
1272 query_scm = scm_cons (pair, query_scm);
1273
1274 /* secondary-sort */
1275 pair = scm_cons (gnc_query_sort2scm (s2), SCM_EOL);
1276 pair = scm_cons (scm_from_locale_symbol ("secondary-sort"), pair);
1277 query_scm = scm_cons (pair, query_scm);
1278
1279 /* tertiary-sort */
1280 pair = scm_cons (gnc_query_sort2scm (s3), SCM_EOL);
1281 pair = scm_cons (scm_from_locale_symbol ("tertiary-sort"), pair);
1282 query_scm = scm_cons (pair, query_scm);
1283
1284 /* max results */
1285 pair = scm_cons (scm_from_int (qof_query_get_max_results (q)), SCM_EOL);
1286 pair = scm_cons (scm_from_locale_symbol ("max-results"), pair);
1287 query_scm = scm_cons (pair, query_scm);
1288
1289 /* Reverse this list; tag it as 'query-v2' */
1290 pair = scm_reverse (query_scm);
1291 return scm_cons (scm_from_locale_symbol ("query-v2"), pair);
1292 }
1293
1294 static GSList *
gnc_query_sort_to_list(const gchar * symbol)1295 gnc_query_sort_to_list (const gchar * symbol)
1296 {
1297 GSList *path = NULL;
1298
1299 if (!symbol)
1300 return NULL;
1301
1302 if (!g_strcmp0 (symbol, "by-none"))
1303 {
1304 path = NULL;
1305 }
1306 else if (!g_strcmp0 (symbol, "by-standard"))
1307 {
1308 path = g_slist_prepend (path, QUERY_DEFAULT_SORT);
1309
1310 }
1311 else if (!g_strcmp0 (symbol, "by-date") ||
1312 !g_strcmp0 (symbol, "by-date-rounded"))
1313 {
1314 path = g_slist_prepend (path, TRANS_DATE_POSTED);
1315 path = g_slist_prepend (path, SPLIT_TRANS);
1316
1317 }
1318 else if (!g_strcmp0 (symbol, "by-date-entered") ||
1319 !g_strcmp0 (symbol, "by-date-entered-rounded"))
1320 {
1321 path = g_slist_prepend (path, TRANS_DATE_ENTERED);
1322 path = g_slist_prepend (path, SPLIT_TRANS);
1323
1324 }
1325 else if (!g_strcmp0 (symbol, "by-date-reconciled") ||
1326 !g_strcmp0 (symbol, "by-date-reconciled-rounded"))
1327 {
1328 path = g_slist_prepend (path, SPLIT_DATE_RECONCILED);
1329
1330 }
1331 else if (!g_strcmp0 (symbol, "by-num"))
1332 {
1333 path = g_slist_prepend (path, TRANS_NUM);
1334 path = g_slist_prepend (path, SPLIT_TRANS);
1335
1336 }
1337 else if (!g_strcmp0 (symbol, "by-amount"))
1338 {
1339 path = g_slist_prepend (path, SPLIT_VALUE);
1340
1341 }
1342 else if (!g_strcmp0 (symbol, "by-memo"))
1343 {
1344 path = g_slist_prepend (path, SPLIT_MEMO);
1345
1346 }
1347 else if (!g_strcmp0 (symbol, "by-desc"))
1348 {
1349 path = g_slist_prepend (path, TRANS_DESCRIPTION);
1350 path = g_slist_prepend (path, SPLIT_TRANS);
1351
1352 }
1353 else if (!g_strcmp0 (symbol, "by-reconcile"))
1354 {
1355 path = g_slist_prepend (path, SPLIT_RECONCILE);
1356
1357 }
1358 else if (!g_strcmp0 (symbol, "by-account-full-name"))
1359 {
1360 path = g_slist_prepend (path, SPLIT_ACCT_FULLNAME);
1361
1362 }
1363 else if (!g_strcmp0 (symbol, "by-account-code"))
1364 {
1365 path = g_slist_prepend (path, ACCOUNT_CODE_);
1366 path = g_slist_prepend (path, SPLIT_ACCOUNT);
1367
1368 }
1369 else if (!g_strcmp0 (symbol, "by-corr-account-full-name"))
1370 {
1371 path = g_slist_prepend (path, SPLIT_CORR_ACCT_NAME);
1372
1373 }
1374 else if (!g_strcmp0 (symbol, "by-corr-account-code"))
1375 {
1376 path = g_slist_prepend (path, SPLIT_CORR_ACCT_CODE);
1377
1378 }
1379 else
1380 {
1381 PERR ("Unknown sort-type, %s", symbol);
1382 }
1383
1384 return path;
1385 }
1386
1387 static QofQuery *
gnc_scm2query_v1(SCM query_scm)1388 gnc_scm2query_v1 (SCM query_scm)
1389 {
1390 QofQuery *q = NULL;
1391 gboolean ok = TRUE;
1392 gchar * primary_sort = NULL;
1393 gchar * secondary_sort = NULL;
1394 gchar * tertiary_sort = NULL;
1395 gboolean primary_increasing = TRUE;
1396 gboolean secondary_increasing = TRUE;
1397 gboolean tertiary_increasing = TRUE;
1398 int max_splits = -1;
1399
1400 while (!scm_is_null (query_scm))
1401 {
1402 gchar *symbol;
1403 SCM sym_scm;
1404 SCM value;
1405 SCM pair;
1406
1407 pair = SCM_CAR (query_scm);
1408 query_scm = SCM_CDR (query_scm);
1409
1410 if (!scm_is_pair (pair))
1411 {
1412 PERR ("Not a Pair");
1413 ok = FALSE;
1414 break;
1415 }
1416
1417 sym_scm = SCM_CAR (pair);
1418 value = SCM_CADR (pair);
1419
1420 if (!scm_is_symbol (sym_scm))
1421 {
1422 PERR ("Not a symbol");
1423 ok = FALSE;
1424 break;
1425 }
1426
1427 symbol = gnc_scm_symbol_to_locale_string (sym_scm);
1428 if (!symbol)
1429 {
1430 PERR ("No string found");
1431 ok = FALSE;
1432 break;
1433 }
1434
1435 if (g_strcmp0 ("terms", symbol) == 0)
1436 {
1437 if (q)
1438 qof_query_destroy (q);
1439
1440 q = gnc_scm2query_or_terms (value, gnc_QUERY_v1);
1441 if (!q)
1442 {
1443 PINFO ("invalid terms");
1444 ok = FALSE;
1445 break;
1446 }
1447
1448 }
1449 else if (g_strcmp0 ("primary-sort", symbol) == 0)
1450 {
1451 if (!scm_is_symbol (value))
1452 {
1453 PINFO ("Invalid primary sort");
1454 ok = FALSE;
1455 break;
1456 }
1457
1458 primary_sort = gnc_scm_symbol_to_locale_string (value);
1459
1460 }
1461 else if (g_strcmp0 ("secondary-sort", symbol) == 0)
1462 {
1463 if (!scm_is_symbol (value))
1464 {
1465 PINFO ("Invalid secondary sort");
1466 ok = FALSE;
1467 break;
1468 }
1469
1470 secondary_sort = gnc_scm_symbol_to_locale_string (value);
1471
1472 }
1473 else if (g_strcmp0 ("tertiary-sort", symbol) == 0)
1474 {
1475 if (!scm_is_symbol (value))
1476 {
1477 PINFO ("Invalid tertiary sort");
1478 ok = FALSE;
1479 break;
1480 }
1481
1482 tertiary_sort = gnc_scm_symbol_to_locale_string (value);
1483
1484 }
1485 else if (g_strcmp0 ("primary-increasing", symbol) == 0)
1486 {
1487 primary_increasing = scm_is_true (value);
1488
1489 }
1490 else if (g_strcmp0 ("secondary-increasing", symbol) == 0)
1491 {
1492 secondary_increasing = scm_is_true (value);
1493
1494 }
1495 else if (g_strcmp0 ("tertiary-increasing", symbol) == 0)
1496 {
1497 tertiary_increasing = scm_is_true (value);
1498
1499 }
1500 else if (g_strcmp0 ("max-splits", symbol) == 0)
1501 {
1502 if (!scm_is_number (value))
1503 {
1504 PERR ("invalid max-splits");
1505 ok = FALSE;
1506 break;
1507 }
1508
1509 max_splits = scm_to_int (value);
1510
1511 }
1512 else
1513 {
1514 PERR ("Unknown symbol: %s", symbol);
1515 ok = FALSE;
1516 break;
1517 }
1518
1519 g_free (symbol);
1520 }
1521
1522 if (ok)
1523 {
1524 GSList *s1, *s2, *s3;
1525 s1 = gnc_query_sort_to_list (primary_sort);
1526 s2 = gnc_query_sort_to_list (secondary_sort);
1527 s3 = gnc_query_sort_to_list (tertiary_sort);
1528
1529 qof_query_set_sort_order (q, s1, s2, s3);
1530 qof_query_set_sort_increasing (q, primary_increasing, secondary_increasing,
1531 tertiary_increasing);
1532 qof_query_set_max_results (q, max_splits);
1533 }
1534 else
1535 {
1536 qof_query_destroy (q);
1537 q = NULL;
1538 }
1539
1540 g_free (primary_sort);
1541 g_free (secondary_sort);
1542 g_free (tertiary_sort);
1543
1544 return q;
1545 }
1546
1547 static QofQuery *
gnc_scm2query_v2(SCM query_scm)1548 gnc_scm2query_v2 (SCM query_scm)
1549 {
1550 QofQuery *q = NULL;
1551 gboolean ok = TRUE;
1552 gchar * search_for = NULL;
1553 GSList *sp1 = NULL, *sp2 = NULL, *sp3 = NULL;
1554 gint so1 = 0, so2 = 0, so3 = 0;
1555 gboolean si1 = TRUE, si2 = TRUE, si3 = TRUE;
1556 int max_results = -1;
1557
1558 while (!scm_is_null (query_scm))
1559 {
1560 gchar *symbol;
1561 SCM sym_scm;
1562 SCM value;
1563 SCM pair;
1564
1565 pair = SCM_CAR (query_scm);
1566 query_scm = SCM_CDR (query_scm);
1567
1568 if (!scm_is_pair (pair))
1569 {
1570 ok = FALSE;
1571 break;
1572 }
1573
1574 sym_scm = SCM_CAR (pair);
1575 value = SCM_CADR (pair);
1576
1577 if (!scm_is_symbol (sym_scm))
1578 {
1579 ok = FALSE;
1580 break;
1581 }
1582
1583 symbol = gnc_scm_symbol_to_locale_string (sym_scm);
1584 if (!symbol)
1585 {
1586 ok = FALSE;
1587 break;
1588 }
1589
1590 if (!g_strcmp0 ("terms", symbol))
1591 {
1592 if (q)
1593 qof_query_destroy (q);
1594
1595 q = gnc_scm2query_or_terms (value, gnc_QUERY_v2);
1596 if (!q)
1597 {
1598 ok = FALSE;
1599 break;
1600 }
1601
1602 }
1603 else if (!g_strcmp0 ("search-for", symbol))
1604 {
1605 if (!scm_is_symbol (value))
1606 {
1607 ok = FALSE;
1608 break;
1609 }
1610 search_for = gnc_scm_symbol_to_locale_string (value);
1611
1612 }
1613 else if (g_strcmp0 ("primary-sort", symbol) == 0)
1614 {
1615 if (! gnc_query_scm2sort (value, &sp1, &so1, &si1))
1616 {
1617 ok = FALSE;
1618 break;
1619 }
1620
1621 }
1622 else if (!g_strcmp0 ("secondary-sort", symbol))
1623 {
1624 if (! gnc_query_scm2sort (value, &sp2, &so2, &si2))
1625 {
1626 ok = FALSE;
1627 break;
1628 }
1629
1630 }
1631 else if (!g_strcmp0 ("tertiary-sort", symbol))
1632 {
1633 if (! gnc_query_scm2sort (value, &sp3, &so3, &si3))
1634 {
1635 ok = FALSE;
1636 break;
1637 }
1638
1639 }
1640 else if (!g_strcmp0 ("max-results", symbol))
1641 {
1642 if (!scm_is_number (value))
1643 {
1644 ok = FALSE;
1645 break;
1646 }
1647
1648 max_results = scm_to_int (value);
1649
1650 }
1651 else
1652 {
1653 ok = FALSE;
1654 break;
1655 }
1656
1657 g_free (symbol);
1658 }
1659
1660 if (ok && search_for)
1661 {
1662 qof_query_search_for (q, search_for);
1663 qof_query_set_sort_order (q, sp1, sp2, sp3);
1664 qof_query_set_sort_options (q, so1, so2, so3);
1665 qof_query_set_sort_increasing (q, si1, si2, si3);
1666 qof_query_set_max_results (q, max_results);
1667 }
1668 else
1669 {
1670 qof_query_destroy (q);
1671 q = NULL;
1672 }
1673
1674 g_free (search_for);
1675
1676 return q;
1677 }
1678
1679 QofQuery *
gnc_scm2query(SCM query_scm)1680 gnc_scm2query (SCM query_scm)
1681 {
1682 SCM q_type;
1683 gchar *type;
1684 QofQuery *q = NULL;
1685
1686 /* Not a list or NULL? No need to go further */
1687 if (!scm_is_list (query_scm) || scm_is_null (query_scm))
1688 return NULL;
1689
1690 /* Grab the 'type' (for v2 and above) */
1691 q_type = SCM_CAR (query_scm);
1692
1693 if (!scm_is_symbol (q_type))
1694 {
1695 if (scm_is_pair (q_type))
1696 {
1697 /* Version-1 queries are just a list */
1698 return gnc_scm2query_v1 (query_scm);
1699 }
1700 else
1701 {
1702 return NULL;
1703 }
1704 }
1705
1706 /* Ok, the LHS is the version and the RHS is the actual query list */
1707 type = gnc_scm_symbol_to_locale_string (q_type);
1708 if (!type)
1709 return NULL;
1710
1711 if (!g_strcmp0 (type, "query-v2"))
1712 q = gnc_scm2query_v2 (SCM_CDR (query_scm));
1713
1714 g_free (type);
1715 return q;
1716 }
1717
1718 gnc_numeric
gnc_scm_to_numeric(SCM gncnum)1719 gnc_scm_to_numeric(SCM gncnum)
1720 {
1721 SCM num, denom;
1722
1723 /* Not a number. */
1724 if (!scm_is_number (gncnum))
1725 return gnc_numeric_error (GNC_ERROR_ARG);
1726
1727 num = scm_numerator (gncnum);
1728 denom = scm_denominator (gncnum);
1729
1730 /* scm overflows 64-bit numbers */
1731 if (!scm_is_signed_integer (num, INT64_MIN, INT64_MAX) ||
1732 !scm_is_signed_integer (denom, INT64_MIN, INT64_MAX))
1733 return gnc_numeric_error (GNC_ERROR_OVERFLOW);
1734
1735 return gnc_numeric_create (scm_to_int64 (num), scm_to_int64 (denom));
1736 }
1737
1738 SCM
gnc_numeric_to_scm(gnc_numeric arg)1739 gnc_numeric_to_scm(gnc_numeric arg)
1740 {
1741 return gnc_numeric_check (arg) ? SCM_BOOL_F :
1742 scm_divide (scm_from_int64 (arg.num), scm_from_int64 (arg.denom));
1743 }
1744
1745 static SCM
gnc_generic_to_scm(const void * cx,const gchar * type_str)1746 gnc_generic_to_scm(const void *cx, const gchar *type_str)
1747 {
1748 swig_type_info * stype = NULL;
1749 void *x = (void*) cx;
1750
1751 if (!x) return SCM_BOOL_F;
1752 stype = SWIG_TypeQuery(type_str);
1753
1754 if (!stype)
1755 {
1756 PERR("Unknown SWIG Type: %s ", type_str);
1757 return SCM_BOOL_F;
1758 }
1759
1760 return SWIG_NewPointerObj(x, stype, 0);
1761 }
1762
1763 static void *
gnc_scm_to_generic(SCM scm,const gchar * type_str)1764 gnc_scm_to_generic(SCM scm, const gchar *type_str)
1765 {
1766 swig_type_info * stype = NULL;
1767
1768 stype = SWIG_TypeQuery(type_str);
1769 if (!stype)
1770 {
1771 PERR("Unknown SWIG Type: %s ", type_str);
1772 return NULL;
1773 }
1774
1775 if (!SWIG_IsPointerOfType(scm, stype))
1776 return NULL;
1777
1778 return SWIG_MustGetPtr(scm, stype, 1, 0);
1779 }
1780
1781 gnc_commodity *
gnc_scm_to_commodity(SCM scm)1782 gnc_scm_to_commodity(SCM scm)
1783 {
1784 return gnc_scm_to_generic(scm, "_p_gnc_commodity");
1785 }
1786
1787 SCM
gnc_commodity_to_scm(const gnc_commodity * commodity)1788 gnc_commodity_to_scm (const gnc_commodity *commodity)
1789 {
1790 return gnc_generic_to_scm(commodity, "_p_gnc_commodity");
1791 }
1792
1793 SCM
gnc_book_to_scm(const QofBook * book)1794 gnc_book_to_scm (const QofBook *book)
1795 {
1796 return gnc_generic_to_scm(book, "_p_QofBook");
1797 }
1798
1799 static swig_type_info *
get_acct_type()1800 get_acct_type ()
1801 {
1802 static swig_type_info * account_type = NULL;
1803
1804 if (!account_type)
1805 account_type = SWIG_TypeQuery("_p_Account");
1806
1807 return account_type;
1808 }
1809
gnc_scm_to_account_value_ptr(SCM valuearg)1810 GncAccountValue * gnc_scm_to_account_value_ptr (SCM valuearg)
1811 {
1812 GncAccountValue *res;
1813 Account *acc = NULL;
1814 gnc_numeric value;
1815 swig_type_info * account_type = get_acct_type();
1816 SCM val;
1817
1818 /* Get the account */
1819 val = SCM_CAR (valuearg);
1820 if (!SWIG_IsPointerOfType (val, account_type))
1821 return NULL;
1822
1823 acc = SWIG_MustGetPtr(val, account_type, 1, 0);
1824
1825 /* Get the value */
1826 val = SCM_CDR (valuearg);
1827 value = gnc_scm_to_numeric (val);
1828
1829 /* Build and return the object */
1830 res = g_new0 (GncAccountValue, 1);
1831 res->account = acc;
1832 res->value = value;
1833 return res;
1834 }
1835
gnc_account_value_ptr_to_scm(GncAccountValue * av)1836 SCM gnc_account_value_ptr_to_scm (GncAccountValue *av)
1837 {
1838 swig_type_info * account_type = get_acct_type();
1839 gnc_commodity * com;
1840 gnc_numeric val;
1841
1842 if (!av) return SCM_BOOL_F;
1843
1844 com = xaccAccountGetCommodity (av->account);
1845 val = gnc_numeric_convert (av->value, gnc_commodity_get_fraction (com),
1846 GNC_HOW_RND_ROUND_HALF_UP);
1847
1848 return scm_cons (SWIG_NewPointerObj(av->account, account_type, 0),
1849 gnc_numeric_to_scm (val));
1850 }
1851
1852 typedef struct
1853 {
1854 SCM proc;
1855 int num_args;
1856 } GncScmDangler;
1857
1858
1859 static void
delete_scm_hook(gpointer data)1860 delete_scm_hook (gpointer data)
1861 {
1862 GncScmDangler *scm = data;
1863 scm_gc_unprotect_object(scm->proc);
1864 g_free(scm);
1865 }
1866
1867 static void
scm_hook_cb(gpointer data,GncScmDangler * scm)1868 scm_hook_cb (gpointer data, GncScmDangler *scm)
1869 {
1870 ENTER("data %p, cbarg %p", data, scm);
1871
1872 if (scm->num_args == 0)
1873 scm_call_0 (scm->proc);
1874 else
1875 {
1876 // XXX: FIXME: We really should make sure this is a session!!! */
1877 scm_call_1 (scm->proc,
1878 SWIG_NewPointerObj(data, SWIG_TypeQuery("_p_QofSession"), 0));
1879 }
1880
1881 LEAVE("");
1882 }
1883
1884 void
gnc_hook_add_scm_dangler(const gchar * name,SCM proc)1885 gnc_hook_add_scm_dangler (const gchar *name, SCM proc)
1886 {
1887 GHook *hook;
1888 GncScmDangler *scm;
1889 int num_args;
1890
1891 ENTER("list %s, proc ???", name);
1892 num_args = gnc_hook_num_args(name);
1893 g_return_if_fail(num_args >= 0);
1894 scm = g_new0(GncScmDangler, 1);
1895 scm_gc_protect_object(proc);
1896 scm->proc = proc;
1897 scm->num_args = num_args;
1898 gnc_hook_add_dangler(name, (GFunc)scm_hook_cb,
1899 (GDestroyNotify) delete_scm_hook, scm);
1900 LEAVE("");
1901 }
1902
1903 time64
gnc_parse_time_to_time64(const gchar * s,const gchar * format)1904 gnc_parse_time_to_time64 (const gchar *s, const gchar *format)
1905 {
1906 struct tm tm;
1907
1908 g_return_val_if_fail(s && format, -1);
1909
1910 bzero(&tm, sizeof(tm));
1911
1912 if (!strptime(s, format, &tm))
1913 return -1;
1914
1915 return gnc_mktime(&tm);
1916 }
1917
1918