mirror of https://github.com/Chizi123/.emacs.d.git
view | history | commit | commitdiff
Chizi123
2018-11-18 76bbd07de7add0f9d13c6914f158d19630fe2f62
commit | author | age
76bbd0 1 ;;; ob-perl.el --- Babel Functions for Perl          -*- lexical-binding: t; -*-
C 2
3 ;; Copyright (C) 2009-2018 Free Software Foundation, Inc.
4
5 ;; Authors: Dan Davison
6 ;;     Eric Schulte
7 ;; Keywords: literate programming, reproducible research
8 ;; Homepage: https://orgmode.org
9
10 ;; This file is part of GNU Emacs.
11
12 ;; GNU Emacs is free software: you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation, either version 3 of the License, or
15 ;; (at your option) any later version.
16
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
20 ;; GNU General Public License for more details.
21
22 ;; 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 ;;; Commentary:
26
27 ;; Org-Babel support for evaluating perl source code.
28
29 ;;; Code:
30 (require 'ob)
31
32 (defvar org-babel-tangle-lang-exts)
33 (add-to-list 'org-babel-tangle-lang-exts '("perl" . "pl"))
34
35 (defvar org-babel-default-header-args:perl '())
36
37 (defvar org-babel-perl-command "perl"
38   "Name of command to use for executing perl code.")
39
40 (defun org-babel-execute:perl (body params)
41   "Execute a block of Perl code with Babel.
42 This function is called by `org-babel-execute-src-block'."
43   (let* ((session (cdr (assq :session params)))
44          (result-params (cdr (assq :result-params params)))
45          (result-type (cdr (assq :result-type params)))
46          (full-body (org-babel-expand-body:generic
47              body params (org-babel-variable-assignments:perl params)))
48      (session (org-babel-perl-initiate-session session)))
49     (org-babel-reassemble-table
50      (org-babel-perl-evaluate session full-body result-type result-params)
51      (org-babel-pick-name
52       (cdr (assq :colname-names params)) (cdr (assq :colnames params)))
53      (org-babel-pick-name
54       (cdr (assq :rowname-names params)) (cdr (assq :rownames params))))))
55
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   (mapcar
63    (lambda (pair)
64      (org-babel-perl--var-to-perl (cdr pair) (car pair)))
65    (org-babel--get-vars params)))
66
67 ;; helper functions
68
69 (defvar org-babel-perl-var-wrap "q(%s)"
70   "Wrapper for variables inserted into Perl code.")
71
72 (defvar org-babel-perl--lvl)
73 (defun org-babel-perl--var-to-perl (var &optional varn)
74   "Convert an elisp value to a perl variable.
75 The elisp value, VAR, is converted to a string of perl source code
76 specifying a var of the same value."
77   (if varn
78       (let ((org-babel-perl--lvl 0) (lvar (listp var)))
79     (concat "my $" (symbol-name varn) "=" (when lvar "\n")
80         (org-babel-perl--var-to-perl var)
81         ";\n"))
82     (let ((prefix (make-string (* 2 org-babel-perl--lvl) ?\ )))
83       (concat prefix
84           (if (listp var)
85           (let ((org-babel-perl--lvl (1+ org-babel-perl--lvl)))
86             (concat "[\n"
87                 (mapconcat #'org-babel-perl--var-to-perl var "")
88                 prefix "]"))
89         (format "q(%s)" var))
90           (unless (zerop org-babel-perl--lvl) ",\n")))))
91
92 (defvar org-babel-perl-buffers '(:default . nil))
93
94 (defun org-babel-perl-initiate-session (&optional _session _params)
95   "Return nil because sessions are not supported by perl."
96   nil)
97
98 (defvar org-babel-perl-wrapper-method "{
99     my $babel_sub = sub {
100         %s
101     };
102     open my $BOH, qq(>%s) or die qq(Perl: Could not open output file.$/);
103     my $rv = &$babel_sub();
104     my $rt = ref $rv;
105     select $BOH;
106     if (qq(ARRAY) eq $rt) {
107         local $\\=$/;
108         local $,=qq(\t);
109     foreach my $rv ( @$rv ) {
110         my $rt = ref $rv;
111         if (qq(ARRAY) eq $rt) {
112         print @$rv;
113         } else {
114         print $rv;
115         }
116     }
117     } else {
118     print $rv;
119     }
120 }")
121
122 (defvar org-babel-perl-preface nil)
123
124 (defvar org-babel-perl-pp-wrapper-method
125   nil)
126
127 (defun org-babel-perl-evaluate (session ibody &optional result-type result-params)
128   "Pass BODY to the Perl process in SESSION.
129 If RESULT-TYPE equals `output' then return a list of the outputs
130 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"))
133   (let* ((body (concat org-babel-perl-preface ibody))
134      (tmp-file (org-babel-temp-file "perl-"))
135      (tmp-babel-file (org-babel-process-file-name
136               tmp-file 'noquote)))
137     (let ((results
138            (pcase result-type
139              (`output
140               (with-temp-file tmp-file
141                 (insert
142                  (org-babel-eval org-babel-perl-command body))
143                 (buffer-string)))
144              (`value
145               (org-babel-eval org-babel-perl-command
146                               (format org-babel-perl-wrapper-method
147                                       body tmp-babel-file))))))
148       (when results
149         (org-babel-result-cond result-params
150       (org-babel-eval-read-file tmp-file)
151           (org-babel-import-elisp-from-file tmp-file '(16)))))))
152
153 (provide 'ob-perl)
154
155
156
157 ;;; ob-perl.el ends here