ob-perl.el 5.15 KB
Newer Older
Rasmus's avatar
Rasmus committed
1
;;; ob-perl.el --- Babel Functions for Perl          -*- lexical-binding: t; -*-
2

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
4

5 6
;; Authors: Dan Davison
;;	 Eric Schulte
7
;; Keywords: literate programming, reproducible research
Rasmus's avatar
Rasmus committed
8
;; Homepage: https://orgmode.org
9 10 11 12 13 14 15 16 17 18 19 20 21 22

;; This file is part of GNU Emacs.

;; GNU Emacs 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.

;; GNU Emacs 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
23
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
24 25 26 27 28 29 30 31

;;; Commentary:

;; Org-Babel support for evaluating perl source code.

;;; Code:
(require 'ob)

32
(defvar org-babel-tangle-lang-exts)
33 34 35 36 37 38 39 40 41 42
(add-to-list 'org-babel-tangle-lang-exts '("perl" . "pl"))

(defvar org-babel-default-header-args:perl '())

(defvar org-babel-perl-command "perl"
  "Name of command to use for executing perl code.")

(defun org-babel-execute:perl (body params)
  "Execute a block of Perl code with Babel.
This function is called by `org-babel-execute-src-block'."
Rasmus's avatar
Rasmus committed
43 44 45
  (let* ((session (cdr (assq :session params)))
         (result-params (cdr (assq :result-params params)))
         (result-type (cdr (assq :result-type params)))
46 47
         (full-body (org-babel-expand-body:generic
		     body params (org-babel-variable-assignments:perl params)))
48
	 (session (org-babel-perl-initiate-session session)))
49
    (org-babel-reassemble-table
Bastien Guerry's avatar
Bastien Guerry committed
50
     (org-babel-perl-evaluate session full-body result-type result-params)
51
     (org-babel-pick-name
Rasmus's avatar
Rasmus committed
52
      (cdr (assq :colname-names params)) (cdr (assq :colnames params)))
53
     (org-babel-pick-name
Rasmus's avatar
Rasmus committed
54
      (cdr (assq :rowname-names params)) (cdr (assq :rownames params))))))
55

Rasmus's avatar
Rasmus committed
56
(defun org-babel-prep-session:perl (_session _params)
57
  "Prepare SESSION according to the header arguments in PARAMS."
58
  (error "Sessions are not supported for Perl"))
59

60
(defun org-babel-variable-assignments:perl (params)
61
  "Return list of perl statements assigning the block's variables."
62 63
  (mapcar
   (lambda (pair)
Bastien Guerry's avatar
Bastien Guerry committed
64
     (org-babel-perl--var-to-perl (cdr pair) (car pair)))
Rasmus's avatar
Rasmus committed
65
   (org-babel--get-vars params)))
66

67 68
;; helper functions

Bastien Guerry's avatar
Bastien Guerry committed
69 70 71 72 73
(defvar org-babel-perl-var-wrap "q(%s)"
  "Wrapper for variables inserted into Perl code.")

(defvar org-babel-perl--lvl)
(defun org-babel-perl--var-to-perl (var &optional varn)
74 75 76
  "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."
Bastien Guerry's avatar
Bastien Guerry committed
77
  (if varn
Rasmus's avatar
Rasmus committed
78
      (let ((org-babel-perl--lvl 0) (lvar (listp var)))
Bastien Guerry's avatar
Bastien Guerry committed
79 80 81 82 83 84 85 86 87 88 89 90
	(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 "]"))
		(format "q(%s)" var))
	      (unless (zerop org-babel-perl--lvl) ",\n")))))
91 92 93

(defvar org-babel-perl-buffers '(:default . nil))

Rasmus's avatar
Rasmus committed
94
(defun org-babel-perl-initiate-session (&optional _session _params)
95 96
  "Return nil because sessions are not supported by perl."
  nil)
97

Bastien Guerry's avatar
Bastien Guerry committed
98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122
(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.$/);
    my $rv = &$babel_sub();
    my $rt = ref $rv;
    select $BOH;
    if (qq(ARRAY) eq $rt) {
        local $\\=$/;
        local $,=qq(\t);
	foreach my $rv ( @$rv ) {
	    my $rt = ref $rv;
	    if (qq(ARRAY) eq $rt) {
		print @$rv;
	    } else {
		print $rv;
	    }
	}
    } else {
	print $rv;
    }
}")

(defvar org-babel-perl-preface nil)
123 124 125 126

(defvar org-babel-perl-pp-wrapper-method
  nil)

Bastien Guerry's avatar
Bastien Guerry committed
127
(defun org-babel-perl-evaluate (session ibody &optional result-type result-params)
128
  "Pass BODY to the Perl process in SESSION.
Rasmus's avatar
Rasmus committed
129 130
If RESULT-TYPE equals `output' then return a list of the outputs
of the statements in BODY, if RESULT-TYPE equals `value' then
131
return the value of the last statement in BODY, as elisp."
132
  (when session (error "Sessions are not supported for Perl"))
Bastien Guerry's avatar
Bastien Guerry committed
133 134 135 136
  (let* ((body (concat org-babel-perl-preface ibody))
	 (tmp-file (org-babel-temp-file "perl-"))
	 (tmp-babel-file (org-babel-process-file-name
			  tmp-file 'noquote)))
137
    (let ((results
Rasmus's avatar
Rasmus committed
138 139
           (pcase result-type
             (`output
140 141 142 143
              (with-temp-file tmp-file
                (insert
                 (org-babel-eval org-babel-perl-command body))
                (buffer-string)))
Rasmus's avatar
Rasmus committed
144
             (`value
145 146 147 148 149 150 151
              (org-babel-eval org-babel-perl-command
                              (format org-babel-perl-wrapper-method
                                      body tmp-babel-file))))))
      (when results
        (org-babel-result-cond result-params
	  (org-babel-eval-read-file tmp-file)
          (org-babel-import-elisp-from-file tmp-file '(16)))))))
152 153 154

(provide 'ob-perl)

155

156 157

;;; ob-perl.el ends here