diff --git a/lisp/ob-perl.el b/lisp/ob-perl.el index e449fbef5..8bc84f0b1 100644 --- a/lisp/ob-perl.el +++ b/lisp/ob-perl.el @@ -48,7 +48,7 @@ This function is called by `org-babel-execute-src-block'." body params (org-babel-variable-assignments:perl params))) (session (org-babel-perl-initiate-session session))) (org-babel-reassemble-table - (org-babel-perl-evaluate session full-body result-type) + (org-babel-perl-evaluate session full-body result-type result-params) (org-babel-pick-name (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) (org-babel-pick-name @@ -62,9 +62,7 @@ This function is called by `org-babel-execute-src-block'." "Return list of perl statements assigning the block's variables." (mapcar (lambda (pair) - (format "$%s=%s;" - (car pair) - (org-babel-perl-var-to-perl (cdr pair)))) + (org-babel-perl--var-to-perl (cdr pair) (car pair))) (mapcar #'cdr (org-babel-get-header params :var)))) ;; helper functions @@ -72,13 +70,25 @@ This function is called by `org-babel-execute-src-block'." (defvar org-babel-perl-var-wrap "q(%s)" "Wrapper for variables inserted into Perl code.") -(defun org-babel-perl-var-to-perl (var) +(defvar org-babel-perl--lvl) +(defun org-babel-perl--var-to-perl (var &optional varn) "Convert an elisp value to a perl variable. The elisp value, VAR, is converted to a string of perl source code specifying a var of the same value." - (if (listp var) - (concat "[" (mapconcat #'org-babel-perl-var-to-perl var ", ") "]") - (format org-babel-perl-var-wrap var))) + (if varn + (let ((org-babel-perl--lvl 0) (lvar (listp var)) prefix) + (concat "my $" (symbol-name varn) "=" (when lvar "\n") + (org-babel-perl--var-to-perl var) + ";\n")) + (let ((prefix (make-string (* 2 org-babel-perl--lvl) ?\ ))) + (concat prefix + (if (listp var) + (let ((org-babel-perl--lvl (1+ org-babel-perl--lvl))) + (concat "[\n" + (mapconcat #'org-babel-perl--var-to-perl var "") + prefix "]")) + (concat "q(" (princ var) ")")) + (unless (zerop org-babel-perl--lvl) ",\n"))))) (defvar org-babel-perl-buffers '(:default . nil)) @@ -86,32 +96,53 @@ specifying a var of the same value." "Return nil because sessions are not supported by perl." nil) -(defvar org-babel-perl-wrapper-method - " -sub main { -%s -} -@r = main; -open(o, \">%s\"); -print o join(\"\\n\", @r), \"\\n\"") +(defvar org-babel-perl-wrapper-method "{ + my $babel_sub = sub { + %s + }; + open my $BOH, qq(>%s) or die qq(Perl: Could not open output file.$/); + select $BOH; + my $rv = &$babel_sub(); + my $rt = ref $rv; + if (qq(ARRAY) eq $rt) { + local $\\=$/; + foreach my $rv ( @$rv ) { + my $rt = ref $rv; + if (qq(ARRAY) eq $rt) { + print join q(|), @$rv; + } else { + print $rv; + } + } + } else { + print $rv; + } +}") + +(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 result-params) "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-result-cond result-params + (with-temp-buffer + (insert-file-contents tmp-file) + (buffer-string)) + (org-babel-import-elisp-from-file tmp-file '(16)))))))) (provide 'ob-perl)