develooper Front page | perl.perl5.porters | Postings from April 2000

c with embedded perl

Thread Next
Konovalov, Vadim
April 14, 2000 05:59
c with embedded perl
Message ID:

Please direct me into right place if this mailing list serves different

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)
$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;
$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\
else {$vt::sext=''}\n\
for (readdir DIR) {\n\
  next unless -f \"$vt::dir$_\";\n\
  push @G::clbFiles, \"0$_\" if /$vt::sext/io;\n\
closedir DIR;\n\
undef $vt::sext;\n\
undef $vt::dir;\n\

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) {
    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) {
  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)) ? $& :
  ) {
    $bb = 1;
  if (
    $f=~s/^(#ifdef PERL_SOURCE((?:_S)?))(\r?\n)(.*?)#endif/
     ((index($4,"#ifdef")>-1) or (index($4,"#else")>-1)) ? $& :
  ) {
    $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 Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at | Group listing | About