;;;; -*- mode:lisp;coding:utf-8 -*-
;;;;**************************************************************************
;;;;FILE: filter.lisp
;;;;LANGUAGE: Common-Lisp
;;;;SYSTEM: Common-Lisp
;;;;USER-INTERFACE: NONE
;;;;DESCRIPTION
;;;;
;;;; This package exports a grep I/O filter,
;;;; and a macro to build unix-like pipes, using
;;;; com.informatimago.clext.pipe.
;;;; Note com.informatimago.interactive.browser:{cat,more,less}
;;;; as any other expression reading *standard-input* and writing
;;;; *standard-output* can be used in a filter,
;;;;
;;;;AUTHORS
;;;; <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
;;;;MODIFICATIONS
;;;; 2015-10-10 <PJB> Created.
;;;;BUGS
;;;;LEGAL
;;;; AGPL3
;;;;
;;;; Copyright Pascal J. Bourguignon 2015 - 2016
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Affero General Public License as published by
;;;; the Free Software Foundation, either version 3 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program 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 Affero General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU Affero General Public License
;;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;;;**************************************************************************
(eval-when (:compile-toplevel :load-toplevel :execute)
(setf *readtable* (copy-readtable nil)))
(defpackage "COM.INFORMATIMAGO.CLEXT.FILTER"
(:use "COMMON-LISP"
"BORDEAUX-THREADS"
"CL-PPCRE"
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.STREAM"
"COM.INFORMATIMAGO.CLEXT.PIPE")
(:export "FILTER" "IN" "GREP" "OUT")
(:documentation "
This package exports a grep I/O filter,
and a macro to build unix-like pipes, using
com.informatimago.clext.pipe.
Note com.informatimago.interactive.browser:{cat,more,less}
as any other expression reading *standard-input* and writing
*standard-output* can be used in a filter,
LEGAL
Copyright Pascal J. Bourguignon 2015 - 2015
AGPL3
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Affero General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTYwithout even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU Affero General Public License for more details.
You should have received a copy of the GNU Affero General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
"))
(in-package "COM.INFORMATIMAGO.CLEXT.FILTER")
(defun in (pathname &key (external-format :default) (if-does-not-exist :error))
"
DO: Reads the text file at PATHNAME and writes it out
to *STANDARD-OUTPUT*.
EXTERNAL-FORMAT: The external-format for the file.
IF-DOES-NOT-EXIST: (or (member :ERROR :END-OF-FILE NIL) string stream)
If the file doesn't exist, by default an error is
signaled. Alternatives are:
:END-OF-FILE closes the stream bound to
*STANDARD-OUTPUT* Note: you probably should don't
do that on the system standard output.
NIL: do nothing.
a STRING: writes the string to *STANDARD-OUTPUT*.
a STREAM: copy the stream to *STANDARD-OUTPUT*.
SEE ALSO: COM.INFORMATIMAGO.COMMON-LISP.INTERACTIVE.BROWSER:CAT
"
(with-open-file (input pathname
:direction :input
:external-format external-format
:if-does-not-exist (if (eq :error if-does-not-exist)
:error
nil))
(if input
(copy-stream input *standard-output*)
(etypecase if-does-not-exist
(null #|do nothing|#)
(string (write-string if-does-not-exist *standard-output*))
(stream (copy-stream if-does-not-exist *standard-output*))))))
(defun out (pathname &key (external-format :default) (if-exists :error))
"
DO: Writes the data from *STANDARD-INPUT* into the
text file at PATHNAME.
EXTERNAL-FORMAT: The external-format for the file.
IF-EXISTS: same as for OPEN.
"
(with-open-file (output pathname
:direction :output
:external-format external-format
:if-does-not-exist :create
:if-exists if-exists)
(when output
(copy-stream *standard-input* output))))
(defun grep (regexp &key case-insensitive (extended t) count line-number filename)
(loop
:with filename := (typecase filename
((or string pathname) filename)
(null nil)
(t (if (typep *standard-input* 'file-stream)
(pathname *standard-input*)
(princ-to-string *standard-input*))))
:with scanner := (create-scanner regexp
:case-insensitive-mode case-insensitive
:single-line-mode t
:extended-mode extended
:destructive nil)
:with counter := 0
:for line := (read-line *standard-input* nil nil)
:for linum :from 1
:while line
:when (scan scanner line)
:do (if count
(incf counter)
(if line-number
(if filename
(format t "~A:~D:~A~%" filename linum line)
(format t "~D:~A~%" linum line))
(if filename
(format t "~A:~A~%" filename line)
(write-line line))))
:finally (when count
(format t "~D line~:*~P match~:[~;es~]~%"
counter (= 1 counter)))))
(defvar *buffer-size* 4000)
(defmacro filter (&body filter-forms)
(let* ((vpipe (gensym "pipe")))
;; *standard-input* a pipe b pipe c *standard-output* main thread.
;; - -
(if (rest filter-forms)
`(let ((,vpipe (make-pipe :buffer-size *buffer-size*)))
(bt:make-thread (lambda ()
(unwind-protect
(filter ,@(butlast filter-forms))
(close *standard-output*)))
:initial-bindings (list (cons '*standard-output* (pipe-output-stream ,vpipe))
(cons '*standard-input* *standard-input*)))
(let ((*standard-input* (pipe-input-stream ,vpipe)))
,@(last filter-forms)))
(first filter-forms))))
;; (pprint (macroexpand-1 '(filter (in "/etc/passwd") (out "/tmp/p"))))
;; (filter (in "/etc/passwd") (out "/tmp/p"))
;;;; THE END ;;;;