Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

How to search and replace text characters in a perl script

by thetekguy (Initiate)
on May 19, 2016 at 21:21 UTC ( [id://1163536]=perlquestion: print w/replies, xml ) Need Help??

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

Hi Perl Gurus! For someone more seasoned in perl coding I'm sure this is trivial, but I am a complete noob. I have a text file that requires post-processing to remove lines matching certain control command lines, as well as pre-pend characters and remove characters from other lines. My existing script works to remove lines that match certain control commands- G10, G11, G92, M190, but I am finding it very hard to figure out how to search/replace characters within each line without overwriting the whole line.
The two strings I need to search and replace on a line by line basis are:
1) search for G1 ZNN.NNN where N is a number and . is a decimal, and replace with G1 Z-NN.NNN, retaining remainder of text on line
2) search for EN.NNNNN where N is a number and . is a decimal, and replace with null, retaining remainder of text on line.
My existing code is:
#!/usr/bin/perl -i.before_postproc # Author : David Sherwood # Version : 1.0 # Copyright : none. # # Slice3R GCODE laser cutter post-processor use strict; use warnings; # read stdin and any/all files passed as parameters one line at a time while (<> ) { if (/G11/) { # if we have an un-retraction line, replace it with laser powe +r on print "M400 ; wait for moves to finish\nM104 S100 ; laser on\n +"; } elsif (/G10/) { # if we found a retraction line, replace it with laser power o +ff print "M104 S0 ; laser off\n"; } elsif (/G92/) { # if we found an extruder reset command line, remove it print ""; } elsif (/M190/) { # if we found a heat bed command line, remove it print ""; } else { print or die $!; } }
Sample Data:
G92 E0 ; want to remove all G92 lines (works now) T1 G1 Z0.050 F7800.000 G10 ; retract G92 E0 G1 Z0.150 F7800.000 G1 X14.725 Y-8.975 F7800.000 G1 Z0.050 F7800.000 G11 ; unretract G92 E0 G1 X14.725 Y8.975 E0.01465 F120.000 G10 ; retract G92 E0 G1 Z0.150 F7800.000 G1 X-9.585 Y-0.615 F7800.000 G1 Z0.050 F7800.000 G11 ; unretract G92 E0
Expected Data
T1 G1 Z-0.050 F7800.000 M104 S0 ; laser off G1 Z-0.150 F7800.000 G1 X14.725 Y-8.975 F7800.000 G1 Z-0.050 F7800.000 M400 ; wait for moves to finish M104 S100 ; laser on G1 X14.725 Y8.975 F120.000 M104 S0 ; laser off G1 Z-0.150 F7800.000 G1 X-9.585 Y-0.615 F7800.000 G1 Z-0.050 F7800.000 M400 ; wait for moves to finish M104 S100 ; laser on

