From: Jeremy Whetzel
Subject: executing shell commands with CLISP?
Date: 
Message-ID: <87k7ww4sw7.fsf@toadmail.com>
I was wondering if it's possible to execute shell commands (and even get
the output) using clisp.  I'm wanting to create a front end to a couple
of mp3 programs (encoders, players, etc.), and this is something that I
normall do as a "first project" when I learn new languages.  I've looked
around at the tutorials at www.alu.org, and I hadn't found anything
there that points it out without using external modules or macros or
something.  (wow... sorry for butchering the terminology =0))

Thanks,
Jeremy
From: ········@acm.org
Subject: Re: executing shell commands with CLISP?
Date: 
Message-ID: <IjHH7.3418$cG3.617385@news20.bellglobal.com>
Jeremy Whetzel <·····@toadmail.com> writes:
> I was wondering if it's possible to execute shell commands (and even get
> the output) using clisp.  I'm wanting to create a front end to a couple
> of mp3 programs (encoders, players, etc.), and this is something that I
> normall do as a "first project" when I learn new languages.  I've looked
> around at the tutorials at www.alu.org, and I hadn't found anything
> there that points it out without using external modules or macros or
> something.  (wow... sorry for butchering the terminology =0))

Does the following qualify, maybehaps?

(defparameter *SOUNDNAMES*
  '("card_shuffle" "email" "error" "info" "login" "logout" "phone" "question"))

(defun play-sound (soundname)
  (if (member soundname *SOUNDNAMES* :test #'equal)
      (common-lisp-user::run-shell-command
       (concatenate 'string
		    "/usr/bin/mpg123 "
		    "/usr/share/sounds/"
		    soundname ".mp3"))
    (format t "Error: Sound ~S not found in *SOUNDNAMES*~%" soundname)))

This doesn't demonstrate the notion of grabbing the output; the bit of
code below demonstrates that in parsing SQL output...

;;; $Id: sqlquery.lisp,v 1.2 2001/08/04 02:03:22 cbbrowne Exp $
(DEFPACKAGE "SQL"
  (:USE "COMMON-LISP")
  (:EXPORT
   "DAILY-QUERY" "SET-UP-QUERY"
   "PROCESS-SQL-QUERY" "LOOKUP-FIELD"))

(IN-PACKAGE "SQL")

(defun daily-query (date)
  (concatenate 'string
	       "select transactions.security, securities.name, "
	       "round(prices.price * transactions.shares, 2) as value, "
	       "round(transactions.cost, 2) as cost, "
	       "round(prices.price * transactions.shares, 2) - "
	       "round(transactions.cost, 2) as profit "
	       "from securities, prices, transactions "
	       "where securities.security = transactions.security and "
	       "securities.security = prices.security and "
	       "prices.as_at = '"
	       date
	       "' "
	       "order by transactions.security;"))

(defun name-temp-file ()
  (let ((rval (random 250))
	(now (get-universal-time)))
    (format nil "sql-~D.~D" now rval)))

(defun build-query-command-name (rfilename)
  (concatenate 'string
	       "/usr/bin/psql -A < /tmp/" rfilename))
    
(defun set-up-query (query)
  (let* ((tmpfilename (name-temp-file))
	 (command (build-query-command-name tmpfilename))
	 (querypath (make-pathname :directory '(:absolute "tmp")
				   :name tmpfilename))
	 (result nil))
    (with-open-file
     (s querypath :direction :output)
     (format s "~A~%" query))
    (with-open-stream
     (st (lisp:run-shell-command command :output :stream))
     (setf result 
	   (process-sql-query st)))
    (delete-file querypath)
    result))

(defun process-sql-query (stream)
  (let ((headers nil)
	(rows '())
	(first-line (read-line stream nil nil)))
    (setf headers (split-on-bar first-line))
    (loop for line = (read-line stream nil nil)
      while line
      do
      (if line
	  (setf rows (cons (split-on-bar line) rows))))
    (list headers (cdr rows))))

(defun split-on-bar (rawline)
  (let ((result nil))
    (loop
      with line = (concatenate 'string rawline "|")
      with length = (length line)
      and pos = 0
      for nextbar = (search "|" line :start2 pos)
      while nextbar
      for element = (subseq line pos nextbar)
      collect element into result-list
      do
      (setf pos (+ 1 nextbar))
      finally (loop
		with results = result-list
		with array = (setf result (make-array
					   (list (length results))))
		for i = 0 then (incf i)
		for value in results
		do (setf (aref result i) value)
		finally array))
    result))

(defun lookup-field (field header record)
  (let ((pos (position field header :test 'equal)))
    (aref record pos)))

(defun open-sql-connection ()
  (lisp:run-shell-command "/usr/bin/psql" :input :stream))

(defun begin-transaction (connection)
  (format connection "begin work;~%"))

(defun commit-transaction (connection)
  (format connection "commit work;~%"))

(defun profit-report ()
  (let ((query (set-up-query (daily-query "2001-04-01")))
	(total-cost 0)
	(total-profit 0))
    (format t ···@A ~24A ···@A ···@A~%"
	    "Symbol" "Name" "Cost" "Profit")
    (format t ···@A ~24A ~14A ~14A~%"
	    "-------" "------------------------" "--------------"
	     "--------------")
    (dolist 
	(s (reverse (car (cdr query))))
      (let ((security (string-trim '(#\space)
				   (lookup-field "security" (car query) s)))
	    (name (string-trim '(#\space)
			       (lookup-field "name" (car query) s)))
	    (cost 
	     (stockquotes::read-number-from-string
	     (lookup-field "cost" (car query) s)))
	    (profit (stockquotes::read-number-from-string
	     (lookup-field "profit" (car query) s))))
	(format t ···@A ~24A ~14,2F ~14,2F~%" 
		security name cost profit)
	(incf total-cost cost)
	(incf total-profit profit)))
    (format t ···@A ~24A ~14A ~14A~%"
	    "-------" "------------------------" "--------------"
	     "--------------")
    (format t ···@A ~24A ~14,2F ~14,2F~%" 
	    "Total" "" total-cost total-profit)
    (format t ···@A ~24A ~14A ~14A~%"
	    "=======" "========================" "=============="
	     "==============")))

-- 
(concatenate 'string "chris" ·@cbbrowne.com")
http://www.cbbrowne.com/info/spreadsheets.html
"You can swear at the keyboard  and it won't be offended. It was going
to treat you badly anyway" -- Arthur Norman