Re: [PATCH] bug in expansion of variables in babel Perl

[Achim Gratz <Stromeko@nexgo.de>]

[-- Attachment #1: Type: text/plain, Size: 556 bytes --]

D M German writes:
> I found a bug in the Babel perl code. When a table is used as input, the
> values of the table  are not escaped.

Here are two patches that fix this and implement (partly) some of your
suggestions.  I don't think Org should pollute the global Perl namespace
by default, so I've left the definition of org-babel-perl-preface to the
user for now.  The second patch has the debugging aid you've been
requesting, if you bind the symbol org-babel--debug-input to anything
the temporary input files won't be deleted after the code has run.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-ob-perl-modify-variable-definition-to-be-compatible-.patch --]
[-- Type: text/x-patch, Size: 3814 bytes --]

From 7a668942b58dc94994b11e6ec0751ec36b07b196 Mon Sep 17 00:00:00 2001
From: Achim Gratz <Stromeko@Stromeko.DE>
Date: Sun, 24 Feb 2013 13:28:50 +0100
Subject: [PATCH 1/2] ob-perl: modify variable definition to be compatible with
 strict and use non-interpolating quotes

* lisp/ob-perl.el (org-babel-variable-assignments:perl): Add "my" to
  variable declaration so that it becomes compatible with "use
  strict;".
* lisp/ob-perl.el (org-babel-perl-var-to-perl): Use Perl
  non-interpolating quoting on the string that defines the variable to
  suppress spurious interpretation of it as Perl syntax.
* lisp/ob-perl.el (org-babel-perl-wrapper-method): Use a block and
  declare all variables as "my", also use Perl quoting and the output
  record separator instead of a literal LF character.  Do away with
  the subroutine definition and use eval instead.
* lisp/ob-perl.el (org-babel-perl-preface): Content of this variable
  is prepended to body before invocation of perl.
* lisp/ob-perl.el (org-babel-perl-evaluate): Rename input parameter
  body to ibody and let-bind body to concatentation of
  org-babel-perl-preface and ibody.

Following a suggestion by Daniel M. German in
http://thread.gmane.org/gmane.emacs.orgmode/66855.
---
 lisp/ob-perl.el | 37 ++++++++++++++++++++-----------------
 1 file changed, 20 insertions(+), 17 deletions(-)

diff --git a/lisp/ob-perl.el b/lisp/ob-perl.el
index ccd3826..53f166e 100644
--- a/lisp/ob-perl.el
+++ b/lisp/ob-perl.el
@@ -62,7 +62,7 @@ (defun org-babel-variable-assignments:perl (params)
   "Return list of perl statements assigning the block's variables."
   (mapcar
    (lambda (pair)
-     (format "$%s=%s;"
+     (format "my $%s=%s;"
 	     (car pair)
 	     (org-babel-perl-var-to-perl (cdr pair))))
    (mapcar #'cdr (org-babel-get-header params :var))))
@@ -75,7 +75,7 @@ (defun org-babel-perl-var-to-perl (var)
 specifying a var of the same value."
   (if (listp var)
       (concat "[" (mapconcat #'org-babel-perl-var-to-perl var ", ") "]")
-    (format "%S" var)))
+    (format "q(%s)" var)))
 
 (defvar org-babel-perl-buffers '(:default . nil))
 
@@ -84,31 +84,34 @@ (defun org-babel-perl-initiate-session (&optional session params)
   nil)
 
 (defvar org-babel-perl-wrapper-method
-  "
-sub main {
+  "{
+  my @r = eval( q(
 %s
-}
-@r = main;
-open(o, \">%s\");
-print o join(\"\\n\", @r), \"\\n\"")
+              ));
+  open my $BO, qq(>%s) or die qq( Perl: Could not open output file.$\\ );
+  print $BO join($\\, @r), $\\ ;
+}")
+
+(defvar org-babel-perl-preface nil)
 
 (defvar org-babel-perl-pp-wrapper-method
   nil)
 
-(defun org-babel-perl-evaluate (session body &optional result-type)
+(defun org-babel-perl-evaluate (session ibody &optional result-type)
   "Pass BODY to the Perl process in SESSION.
 If RESULT-TYPE equals 'output then return a list of the outputs
 of the statements in BODY, if RESULT-TYPE equals 'value then
 return the value of the last statement in BODY, as elisp."
   (when session (error "Sessions are not supported for Perl"))
-  (case result-type
-    (output (org-babel-eval org-babel-perl-command body))
-    (value (let ((tmp-file (org-babel-temp-file "perl-")))
-	     (org-babel-eval
-	      org-babel-perl-command
-	      (format org-babel-perl-wrapper-method body
-		      (org-babel-process-file-name tmp-file 'noquote)))
-	     (org-babel-eval-read-file tmp-file)))))
+  (let ((body (concat org-babel-perl-preface ibody)))
+    (case result-type
+      (output (org-babel-eval org-babel-perl-command body))
+      (value (let ((tmp-file (org-babel-temp-file "perl-")))
+	       (org-babel-eval
+		org-babel-perl-command
+		(format org-babel-perl-wrapper-method body
+			(org-babel-process-file-name tmp-file 'noquote)))
+	       (org-babel-eval-read-file tmp-file))))))
 
 (provide 'ob-perl)
 
-- 
1.8.1.4


[-- Attachment #3: 0002-ob-eval-make-org-babel-shell-command-on-region-inter.patch --]
[-- Type: text/x-patch, Size: 10487 bytes --]

From 6827b07c0e8a03eea11d86ea714c8f10fb05b43d Mon Sep 17 00:00:00 2001
From: Achim Gratz <Stromeko@Stromeko.DE>
Date: Sun, 24 Feb 2013 17:15:36 +0100
Subject: [PATCH 2/2] ob-eval: make org-babel--shell-command-on-region internal
 and simplify
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* lisp/ob-eval.el (org-babel-eval): Use simplified version of
  `org-babel--shell-command-on-region´, we are the only caller of this
  function.
* lisp/ob-eval.el (org-babel--shell-command-on-region): Replace
  `org-babel-shell-command-on-region´ with a much more simplified
  internal version, remove superfluous DOCSTRING and interactive
  clause, strip out all conditionals which were never used.  Prevent
  deletion of temporary input file to aid debugging when the symbol
  `org-babel--debug-input´ is bound and has non-nil value.
---
 lisp/ob-eval.el | 195 +++++++++-----------------------------------------------
 1 file changed, 30 insertions(+), 165 deletions(-)

diff --git a/lisp/ob-eval.el b/lisp/ob-eval.el
index 22d2bcf..681362f 100644
--- a/lisp/ob-eval.el
+++ b/lisp/ob-eval.el
@@ -50,8 +50,8 @@ (defun org-babel-eval (cmd body)
     (with-temp-buffer
       (insert body)
       (setq exit-code
-	    (org-babel-shell-command-on-region
-	     (point-min) (point-max) cmd t 'replace err-buff))
+	    (org-babel--shell-command-on-region
+	     (point-min) (point-max) cmd err-buff))
       (if (or (not (numberp exit-code)) (> exit-code 0))
 	  (progn
 	    (with-current-buffer err-buff
@@ -64,79 +64,15 @@ (defun org-babel-eval-read-file (file)
   (with-temp-buffer (insert-file-contents file)
 		    (buffer-string)))
 
-(defun org-babel-shell-command-on-region (start end command
-						&optional output-buffer replace
-						error-buffer display-error-buffer)
+(defun org-babel--shell-command-on-region (start end command error-buffer)
   "Execute COMMAND in an inferior shell with region as input.
 
-Fixes bugs in the emacs 23.1.1 version of `shell-command-on-region'
-
-Normally display output (if any) in temp buffer `*Shell Command Output*';
-Prefix arg means replace the region with it.  Return the exit code of
-COMMAND.
-
-To specify a coding system for converting non-ASCII characters in
-the input and output to the shell command, use
-\\[universal-coding-system-argument] before this command.  By
-default, the input (from the current buffer) is encoded in the
-same coding system that will be used to save the file,
-`buffer-file-coding-system'.  If the output is going to replace
-the region, then it is decoded from that same coding system.
-
-The noninteractive arguments are START, END, COMMAND,
-OUTPUT-BUFFER, REPLACE, ERROR-BUFFER, and DISPLAY-ERROR-BUFFER.
-Noninteractive callers can specify coding systems by binding
-`coding-system-for-read' and `coding-system-for-write'.
-
-If the command generates output, the output may be displayed
-in the echo area or in a buffer.
-If the output is short enough to display in the echo area
-\(determined by the variable `max-mini-window-height' if
-`resize-mini-windows' is non-nil), it is shown there.  Otherwise
-it is displayed in the buffer `*Shell Command Output*'.  The output
-is available in that buffer in both cases.
-
-If there is output and an error, a message about the error
-appears at the end of the output.
-
-If there is no output, or if output is inserted in the current buffer,
-then `*Shell Command Output*' is deleted.
-
-If the optional fourth argument OUTPUT-BUFFER is non-nil,
-that says to put the output in some other buffer.
-If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
-If OUTPUT-BUFFER is not a buffer and not nil,
-insert output in the current buffer.
-In either case, the output is inserted after point (leaving mark after it).
-
-If REPLACE, the optional fifth argument, is non-nil, that means insert
-the output in place of text from START to END, putting point and mark
-around it.
-
-If optional sixth argument ERROR-BUFFER is non-nil, it is a buffer
-or buffer name to which to direct the command's standard error output.
-If it is nil, error output is mingled with regular output.
-If DISPLAY-ERROR-BUFFER is non-nil, display the error buffer if there
-were any errors.  (This is always t, interactively.)
-In an interactive call, the variable `shell-command-default-error-buffer'
-specifies the value of ERROR-BUFFER."
-  (interactive (let (string)
-		 (unless (mark)
-		   (error "The mark is not set now, so there is no region"))
-		 ;; Do this before calling region-beginning
-		 ;; and region-end, in case subprocess output
-		 ;; relocates them while we are in the minibuffer.
-		 (setq string (read-shell-command "Shell command on region: "))
-		 ;; call-interactively recognizes region-beginning and
-		 ;; region-end specially, leaving them in the history.
-		 (list (region-beginning) (region-end)
-		       string
-		       current-prefix-arg
-		       current-prefix-arg
-		       shell-command-default-error-buffer
-		       t)))
-  (let ((input-file (org-babel-temp-file "input-"))
-	(error-file (if error-buffer (org-babel-temp-file "scor-") nil))
+Stripped down version of shell-command-on-region for internal use
+in Babel only.  This lets us work around errors in the original
+function in various versions of Emacs.
+"
+  (let ((input-file (org-babel-temp-file "ob-input-"))
+	(error-file (if error-buffer (org-babel-temp-file "ob-error-") nil))
 	;; Unfortunately, `executable-find' does not support file name
 	;; handlers.  Therefore, we could use it in the local case
 	;; only.
@@ -154,96 +90,26 @@ (defun org-babel-shell-command-on-region (start end command
     ;; workaround for now.
     (unless (file-remote-p default-directory)
       (delete-file error-file))
-    (if (or replace
-	    (and output-buffer
-		 (not (or (bufferp output-buffer) (stringp output-buffer)))))
-	;; Replace specified region with output from command.
-	(let ((swap (and replace (< start end))))
-	  ;; Don't muck with mark unless REPLACE says we should.
-	  (goto-char start)
-	  (and replace (push-mark (point) 'nomsg))
-	  (write-region start end input-file)
-	  (delete-region start end)
-	  (setq exit-status
-		(process-file shell-file-name input-file
-			      (if error-file
-				  (list output-buffer error-file)
-				t)
-			      nil shell-command-switch command))
-	  ;; It is rude to delete a buffer which the command is not using.
-	  ;; (let ((shell-buffer (get-buffer "*Shell Command Output*")))
-	  ;;   (and shell-buffer (not (eq shell-buffer (current-buffer)))
-	  ;; 	 (kill-buffer shell-buffer)))
-	  ;; Don't muck with mark unless REPLACE says we should.
-	  (and replace swap (exchange-point-and-mark)))
-      ;; No prefix argument: put the output in a temp buffer,
-      ;; replacing its entire contents.
-      (let ((buffer (get-buffer-create
-		     (or output-buffer "*Shell Command Output*"))))
-	(unwind-protect
-	    (if (eq buffer (current-buffer))
-		;; If the input is the same buffer as the output,
-		;; delete everything but the specified region,
-		;; then replace that region with the output.
-		(progn (setq buffer-read-only nil)
-		       (delete-region (max start end) (point-max))
-		       (delete-region (point-min) (min start end))
-		       (write-region (point-min) (point-max) input-file)
-		       (delete-region (point-min) (point-max))
-		       (setq exit-status
-			     (process-file shell-file-name input-file
-					   (if error-file
-					       (list t error-file)
-					     t)
-					   nil shell-command-switch command)))
-	      ;; Clear the output buffer, then run the command with
-	      ;; output there.
-	      (let ((directory default-directory))
-		(with-current-buffer buffer
-		  (setq buffer-read-only nil)
-		  (if (not output-buffer)
-		      (setq default-directory directory))
-		  (erase-buffer)))
-	      (setq exit-status
-		    (process-file shell-file-name nil
-				  (if error-file
-				      (list buffer error-file)
-				    buffer)
-				  nil shell-command-switch command)))
-	  ;; Report the output.
-	  (with-current-buffer buffer
-	    (setq mode-line-process
-		  (cond ((null exit-status)
-			 " - Error")
-			((stringp exit-status)
-			 (format " - Signal [%s]" exit-status))
-			((not (equal 0 exit-status))
-			 (format " - Exit [%d]" exit-status)))))
-	  (if (with-current-buffer buffer (> (point-max) (point-min)))
-	      ;; There's some output, display it
-	      (display-message-or-buffer buffer)
-	    ;; No output; error?
-	    (let ((output
-		   (if (and error-file
-			    (< 0 (nth 7 (file-attributes error-file))))
-		       "some error output"
-		     "no output")))
-	      (cond ((null exit-status)
-		     (message "(Shell command failed with error)"))
-		    ((equal 0 exit-status)
-		     (message "(Shell command succeeded with %s)"
-			      output))
-		    ((stringp exit-status)
-		     (message "(Shell command killed by signal %s)"
-			      exit-status))
-		    (t
-		     (message "(Shell command failed with code %d and %s)"
-			      exit-status output))))
-	    ;; Don't kill: there might be useful info in the undo-log.
-	    ;; (kill-buffer buffer)
-	    ))))
-
-    (when (and input-file (file-exists-p input-file))
+    ;; we always call this with 'replace, remove conditional
+    ;; Replace specified region with output from command.
+    (let ((swap (< start end)))
+      (goto-char start)
+      (push-mark (point) 'nomsg)
+      (write-region start end input-file)
+      (delete-region start end)
+      (setq exit-status
+	    (process-file shell-file-name input-file
+			  (if error-file
+			      (list t error-file)
+			    t)
+			  nil shell-command-switch command))
+      (when swap (exchange-point-and-mark)))
+
+    (when (and input-file (file-exists-p input-file)
+	       ;; bind org-babel--debug-input around the call to keep
+	       ;; the temporary input files available for inspection
+	       (not (when (boundp 'org-babel--debug-input)
+		      org-babel--debug-input)))
       (delete-file input-file))
 
     (when (and error-file (file-exists-p error-file))
@@ -258,8 +124,7 @@ (defun org-babel-shell-command-on-region (start end command
 	      (format-insert-file error-file nil)
 	      ;; Put point after the inserted errors.
 	      (goto-char (- (point-max) pos-from-end)))
-	    (and display-error-buffer
-		 (display-buffer (current-buffer)))))
+	    (current-buffer)))
       (delete-file error-file))
     exit-status))
 
-- 
1.8.1.4


[-- Attachment #4: Type: text/plain, Size: 558 bytes --]


Please reply to the list whether this works for you so when Eric sees
this he can decide if he wants to apply them.

Eric, the input file seems to be missing the final newline, probably
because the original region didn't include it.  This can be a problem
with some programs, is this intended to be left off or should we add
one (generally or just for some languages)?


Regards,
Achim.
-- 
+<[Q+ Matrix-12 WAVE#46+305 Neuron microQkb Andromeda XTk Blofeld]>+

SD adaptation for Waldorf microQ V2.22R2:
http://Synth.Stromeko.net/Downloads.html#WaldorfSDada