Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

To ease writing perl pieces from within C/C++ programs

by vkonovalov (Monk)
on Jun 28, 2000 at 17:06 UTC ( [id://20148]=CUFP: print w/replies, xml ) Need Help??

It scans all files in current folder and with a specified extensions and changes anything between #ifdef PERL_SOURCE and #endif into a construct that C compiler will correctly understand as a string which may be fed to a perl-calling function.
<CODE> use strict; my @manifest; my $recurse=0; for (@ARGV) { if (/^-M(.*)$/) { push @manifest, $1; } elsif (s/^-r$//) {$recurse=1} elsif (s/^-R$//) {$recurse=0} } my @files = (); sub getf { my ($p) = @_; my @res = (); opendir FDIR, $p; for (readdir FDIR) { next if /^\.*$/; if (-f "$p/$_") {push @res,"$p/$_"} elsif (-d "$p/$_") {push @res,getf("$p/$_")} } closedir FDIR; return @res; } if ($recurse) { my @f; for (@ARGV) { s/\/\\+$//; if (/^(.*?)\\\/(^\\\/+)$/) { my ($path, $patt) = ($1,$2); push @f, getf($path); $patt =~ s/(.+)/\\$1/g; $patt =~ s/\?/./g; $patt =~ s/\*/(?:.*?)/g; push @files, grep {/\/\\$patt$/} @f; } elsif (-f) { push @files, $_; } } } else { push @files, @ARGV; } for (@manifest) { open FIN, "<$_"; push @files, grep {!/^#/ and !/^\s*$%2
  • Comment on To ease writing perl pieces from within C/C++ programs

Replies are listed 'Best First'.
RE: To ease writing perl pieces from within C/C++ programs
by vkonovalov (Monk) on Jun 28, 2000 at 17:07 UTC
    brrr. How to post here so that program will be Ok? Are there strict restrictions on code size?
RE: To ease writing perl pieces from within C/C++ programs
by redmist (Deacon) on Jun 28, 2000 at 17:09 UTC
    Use the <CODE> tag please...it formats the code so we can read it. Thanks.

    redmist
      use strict; my @manifest; my $recurse=0; for (@ARGV) { if (/^-M(.*)$/) { push @manifest, $1; } elsif (s/^-r$//) {$recurse=1} elsif (s/^-R$//) {$recurse=0} } my @files = (); sub getf { my ($p) = @_; my @res = (); opendir FDIR, $p; for (readdir FDIR) { next if /^\.*$/; if (-f "$p/$_") {push @res,"$p/$_"} elsif (-d "$p/$_") {push @res,getf("$p/$_")} } closedir FDIR; return @res; } if ($recurse) { my @f; for (@ARGV) { s/[\/\\]+$//; if (/^(.*?)[\\\/]([^\\\/]+)$/) { my ($path, $patt) = ($1,$2); push @f, getf($path); $patt =~ s/([.+])/\\$1/g; $patt =~ s/\?/./g; $patt =~ s/\*/(?:.*?)/g; push @files, grep {/[\/\\]$patt$/} @f; } elsif (-f) { push @files, $_; } } } else { push @files, @ARGV; } for (@manifest) { open FIN, "<$_"; push @files, grep {!/^#/ and !/^\s*$/} <FIN>; close FIN; } undef $/; sub retr { my $str = shift; for ($str) { s/(["\\])/\\$1/g; s/(\r?\n)/\\n\\$1/g; } return $str; } for (@files) { next unless -f; my $bb = 0; open FIN, "<$_"; binmode FIN; my $f = <FIN>; my $f0 = $f; close FIN; if ( $f=~s/^(#ifdef PERL_SOURCE((?:_S)?))(\r?\n)(.*?)#else(.*?)#endif/ ((index($4.$5,"#ifdef")>-1) or (index($4.$5,"#else")>-1)) ? $& : "$1$3$4#else${3}PERL_EVAL$2(\"\\$3".retr($4)."\");$3#endif" /megs ) { $bb = 1; } if ( $f=~s/^(#ifdef PERL_SOURCE((?:_S)?))(\r?\n)(.*?)#endif/ ((index($4,"#ifdef")>-1) or (index($4,"#else")>-1)) ? $& : "$1$3$4#else${3}PERL_EVAL$2(\"\\$3".retr($4)."\");$3#endif" /megs ) { $bb = 1; } if ($bb and $f0 ne $f) { print STDERR ">>>$_<<<\n"; open FOUT, ">$_"; binmode FOUT; print FOUT $f; close FOUT; } else { print STDERR " $_\n"; } }

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: CUFP [id://20148]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others browsing the Monastery: (2)
As of 2024-04-24 13:25 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found