-(use-modules (rnrs)
- (system foreign))
+;; Copyright (C) 2015
+;; "Mu Lei" known as "NalaGinrut" <NalaGinrut@gmail.com>
+;; This file 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 3 of the License, or
+;; (at your option) any later version.
+
+;; This file 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 this program. If not, see <http://www.gnu.org/licenses/>.
+
+(library (pcre)
+ (export new-pcre
+ pcre-match
+ pcre-get-substring
+ pcre-search)
+ (import (guile) (rnrs) (system foreign)))
(define (make-blob-pointer len)
(bytevector->pointer (make-bytevector len)))
(dynamic-func "pcre_get_substring" pcre-ffi)
(list '* '* int int '*)))
-(define %pcre-free-study
+(define %pcre-free
(pointer->procedure void
- (dynamic-func "pcre_free_study" pcre-ffi)
+ (dynamic-func "pcre_free" pcre-ffi)
(list '*)))
+
+(define %pcre-free-study (dynamic-func "pcre_free_study" pcre-ffi))
-(define %pcre-free-substring
- (pointer->procedure void
- (dynamic-func "pcre_free_substring" pcre-ffi)
- (list '*)))
+(define %pcre-free-substring (dynamic-func "pcre_free_substring" pcre-ffi))
(define-record-type pcre
(fields
(erroffset (make-blob-pointer int))
(tableptr %null-pointer)
(pcre (%new-pcre)))
- ;; FIXME: add exceptional handling
- (pcre-code-set! pcre
- (%pcre-compile reptr options (pcre-errptr pcre)
- erroffset tableptr))
+ ;; FIXME: add exception handling
+ (pcre-code-set! pcre (%pcre-compile reptr options (pcre-errptr pcre)
+ erroffset tableptr))
+ ;;(set-pointer-finalizer! (pcre-code pcre) %pcre-free)
pcre))
(define* (pcre-match pcre str #:key (study-options 0) (exec-options 0)
ovecsize))
(pcre-ovector-set! pcre ovector)
(pcre-strptr-set! pcre strptr)
- (%pcre-free-study extra)
+ (set-pointer-finalizer! extra %pcre-free-study)
pcre))
(define (pcre-get-substring pcre index)
(buf (make-blob-pointer uint64)))
(%pcre-get-substring strptr ovector matched index buf)
(let ((ret (pointer->string (dereference-pointer buf))))
- (%pcre-free-substring (dereference-pointer buf))
+ (set-pointer-finalizer! (dereference-pointer buf) %pcre-free-substring)
ret)))
(define* (pcre-search pcre str #:key (study-options 0) (exec-options 0)
- (trim string-trim-both))
+ (exclude " "))
+ (define (trim s)
+ (string-trim-both s (lambda (x) (string-contains exclude (string x)))))
(define len (string-length str))
(let lp((i 0) (ret '()))
(cond
- ((>= i len) (reverse ret))
+ ((>= i len) (and ret (reverse ret)))
(else
(pcre-match pcre str #:study-options study-options #:exec-options exec-options #:offset i)
- (let* ((sub (pcre-get-substring pcre 0))
- (sublen (string-length sub)))
- (lp (+ i sublen) (cons (trim sub) ret)))))))
+ (if (<= (pcre-matched pcre) 0)
+ (lp len #f)
+ (let ((hit (trim (pcre-get-substring pcre 1)))
+ (sublen (string-length (pcre-get-substring pcre 0))))
+ (lp (+ i sublen) (cons hit ret))))))))
+
+(define (pcre-free pcre)
+ (and (not (null-pointer? (pcre-code pcre)))
+ (%pcre-free (pcre-code pcre))))