perluser456 has asked for the wisdom of the Perl Monks concerning the following question:

I am new to this site and I have a question (sorry about it eating the <CR><LF>, dont know how to fix). I want to write a perl script that gets a list of regular expressions from a file. Example: myscript.pl regexp.txt ascii.txt I know how to write the script with regexp.txt hard coded into myscript.pl. I want to allow the user to specify this at runtime. Below is an example of where I have hardcoded the regexp in the script so you can gauge perl ability. 
#!/usr/local/bin/perl

open (FILE1, "$ARGV[1]") || warn "The script $0 can't open $ARGV[1]: $
+!\n";
open (FILE1, "$ARGV[0]") || warn "The script $0 can't open $ARGV[0]: $
+!\n";

while (<FILE1>){
  s/f/z/;
  s/h/y/;
  s/there/where/; 
  print $_;
}
close (FILE1);

[download]
Thanks Ascii.txt would look like this: 
foo
bar
here
there

[download]
Then regexp.txt would be like this: 
s/f/z/;
s/h/y/;
s/there/where/;

[download]

Replies are listed 'Best First'.
Re: Want to get regexp list from file
by japhy (Canon) on Mar 26, 2005 at 21:30 UTC
    Well, I'm not sure I'd do this, but if you TRUST YOUR USER, you can do: 
    while (<FILE1>) {
  do $regex_file;
  print;
}

    [download]
    where $regex_file holds the filename to execute. It's scary though, because the user could put ANYTHING in that file. So maybe you want a sandbox, via Safe: 
    use Safe;
use strict;
use warnings;

# read the regex file into $code
my $code = do {
  local $/;
  open my($rx), $regex_file;
  <$rx>;
};

# create a sandbox
my $sandbox = Safe->new;

# allow acceptable operators (perldoc Opcode)
$sandbox->permit_only(qw( :base_core :base_orig ));

while (<FILE>) {
  $sandbox->reval($code);
  print;
}

    [download]
    Try that out.
    _____________________________________________________
    Jeff japhy Pinyan, P.L., P.M., P.O.D, X.S.: Perl, regex, and perl hacker
    How can we ever be the sold short or the cheated, we who for every service have long ago been overpaid? ~~ Meister Eckhart
[reply]
[d/l]
[select]
Re: Want to get regexp list from file
by ambs (Pilgrim) on Mar 26, 2005 at 19:53 UTC
    Hi.

    Regarding your post, try to add <pre>..</pre> around the code.

    Regarding your problem, try something like: 

      my $regexp = shift;
  my $text = shift;

  open RE, $regexp;
  while(<RE>) { chomp; push @re, $_ }
  close RE;

  open TXT, $text;
  while(<TXT>) {
     for my $re (@re) {
         print if m!$re!
     }
  }
  close TXT

    [download]
    Sorry but I didn't test the code, but I hope this helps. Good luck.

    Update: Thanks to ambrus for correcting my code.

    Alberto Simões

[reply]
[d/l]
         for my $re (@re) {
       print if m!re!
   }

      [download]

      I guess you're missing a dollar sign before re.

[reply]
[d/l]
[select]
      Regarding your post, try to add <pre>..</pre> around the code.

      Erm, ITYM add <code>...</code>.

[reply]
Re: Want to get regexp list from file
by b10m (Vicar) on Mar 26, 2005 at 21:24 UTC

    I assume you want your program to do more than just regexp'ing some file, but if not, why not just go with sed

    Probably faster than your script and extrememly useful :)

    --
    b10m

    All code is usually tested, but rarely trusted.
[reply]
Re: Want to get regexp list from file
by perluser456 (Initiate) on Mar 29, 2005 at 15:30 UTC 
    Thanks a bunch for everyones comments.  Really appreciate it.  Here is what I am going to use:

The Ascii.txt looks something like this:
    "X[6]" + "XM7"  + "Z_data[17]" + "Z[18][20]"

    [download]
    Then the user supplied the mapping file 
    X[6] X_6_
XM7 X_7_
Z_data[17] Z_17_
Z[18][20] Z_18__20_

    [download]
    Then my perl script looked like this: 
    
#use strict;
#use warnings;
$regexp = table2;
$i =0;

open RE, $regexp;
while (<RE>) {
  chop;
  ($search[$i], $replace[$i]) = split(/ /, $_ );
  $search[$i] =~ s/\[/\\[/g;
  $search[$i] =~ s/\]/\\]/g;
  $i++;
}
  

while (<>) {
  for($i=0; $i < $#search; $i++) {
    s{$search[$i]}{$replace[$i]}g;
  }
  print;
}

    [download]
[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom