blob: 3abb3482a927b471dab981cd188d848c4b4be6d3 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
|
;;; guile-xapian --- Guile bindings for Xapian
;;; Copyright © 2026 Arun Isaac <arunisaac@systemreboot.net>
;;;
;;; This file is part of guile-xapian.
;;;
;;; guile-xapian 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.
;;;
;;; guile-xapian 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 guile-xapian. If not, see
;;; <https://www.gnu.org/licenses/>.
(use-modules (rnrs io ports)
(srfi srfi-26)
(srfi srfi-64)
(ice-9 match)
(ice-9 popen))
(define (call-with-input-pipe command proc)
"Call @var{proc} with input pipe to @var{command}. @var{command} is a
list of program arguments."
(match command
((prog args ...)
(let ((port #f))
(dynamic-wind
(lambda ()
(set! port (apply open-pipe* OPEN_READ prog args)))
(cut proc port)
(lambda ()
(unless (zero? (close-pipe port))
(error "Command invocation failed" command))))))))
(define (search . query)
(call-with-input-pipe (cons* "guile" "examples/search.scm" "/tmp/db" query)
(lambda (port)
;; port-transduce might be shorter and more preferable. But we'd
;; like to support guile 2.2, and port-transduce does not exist
;; in guile 2.2.
(let loop ((result '()))
(let ((line (get-line port)))
(if (eof-object? line)
(reverse result)
(loop (cons line result))))))))
(test-begin "examples")
(test-equal "index"
0
(status:exit-val
(system* "guile"
"examples/index.scm"
"examples/100-objects.sexp"
"/tmp/db")))
(test-equal "search watch"
(list "0: #004 Watch with Chinese duplex escapement"
"1: #018 Solar/Sidereal verge watch with epicyclic maintaining power"
"2: #013 Watch timer by P"
"3: #033 A device by Favag of Neuchatel which enables a stop watch to"
"4: #015 Ingersoll \"Dan Dare\" automaton pocket watch with pin-pallet"
"5: #036 Universal 'Tri-Compax' chronographic wrist watch"
"6: #046 Model by Dent of mechanism for setting hands and winding up")
(search "watch"))
(test-equal "search Dent watch"
(list "0: #046 Model by Dent of mechanism for setting hands and winding up"
"1: #004 Watch with Chinese duplex escapement"
"2: #018 Solar/Sidereal verge watch with epicyclic maintaining power"
"3: #013 Watch timer by P"
"4: #094 Model of a Lever Escapement , 1850-1883"
"5: #093 Model of Graham's Cylinder Escapement, 1850-1883"
"6: #033 A device by Favag of Neuchatel which enables a stop watch to"
"7: #015 Ingersoll \"Dan Dare\" automaton pocket watch with pin-pallet"
"8: #086 Model representing Earnshaw's detent chronometer escapement, 1950-1883"
"9: #036 Universal 'Tri-Compax' chronographic wrist watch")
(search "Dent" "watch"))
(test-equal "search title:sunwatch"
(list "0: #001 Ansonia Sunwatch (pocket compas dial)")
(search "title:sunwatch"))
(test-equal "search description:\"leather case\" AND title:sundial"
(list "0: #055 Silver altitude sundial in leather case"
"1: #084 Magnetic sundial in brass case")
(search "description:leather case" "AND" "title:sundial"))
(test-end "examples")
|
