Changeset 15839 in project


Ignore:
Timestamp:
09/12/09 21:28:45 (10 years ago)
Author:
sjamaan
Message:

Add some sanity to attribute searching

Location:
release/4/estraier-client
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/estraier-client/estraier-client.scm

    r15837 r15839  
    216216                              keywords))))))))
    217217
    218 (define (find-documents node #!key phrase attr order max options auxiliary
    219                         distinct depth wwidth hwidth awidth skip mask)
    220   (apply
    221    values
    222    (exec (node-uri node "search"
    223                    query: `((phrase . ,phrase)
    224                             (attr . ,attr)
    225                             (order . ,order)
    226                             (max . ,(and max (->string max)))
    227                             (options . ,(and options (->string options)))
    228                             (auxiliary . ,(and auxiliary (->string auxiliary)))
    229                             (distinct . ,distinct)
    230                             (depth . ,(and depth (->string depth)))
    231                             (wwidth . ,(and wwidth (->string wwidth)))
    232                             (hwidth . ,(and hwidth (->string hwidth)))
    233                             (awidth . ,(and awidth (->string awidth)))
    234                             (skip . ,(and skip (->string skip)))
    235                             (mask . ,(and mask (->string mask)))))
    236          #f
    237          (lambda (in)
    238            (let* ((delimiter (read-line in))
    239                   (meta
    240                    (let next-line ((line (read-line in))
    241                                    (metadata (list)))
    242                      ;; There's a pointless blank line at the end... skip over it
    243                      (if (string-null? line)
    244                          (next-line (read-line in) metadata)
    245                          (if (string-prefix? delimiter line)
    246                              (reverse! metadata) ; done, continue to snippets
    247                              (let ((data (string-split line "\t" #t)))
    248                                (next-line (read-line in)
    249                                           (cons (cons (string->symbol (car data))
    250                                                       (cdr data))
    251                                                 metadata)))))))
    252                   (documents
    253                    (let next-document ((docs (list)))
    254                      (let ((attribs (read-attributes in)))
    255                        (let next-line ((matches (list))
    256                                        (line  (read-line in)))
    257                          (cond
    258                           ;; We're not relying on :END here since it would
    259                           ;; complicate matters with zero search results.
    260                           ((eof-object? line)
    261                            (reverse! docs))
    262                           ((string-prefix? delimiter line)
    263                            (next-document (cons (cons (reverse! matches) attribs)
    264                                                 docs)))
    265                           ;; Discard pointless empty lines.. there's at least
    266                           ;; one at the end of each block.
    267                           ((string-null? line)
    268                            (next-line matches (read-line in)))
    269                           (else
    270                            (let* ((idx (string-index line #\tab))
    271                                   (highlight (and idx (string-take line idx)))
    272                                   (match (if idx
    273                                              (string-drop line (add1 idx))
    274                                              line)))
    275                              (next-line (cons (cons highlight match) matches)
    276                                         (read-line in))))))))))
    277              (list documents meta))))))
     218;; Attrs are ANDed together.  All attribute phrases must match
     219(define (find-documents node #!key phrase (attr-phrases '()) order max options
     220                        auxiliary distinct depth wwidth hwidth awidth skip mask)
     221  (when (> (length attr-phrases) 10)
     222    (error (string-append "You can't provide more than 10 attribute phrases. "
     223                          "This is a limitation of the estraier API. Sorry!")))
     224  ;; Normalise attr-phrases list to attr, attr1, ... attr9
     225  (let ((attrs (map (lambda (a i)
     226                      (if (zero? i)
     227                          (cons 'attr a)
     228                          (cons (sprintf "attr~A" i) a)))
     229                    attr-phrases
     230                    (iota 10))))
     231   (apply
     232    values
     233    (exec (node-uri node "search"
     234                    query: `((phrase . ,phrase)
     235                             (order . ,order)
     236                             (max . ,(and max (->string max)))
     237                             (options . ,(and options (->string options)))
     238                             (auxiliary . ,(and auxiliary (->string auxiliary)))
     239                             (distinct . ,distinct)
     240                             (depth . ,(and depth (->string depth)))
     241                             (wwidth . ,(and wwidth (->string wwidth)))
     242                             (hwidth . ,(and hwidth (->string hwidth)))
     243                             (awidth . ,(and awidth (->string awidth)))
     244                             (skip . ,(and skip (->string skip)))
     245                             (mask . ,(and mask (->string mask)))
     246                             ,@attrs))
     247          #f
     248          (lambda (in)
     249            (let* ((delimiter (read-line in))
     250                   (meta
     251                    (let next-line ((line (read-line in))
     252                                    (metadata (list)))
     253                      ;; There's a pointless blank line at the end... skip over it
     254                      (if (string-null? line)
     255                          (next-line (read-line in) metadata)
     256                          (if (string-prefix? delimiter line)
     257                              (reverse! metadata) ; done, continue to snippets
     258                              (let ((data (string-split line "\t" #t)))
     259                                (next-line (read-line in)
     260                                           (cons (cons (string->symbol (car data))
     261                                                       (cdr data))
     262                                                 metadata)))))))
     263                   (documents
     264                    (let next-document ((docs (list)))
     265                      (let ((attribs (read-attributes in)))
     266                        (let next-line ((matches (list))
     267                                        (line  (read-line in)))
     268                          (cond
     269                           ;; We're not relying on :END here since it would
     270                           ;; complicate matters with zero search results.
     271                           ((eof-object? line)
     272                            (reverse! docs))
     273                           ((string-prefix? delimiter line)
     274                            (next-document (cons (cons (reverse! matches) attribs)
     275                                                 docs)))
     276                           ;; Discard pointless empty lines.. there's at least
     277                           ;; one at the end of each block.
     278                           ((string-null? line)
     279                            (next-line matches (read-line in)))
     280                           (else
     281                            (let* ((idx (string-index line #\tab))
     282                                   (highlight (and idx (string-take line idx)))
     283                                   (match (if idx
     284                                              (string-drop line (add1 idx))
     285                                              line)))
     286                              (next-line (cons (cons highlight match) matches)
     287                                         (read-line in))))))))))
     288              (list documents meta)))))))
    278289
    279290(define (_set-user node name mode)
  • release/4/estraier-client/tests/run.scm

    r15833 r15839  
    6161        '() (list-documents node-uri))
    6262
    63   (test "After registering admins and a guests, they are listed in node info"
     63  (test "After registering admins and guests, they are listed in node info"
    6464        '(("guest1" "guest2" "both") ("admin1" "admin2" "both"))
    6565        (begin (register-guest-user node-uri "guest1")
     
    8888                               '((@uri . "/test1") (my-tag . "something")))
    8989                 (put-document node-uri '("Another test for estraier")
    90                                '((@uri . "/test2") (my-tag . "whatever")))
     90                               '((@uri . "/test2") (my-tag . "foo") (my-other-tag . "whatever")))
    9191                 #t))
    9292  ;; If we don't sync, the newly added docs don't (always?) show up...
     
    164164          (document-uri->id node-uri "/test1")))
    165165
     166  (receive (results meta-data)
     167    (find-documents node-uri attr-phrases: '("my-tag STREQ foo"
     168                                             "my-other-tag STREQ whatever"))
     169    (test "Find-documents can search attributes"
     170          '(((#f . "Another test for estraier")))
     171          (map car results))
     172    (test-assert "Find-documents can search up to 10 attributes"
     173                 (find-documents node-uri
     174                                 attr-phrases: '("0" "1" "2" "3" "4" "5"
     175                                                 "6" "7" "8" "9")))
     176    (test-error "Find-documents cannot search more than 10 attributes"
     177                (find-documents node-uri
     178                                attr-phrases: '("0" "1" "2" "3" "4" "5"
     179                                                "6" "7" "8" "9" "10"))))
     180
    166181  (test "Deleted documents are not listed"
    167182        '("/test1")
Note: See TracChangeset for help on using the changeset viewer.