Front page | perl.perl5.porters |
Postings from April 2000
c with embedded perl
Thread Next
From:
Konovalov, Vadim
Date:
April 14, 2000 05:59
Subject:
c with embedded perl
Message ID:
402099F49BEED211999700805FC7359F4DF0FA@ru0028exch01.spb.lucent.com
Hello.
Please direct me into right place if this mailing list serves different
purposes.
I've wrote a simple but very often used by me script to ease writing perl
pieces from within C/C++ programs.
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 and
So I quite often write something like (in my case $G:: are variables that
are seen on the GUI screen):
//--------------------------------------------------------------------------
-
void __fastcall TfrmSGML2EPS::spbRefreshFilesClick(TObject *Sender)
{
if (!bRefreshAllowed)
return;
#ifdef PERL_SOURCE
$vt::dir = $G::edtDocumentDir;
opendir DIR, $vt::dir;
@G::clbFiles = ();
if ($G::chkSuggestedExtensions) {
if ($G::chkParsedSGML) {$vt::sext='\\.parsed$'}
else {$vt::sext='\\.sgml?$'}
}
else {$vt::sext=''}
for (readdir DIR) {
next unless -f "$vt::dir$_";
push @G::clbFiles, "0$_" if /$vt::sext/io;
}
closedir DIR;
undef $vt::sext;
undef $vt::dir;
#else
PERL_EVAL("\
$vt::dir = $G::edtDocumentDir;\n\
opendir DIR, $vt::dir;\n\
@G::clbFiles = ();\n\
if ($G::chkSuggestedExtensions) {\n\
if ($G::chkParsedSGML) {$vt::sext='\\\\.parsed$'}\n\
else {$vt::sext='\\\\.sgml?$'}\n\
}\n\
else {$vt::sext=''}\n\
for (readdir DIR) {\n\
next unless -f \"$vt::dir$_\";\n\
push @G::clbFiles, \"0$_\" if /$vt::sext/io;\n\
}\n\
closedir DIR;\n\
undef $vt::sext;\n\
undef $vt::dir;\n\
");
#endif
}
Anything between #else and #endif was generated automatically.
I find this script quite convenient and want share it with anyone who
intrested with it.
I would be happy to hear any comments, suggestions, related ideas.
Here it comes:
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";
}
}
Good luck,
Vadim Konovalov.
Thread Next