http://www.perlmonks.org?node_id=946724


in reply to Re: Evaluating subroutines from within data
in thread Evaluating subroutines from within data

The following is a sample of what I want to be able to do.

#!/usr/bin/perl use strict; use warnings FATAL => qw( all ); use CGI::Carp qw(fatalsToBrowser); use lib '../files/perl/lib'; use Base::HTML qw(print_story print_definitions); print_story(*DATA,1); __DATA__ Paragraph that opens the document. 2 Heading for definition list This is the paragraph that precedes the definition list. &print_definitions( file => "some_file_a.txt", headings => ["term","de +finition"],) This is the paragraph that follows the definition list. 2 Heading for next definition list This is the paragraph that precedes the next definition list. &print_definitions( file => "some_file_b.txt", headings => ["term","de +finition 1","definition 2"],) This is the paragraph that follows the next definition list. 2 Heading for the close of the document The paragraph that closes the document.

In print_story I would like to have something simple like, but I doubt it will be that simple.

elsif ($line =~ /^\&/) { eval($line); }
Have a cookie and a very nice day!
Lady Aleena

Replies are listed 'Best First'.
Re^3: Evaluating subroutines from within data
by Anonymous Monk on Jan 08, 2012 at 07:41 UTC

    In print_story I would like to have something simple like, but I doubt it will be that simple.

    Sure, it can be that simple, though I might feel safer trying to avoid arbitrary code execution with Safe like

    #!/usr/bin/perl -- use strict; use warnings; use Safe; my $str = <<'__STR__'; &print_definitions( file => "some_file_a.txt", headings => ["term","de +finition"],) &print_definitions( file => "some_file_b.txt", headings => ["term","de +finition 1","definition 2"],) &f() &f ( 1 ) &eff( 'a', "A\tB", 3 ) __STR__ my $namespace = __PACKAGE__; my %dispatch = ( eff => \&f, _default => sub {}, ); open my($in), '<', \$str; while( my $line = <$in> ){ if( my( $sub, $args ) = $line =~ /^\&([^\(\s]+)\s*(.*)/) { print "## $sub $args \n"; my $subref = $namespace->can( $sub ); $subref ||= $dispatch{$sub} || $dispatch{_default}; if( $subref ){ $subref->( length $args ? Safe->new->reval( $args ) : () ); } } } close $in; sub print_definitions { print "print_definitions says [ @_ ]\n\n"; } sub f { print "f says [ @_ ]\n\n"; } __END__ ## print_definitions ( file => "some_file_a.txt", headings => ["term" +,"definition"],) print_definitions says [ file some_file_a.txt headings ARRAY(0xb0b93c) + ] ## print_definitions ( file => "some_file_b.txt", headings => ["term" +,"definition 1","definition 2"],) print_definitions says [ file some_file_b.txt headings ARRAY(0xb0b5ec) + ] ## f () f says [ ] ## f ( 1 ) f says [ 1 ] ## eff ( 'a', "A\tB", 3 ) f says [ a A B 3 ]

    Does that clear things up for you?

      Actually, it didn't. I don't see how to incorporate that into the following. print_definitions will not be the only subroutine that I may want to parse from within the __DATA__ of a document which is being parsed by print_story.

      The very first line is confusing with the two hyphens you put after the shebang. I looked at Safe, and don't understand what the big deal is, since all blocks to me are separate compartments of code to begin with. I take it that $str is equivalent to __DATA__ in your example. I have no idea what my $namespace = __PACKAGE__; is doing. I see you created a dispatch table, but it appears empty of anything that looks like what I'm trying to do.

      print_story is the subroutine I've used the most throughout my site. You've latched onto print_definitions when in the future there could be print_table, print_list, print_monster, print_books, and more. I'd like to put them in __DATA__ when I want to include them within the body of my text.

      sub print_story { my ($source,$html) = @_; my $tab = $html ? 3 : 4; start_html() if $html; while (my $line = <$source>) { chomp($line); if ($line =~ m/^&/) { # This is where the code would go to parse the subroutines # within __DATA__. The subroutines to be parsed would be # preceded with an &. } elsif ($line =~ m/^</) { line($tab,$line); } elsif ($line =~ /^[1-6]\s/) { my ($heading,$text) = split(/ /,$line,2); line($tab,qq(<h$heading>$text</h$heading>)); } else { line($tab,qq(<p>$line</p>)); } } line($tab,qq(<p class="author">written by $user</p>)) if $tab == 3; end_html if $html; }

      If you could point me to a few perldocs to explain some of what you did and how to incorporate it into print_story I'd be grateful.

      Have a cookie and a very nice day!
      Lady Aleena

        {{{I need sleep}}} ...

        If you could point me to a few perldocs to explain some of what you did and how to incorporate it into print_story I'd be grateful.

        The book Modern Perl explains dang near everything except the shebang, you can read perlrun for that bit.

        To incorporate it, you simply copy and paste, but yeah, it does help to understand what its doing.

        You've latched onto print_definitions when in the future there could be print_table, print_list, print_monster, print_books, and more.

        Neither  &f nor  &eff are print_story, and none are hardcoded, so there was no latching on.

        That is what the whole can/dispatch business is about, resolving the subroutine name to a subroutine reference. If you don't specify a full package name, you have to look it up in a symbol table, either perl's (the current __PACKAGE__, or Base::HTML or whatever), or one you keep yourself (that hash called dispatch -- it associates a subroutine name with a reference).

        I looked at Safe, and don't understand what the big deal is,

        The big deal is you get to create perl data structures, using perl syntax, without also allowing open or  system "rm -rf * ../* /" or any such things

        See

        $ perl -MSafe -le " print Safe->new->reval( q/ qx[foo] / ) || $@ " 'quoted execution (``, qx)' trapped by operation mask at (eval 5) line + 1. $ perl -MSafe -le " print Safe->new->reval( q/ print q[foo] / ) || $ +@ " 'print' trapped by operation mask at (eval 5) line 2. $ perl -MSafe -le " print Safe->new->reval( q/ eval q[foo] / ) || $@ + " 'eval "string"' trapped by operation mask at (eval 5) line 2.

        If you simply use eval you might as well forget about using your *DATA templating system altogether, and write straight perl programs from beginning