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

[D M German]

 dmg> Mm, I also noticed that when :results output is used, there is no way
 dmg> to insert perl code before or after the executed code.
 dmg> org-babel-perl-wrapper-method only works for all the methods but
 dmg> output. It would be nice to have a variable that
 dmg> does this for any output type.

I implemented a proof-of-concept. The idea is to have a variable called
org-babel-perl-preface that is inserted before the code. I also like to
be able to use my in all variables, so I can use strict, if I choose
to. See the patch at the bottom. 


here is a test example:


======================================================================
Input table

#+RESULTS: patito
| id                 | title       | year | index | notes | attr |
|--------------------+-------------+------+-------+-------+------|
| Taxi Driver (1944) | Taxi Driver | 1944 |       |       |      |
| Taxi Driver (1954) | Taxi Driver | 1954 |       |       |      |
| Taxi Driver (1973) | Taxi Driver | 1973 |       |       |      |
| Taxi Driver (1976) | Taxi Driver | 1976 |       |       |      |
| Taxi Driver (1978) | Taxi Driver | 1978 |       |       |      |
| Taxi Driver (1981) | Taxi Driver | 1981 |       |       |      |
| Taxi Driver (1990) | Taxi Driver | 1990 |       |       |      |
| Taxi Driver (2004) | Taxi Driver | 2004 |       |       |      |


Simple row output: the last statement is returned as a list, each in a line.

#+name: output2(data=patito)
#+begin_src perl :results raw
org_rows($data), org_columns($data);
#+end_src

#+RESULTS: output2
8
6

More complex example. By defining org_rows and org_columns in the
preface, it makes it easier to manipulate them. org-babel implements
tables as a reference to an array of references to arrays.

#+name: rip(data=patito)
#+begin_src perl :results output
my $rows = org_rows($data);
my $columns = org_columns($data);

for (my $j=0;$j<$rows; $j++) {
    for (my $i=0;$i<$columns; $i++) {
        print "$i:$j ";
        print $$data[$j][$i];
        print "   ;"
    }
    print "|\n";
}
print "Row $rows\n";
print "Columns $columns\n";
#+end_src

#+RESULTS: rip
#+begin_example
0:0 Taxi Driver (1944)   ;1:0 Taxi Driver   ;2:0 1944   ;3:0    ;4:0    ;5:0    
;|
0:1 Taxi Driver (1954)   ;1:1 Taxi Driver   ;2:1 1954   ;3:1    ;4:1    ;5:1    
;|
0:2 Taxi Driver (1973)   ;1:2 Taxi Driver   ;2:2 1973   ;3:2    ;4:2    ;5:2    
;|
0:3 Taxi Driver (1976)   ;1:3 Taxi Driver   ;2:3 1976   ;3:3    ;4:3    ;5:3    
;|
0:4 Taxi Driver (1978)   ;1:4 Taxi Driver   ;2:4 1978   ;3:4    ;4:4    ;5:4    
;|
0:5 Taxi Driver (1981)   ;1:5 Taxi Driver   ;2:5 1981   ;3:5    ;4:5    ;5:5    
;|
0:6 Taxi Driver (1990)   ;1:6 Taxi Driver   ;2:6 1990   ;3:6    ;4:6    ;5:6    
;|
0:7 Taxi Driver (2004)   ;1:7 Taxi Driver   ;2:7 2004   ;3:7    ;4:7    ;5:7    
;|
Row 8
Columns 6
#+end_example

======================================================================

diff --git a/lisp/ob-perl.el b/lisp/ob-perl.el
index ccd3826..65e6b88 100644
--- a/lisp/ob-perl.el
+++ b/lisp/ob-perl.el
@@ -62,7 +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;"
+     (format "my $%s=%s;"
             (car pair)
             (org-babel-perl-var-to-perl (cdr pair))))
    (mapcar #'cdr (org-babel-get-header params :var))))
@@ -85,13 +85,34 @@ specifying a var of the same value."
 
 (defvar org-babel-perl-wrapper-method
   "
+%s
 sub main {
 %s
 }
address@hidden = main;
+my @r = main;
 open(o, \">%s\");
 print o join(\"\\n\", @r), \"\\n\"")
 
+(defvar org-babel-perl-preface
+ "
+use strict;
+
+sub org_columns
+{
+    my ($table) = @_;
+    my $y = $$table[0];
+    return scalar(@$y);
+}
+
+sub org_rows
+{
+    my ($table) = @_;
+    return scalar(@$table);
+}
+
+")
+
+
 (defvar org-babel-perl-pp-wrapper-method
   nil)
 
@@ -102,11 +123,11 @@ 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))
+    (output (org-babel-eval org-babel-perl-command (format "%s\n%s" 
org-babel-perl-preface body)))
     (value (let ((tmp-file (org-babel-temp-file "perl-")))
             (org-babel-eval
              org-babel-perl-command
-             (format org-babel-perl-wrapper-method body
+             (format org-babel-perl-wrapper-method org-babel-perl-preface body
                      (org-babel-process-file-name tmp-file 'noquote)))
             (org-babel-eval-read-file tmp-file)))))
 



--
Daniel M. German                  "In questions of science the authority of
                                   a thousand is not worth the humble
   Galileo ->                      reasoning of a single individual."
http://turingmachine.org/
http://silvernegative.com/
dmg (at) uvic (dot) ca
replace (at) with @ and (dot) with .