Replies are listed 'Best First'.
Re: How to search and replace text characters in a perl script
by stevieb (Canon) on May 19, 2016 at 22:23 UTC

    Here's one example, kind of following along the code layout you already have. In the 'E' case, we simply attempt a regex substitution (s//;), and for the 'Z' entries, we check if we have a match first, capture the match into two parts ($1, $2), and if there is a match, we do the substitution:

    while (<>) { chomp; # EN.NNNNN # no need for if(), we're not using the capture number vars s/E\d\.\d{5}//; # ZNN.NNN # need if, or it'll warn on no match if (/G1 Z\d{1,2}\.\d{3}/){ s/(G1 Z)(\d{1,2}\.\d{3})/$1-$2/; } print "$_\n"; }
      # need if, or it'll warn on no match

      No need: no substitution is done, no capture variables are referenced, if no replacement match exists:

      c:\@Work\Perl\monks>perl -wMstrict -le "for my $s ('G1 Z0.050 F7800.000', 'G10 ; retract',) { printf qq{'$s' -> }; local $_ = $s; s/(G1 Z)(\d{1,2}\.\d{3})/$1-$2/; print qq{'$_'}; } " 'G1 Z0.050 F7800.000' -> 'G1 Z-0.050 F7800.000' 'G10 ; retract' -> 'G10 ; retract'
      (Although I think I would prefer to use look-arounds as graff did and just stick a - in.)


      Give a man a fish:  <%-{-{-{-<

      Beautiful! Thanks for the quick response. It would have taken me weeks of trial and error to get to this point- but this helps me learn for next time. Much appreciated! Here is the final working code:
      #!/usr/bin/perl -i.before_postproc # Author : David Sherwood # Version : 1.0 # Copyright : none. # # Postprocessor for Slic3R Gcode for Laser Cutter use strict; use warnings; # read stdin and any/all files passed as parameters one line at a time while (<>) { chomp; # EN.NNNNN # no need for if(), we're not using the capture number vars s/E\d\.\d{5}//; # ZNN.NNN # need if, or it'll warn on no match if (/G1 Z\d{1,2}\.\d{3}/){ s/(G1 Z)(\d{1,2}\.\d{3})/$1-$2/; } if (/G11/) { # if we have an un-retraction line, replace it with laser powe +r on print "M400 ; wait for moves to finish\nM104 S100 ; laser on\n +"; } elsif (/G10/) { # if we found a retraction line, replace it with laser power o +ff print "M104 S0 ; laser off\n"; } elsif (/G92/) { # if we found an extruder reset command line, remove it print ""; } elsif (/M190/) { # if we found a heat bed command line, remove it print ""; } else { print "$_\n" or die $!; } }
Re: How to search and replace text characters in a perl script
by graff (Chancellor) on May 20, 2016 at 02:56 UTC
    First, a couple nitpicks:
    • You have a comment saying "read stdin and any/all files passed as parameters..." Actually, it should say "or" instead of "and" -- the while(<>) reads either from file names given on the command line, or from STDIN, not both.
    • If you think you need to do print or die $! at all, you should do it on every print statement. (But you probably don't need to do it at all. When a print to STDOUT fails, you either don't need to be told, or else you'll get other error messages anyway.)
    • Doing print "" is a noisy way of doing nothing at all.

    All that aside, I think the device you're looking for is the "look-around" assertions in a regex. Here's a slightly modified version of your code (because sometimes I can't help but change things), with the relevant bits added in the final "else" block:

    #!/usr/bin/perl use strict; use warnings; my @G1x_replace = ( "M104 S0 ; laser off\n", "M400 ; wait for moves to finish\nM104 S100 ; laser on\n", ); while (<DATA>) { if ( /G1([01])/ ) { print $G1x_replace[ $1 ]; } elsif ( /G92|M190/ ) { next; } else { s/(?<=G1 Z)(?=\d)/-/g; # look-behind and look-ahead to insert + "-" s/E[\d.]+ //g; # no look-around needed, just delete s +tuff print; } } __DATA__ G92 E0 ; want to remove all G92 lines (works now) T1 G1 Z0.050 F7800.000 G10 ; retract G92 E0 G1 Z0.150 F7800.000 G1 X14.725 Y-8.975 F7800.000 G1 Z0.050 F7800.000 G11 ; unretract G92 E0 G1 X14.725 Y8.975 E0.01465 F120.000 G10 ; retract G92 E0 G1 Z0.150 F7800.000 G1 X-9.585 Y-0.615 F7800.000 G1 Z0.050 F7800.000 G11 ; unretract G92 E0
      Perl is such a powerful language there are many ways to skin a cat. I use a blunt knife, most of you use a scalpel. :-) I am reading all responses and will learn from them all. Thanks gurus!
Re: How to search and replace text characters in a perl script
by Marshall (Canon) on May 20, 2016 at 02:54 UTC
    Here is a different idea for you... Instead of if/else, I used a "dispatch table" to take action on the various op codes. The default is to just do nothing by printing the existing line. If the op code has an action, then it is done (that might be "nothing" in the case of G92 or M190)

    #!usr/bin/perl use warnings; use strict; $|=1; #turn off stdout buffering, easier to debug warnings... my %dispatch = (G92 => sub{return}, G10 => sub{print "M104 S0 ; laser off\n";}, G11 => sub{print "M400 ; wait for moves to finish\n"; print "M104 S100 ; laser on\n";}, M190 => sub{return}, G1 => \&G1, ); while (my $line = <DATA>) { chomp $line; my ($op,$rest) = split ' ',$line,2; $rest //= ''; #define $rest as null string if undefined if (exists $dispatch{$op}) { $dispatch{$op}->($rest); } else { print "$line\n"; } } sub G1 { my $rest = shift; $rest =~ s/Z/Z-/; $rest =~ s/E[\d.]+//; print "G1 $rest\n"; } =prints: T1 G1 Z-0.050 F7800.000 M104 S0 ; laser off G1 Z-0.150 F7800.000 G1 X14.725 Y-8.975 F7800.000 G1 Z-0.050 F7800.000 M400 ; wait for moves to finish M104 S100 ; laser on G1 X14.725 Y8.975 F120.000 M104 S0 ; laser off G1 Z-0.150 F7800.000 G1 X-9.585 Y-0.615 F7800.000 G1 Z-0.050 F7800.000 M400 ; wait for moves to finish M104 S100 ; laser on =cut __DATA__ G92 E0 ; want to remove all G92 lines (works now) T1 G1 Z0.050 F7800.000 G10 ; retract G92 E0 G1 Z0.150 F7800.000 G1 X14.725 Y-8.975 F7800.000 G1 Z0.050 F7800.000 G11 ; unretract G92 E0 G1 X14.725 Y8.975 E0.01465 F120.000 G10 ; retract G92 E0 G1 Z0.150 F7800.000 G1 X-9.585 Y-0.615 F7800.000 G1 Z0.050 F7800.000 G11 ; unretract G92 E0

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others wandering the Monastery: (5)
As of 2024-04-23 21:33 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found