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