Hi I am new to stackoverflow. I've tried looking a way to print another perl script within a different perl script and the only advice I came across is escaping the variables using a backslash...but I tried this and it does not work.
My goal is to write a perl script to make a bunch of new perl scripts but as it is it won't allow me to use variable/arrays/etc in a print "". Is there a way around this? Thanks in advance!
Here is my preliminary script:
#!/usr/bin/perl
use warnings;
use strict;
my $idfile = $ARGV[0];
open (IDFILE,'<',$idfile)
or die "Could not open $idfile \n";
my $outfile_name;
my $outfile = $outfile_name."pl";
open (OUTFILE, '>', $outfile)
or die "Could not open $outfile \n";
while (my $line = <IDFILE>) {
chomp ($line);
if ($line =~ /(T4-GC_[0-9]+)/) {
my $outfile_name = "Pull_".$line;
my $script = "
#!/usr/bin/perl
use warnings;
use strict;
use Bio::SearchIO;
use Bio::SeqIO;
my #ARGV = glob("*.fa");
foreach my $fil (#ARGV) {
my $seqio = Bio::SeqIO->new(-format => 'fasta', -file => $fil);
while (my $seqobj = $seqio->next_seq) {
my $seqid = $seqobj->display_id;
$fil =~ /([A-Z]+[0-9]+)/;
my $phage_name = $1;
my $id = $seqid."|".$phage_name;
my $nuc = $seqobj->seq();
if ($seqid =~ /**$line**/) {
print ">$id\n$nuc\n";
}
}
}"
print OUTFILE $script;
}
}
And this is the error I get back:
String found where operator expected at make_perl_pull_genes_files.pl line 33, near "my $id = $seqid.""
(Might be a runaway multi-line "" string starting on line 25)
(Missing semicolon on previous line?)
Backslash found where operator expected at make_perl_pull_genes_files.pl line 36, near "$id\"
(Might be a runaway multi-line "" string starting on line 33)
(Missing operator before \?)
Backslash found where operator expected at make_perl_pull_genes_files.pl line 36, near "$nuc\"
(Missing operator before \?)
String found where operator expected at make_perl_pull_genes_files.pl line 39, near "}""
(Might be a runaway multi-line "" string starting on line 36)
(Missing semicolon on previous line?)
syntax error at make_perl_pull_genes_files.pl line 25, near "*."
(Might be a runaway multi-line "" string starting on line 18)
Global symbol "$id" requires explicit package name at make_perl_pull_genes_files.pl line 36.
Global symbol "$nuc" requires explicit package name at make_perl_pull_genes_files.pl line 36.
Execution of make_perl_pull_genes_files.pl aborted due to compilation errors.
Use a HERE document with single quotes around the leading delimiter.
print <<'EOT';
#!/usr/bin/perl
use warnings;
use strict;
use Bio::SearchIO;
use Bio::SeqIO;
my #ARGV = glob("*.fa");
foreach my $fil (#ARGV) {
my $seqio = Bio::SeqIO->new(-format => 'fasta', -file => $fil);
while (my $seqobj = $seqio->next_seq) {
my $seqid = $seqobj->display_id;
$fil =~ /([A-Z]+[0-9]+)/;
my $phage_name = $1;
my $id = $seqid."|".$phage_name;
my $nuc = $seqobj->seq();
if ($seqid =~ /**$line**/) {
print ">$id\n$nuc\n";
}
}
}
EOT
Note that the trailing delimiter must be cuddled by newlines: \nTRAILING\n in your source. Don't attempt to indent it, for instance. Another place you can stuff text like this, within your source file, is beyond a __DATA__ line. You would then read it back through <DATA>.
Related
I am attempting to create a Perl script that filters data presented on STDIN, changing all occurrences of
one string to another and outputting all input lines, changed and unchanged to STDOUT. FROMSTRING and TOSTRING can be PERL-compatible regular expressions. I am unable to get matching output.
Here is an example of what I am trying to achieve.
echo "Today is Saturday" | f.pl 'a' '#'
Output Tod#y is S#turd#y.
echo io | filter.pl '([aeiou])([aeiou])' '$2$1'
Output oi.
#!/usr/bin/perl
use strict;
use warnings;
if (#ARGV != 2){
print STDERR "Usage: ./filter.pl FROMSTRING TOSTRING\n"
}
exit 1;
my $FROM = $ARGV[0];
my $TO = $ARGV[1];
my $inLine = "";
while (<STDIN>){
$inLine = $_;
$inLine =~ s/$FROM/$TO/;
print $inLine
}
exit 0;
First off, the replacement part of a s/.../.../ operation is not a regex; it works like a double-quoted string.
There are a couple of issues with your code.
Your exit 1; statement appears in the middle of the main code, not in the error block. You probably want:
if (#ARGV != 2) {
print STDERR "Usage: ./filter.pl FROMSTRING TOSTRING\n";
exit 1;
}
You're missing a g flag if you want multiple substitutions to happen in the same line:
$inLine =~ s/$FROM/$TO/g;
There's no need to predeclare $inLine; it's only used in one block.
There's also no need to read a line into $_ just to copy it into $inLine.
It's common to use $names_like_this for variables and functions, not $namesLikeThis.
You can use $0 instead of hardcoding the program name in the error message.
exit 0; is redundant at the end.
The following is closer to how I'd write it:
#!/usr/bin/perl
use strict;
use warnings;
if (#ARGV != 2) {
die "Usage: $0 FROMSTRING TOSTRING\n";
}
my ($from, $to) = #ARGV;
while (my $line = readline STDIN) {
$line =~ s/$from/$to/g;
print $line;
}
That said, none of this addresses your second example with '$2$1' as the replacement. The above code won't do what you want because $to is a plain string. Perl won't scan it to look for things like $1 and replace them.
When you write "foo $bar baz" in your code, it means the same thing as 'foo ' . $bar . ' baz', but this only applies to code, i.e. stuff that literally appears in your source code. The contents of $bar aren't re-scanned at runtime to expand e.g. \n or $quux. This also applies to $1 and friends, which are just normal variables.
So how do you get '$2$1' to work?
One way is to mess around with eval, but I don't like it because, well, it's eval: If you're not very careful, it would allow someone to execute arbitrary code by passing the right replacement "string".
Doing it without eval is possible and even easy with e.g. Data::Munge::replace:
#!/usr/bin/perl
use strict;
use warnings;
use Data::Munge qw(replace);
if (#ARGV != 2) {
die "Usage: $0 FROMSTRING TOSTRING\n";
}
my ($from, $to) = #ARGV;
while (my $line = readline STDIN) {
print replace($line, $from, $to, 'g');
}
replace works like JavaScript's String#replace in that it expands special $ sequences.
Doing it by hand is also possible but slightly annoying because you basically have to treat $to as a template and expand all $ sequences by hand (e.g. by using another regex substitution):
# untested
$line =~ s{$from}{
my #start = #-;
my #stop = #+;
(my $r = $to) =~ s{\$([0-9]+|\$)}{
$1 eq '$'
? '$'
: substr($from, $start[$1], $stop[$1] - $start[$1])
}eg;
$r
}eg;
(This does not implement braced groups such as ${1}, ${2}, etc. Those are left as an exercise for the reader.)
This code is sufficiently annoying to write (and look at) that I much prefer using a module like Data::Munge for this sort of thing.
three errors found:
; after error message
exit 1;
$inLine =~ s/$FROM/$TO/g;
like:
#!/usr/bin/perl
use strict;
use warnings;
if (#ARGV != 2){
print STDERR "Usage: ./filter.pl FROMSTRING TOSTRING\n";
exit 1;
}
my $FROM = $ARGV[0];
my $TO = $ARGV[1];
my $inLine = "";
while (<STDIN>){
$inLine = $_;
$inLine =~ s/$FROM/$TO/g;
print $inLine
}
exit 0;
I got a file separated by ":"
uucp:x:10:14:uucp:/var/spool/uucp:/sbin/nologin
operator:x:11:0:operator:/root:/sbin/nologin
games:x:12:100:games:/usr/games:/sbin/nologin
antbexw:x:59000:80::/usr/var/log:/bin/ksh
Each ":" is a separator, thus the aim is to extract position 0 and position 5 to have:
uucp /var/spool/uucp
operator /root
games /usr/games
antbexw /usr/var/log
Then only print line containing antbexw which is in fact the machine hostname.
I have achieved to read the file, split but not the compare against the machine hostname to only print out the antbexw line
antbexw /usr/var/log
Here my script, would you help me out to construct the Condition to print only the line I need? or to propose another method.
#!/usr/bin/perl -w
use strict;
use warnings;
use diagnostics;
use Sys::Hostname;
my $host = hostname;
print "$host\n";
open(my $fh, '<', 'file.txt') or die "cannot open < file.txt: $!";
while (my $line = <$fh>)
{
my#fields = split(":",$line);
print "=*=*=*=*User=*=*=*=* \n$fields[0] \nDirectory $fields[5]\n";
}
close($fh) || warn "close failed: $!";
To compare strings, use the eq operator:
if ($fields[0] eq $host) {
print "=== User ===\n$fields[0]\nDirectory $fields[5]\n";
}
Some unrelated details:
You already have use warnings, no need to specify -w on the shebang line.
The first argument to split is a regex (or a space), so it's better not to use strings.
Your code would be more readable if you indented properly and added some whitespace around punctuation (after commas, before #).
in the mean time i did some other tries and got to this solution:
while (my $line = <$fh>)
{
if($line =~ m/$host/)
{
my#fields = split(":",$line);
print MYFILE"=*=*=*=*SftpUser=* \n$fields[0] \nDirectory $fields[5]\n";
}}
I am working on the perl script and need some help with it. The requirement is, I have to find a lable and once the label is found, I have to replace the word in a line immediately following the label. for Example, if the label is ABC:
ABC:
string to be replaced
some other lines
ABC:
string to be replaced
some other lines
ABC:
string to be replaced
I want to write a script to match the label (ABC) and once the label is found, replace a word in the next line immediately following the label.
Here is my attempt:
open(my $fh, "<", "file1.txt") or die "cannot open file:$!";
while (my $line = <$fh>))
{
next if ($line =~ /ABC/) {
$line =~ s/original_string/replaced_string/;
}
else {
$msg = "pattern not found \n ";
print "$msg";
}
}
Is this correct..? Any help will be greatly appreciated.
The following one-liner will do what you need:
perl -pe '++$x and next if /ABC:/; $x-- and s/old/new/ if $x' inFile > outFile
The code sets a flag and gets the next line if the label is found. If the flag is set, it's unset and the substitution is executed.
Hope this helps!
You're doing this in your loop:
next if ($line =~ /ABC/);
So, you're reading the file, if a line contains ABC anywhere in that line, you skip the line. However, for every other line, you do the replacement. In the end, you're replacing the string on all other lines and printing that out, and your not printing out your labels.
Here's what you said:
I have to read the file until I find a line with the label:
Once the label is found
I have to read the next line and replace the word in a line immediately following the label.
So:
You want to read through a file line-by-line.
If a line matches the label
read the next line
replace the text on the line
Print out the line
Following these directions:
use strict;
use warnings; # Hope you're using strict and warnings
use autodie; # Program automatically dies on failed opens. No need to check
use feature qw(say); # Allows you to use say instead of print
open my $fh, "<", "file1.txt"; # Removed parentheses. It's the latest style
while (my $line = <$fh>) {
chomp $line; # Always do a chomp after a read.
if ( $line eq "ABC:" ) { # Use 'eq' to ensure an exact match for your label
say "$line"; # Print out the current line
$line = <$fh> # Read the next line
$line =~ s/old/new/; # Replace that word
}
say "$line"; # Print the line
}
close $fh; # Might as well do it right
Note that when I use say, I don't have to put the \n on the end of the line. Also, by doing my chomp after my read, I can easily match the label without worrying about the \n on the end.
This is done exactly as you said it should be done, but there are a couple of issues. The first is that when we do $line = <$fh>, there's no guarantee we are really reading a line. What if the file ends right there?
Also, it's bad practice to read a file in multiple places. It makes it harder to maintain the program. To get around this issue, we'll use a flag variable. This allows us to know if the line before was a tag or not:
use strict;
use warnings; # Hope you're using strict and warnings
use autodie; # Program automatically dies on failed opens. No need to check
use feature qw(say); # Allows you to use say instead of print
open my $fh, "<", "file1.txt"; # Removed parentheses. It's the latest style
my $tag_found = 0; # Flag isn't set
while (my $line = <$fh>) {
chomp $line; # Always do a chomp after a read.
if ( $line eq "ABC:" ) { # Use 'eq' to ensure an exact match for your label
$tag_found = 1 # We found the tag!
}
if ( $tag_found ) {
$line =~ s/old/new/; # Replace that word
$tag_found = 0; # Reset our flag variable
}
say "$line"; # Print the line
}
close $fh; # Might as well do it right
Of course, I would prefer to eliminate mysterious values. For example, the tag should be a variable or constant. Same with the string you're searching for and the string you're replacing.
You mentioned this was a word, so your regular expression replacement should probably look like this:
$line =~ s/\b$old_word\b/$new_word/;
The \b mark word boundaries. This way, if you're suppose to replace the word cat with dog, you don't get tripped up on a line that says:
The Jeopardy category is "Say what".
You don't want to change category to dogegory.
Your problem is that reading in a file does not work like that. You're doing it line by line, so when your regex tests true, the line you want to change isn't there yet. You can try adding a boolean variable to check if the last line was a label.
#!/usr/bin/perl;
use strict;
use warnings;
my $found;
my $replacement = "Hello";
while(my $line = <>){
if($line =~ /ABC/){
$found = 1;
next;
}
if($found){
$line =~ s/^.*?$/$replacement/;
$found = 0;
print $line, "\n";
}
}
Or you could use File::Slurp and read the whole file into one string:
use File::Slurp;
$x = read_file( "file.txt" );
$x =~ s/^(ABC:\s*$ [\n\r]{1,2}^.*?)to\sbe/$1to was/mgx;
print $x;
using /m to make the ^ and $ match embedded begin/end of lines
x is to allow the space after the $ - there is probably a better way
Yields:
ABC:
string to was replaced
some other lines
ABC:
string to was replaced
some other lines
ABC:
string to was replaced
Also, relying on perl's in-place editing:
use File::Slurp qw(read_file write_file);
use strict;
use warnings;
my $file = 'fakefile1.txt';
# Initialize Fake data
write_file($file, <DATA>);
# Enclosed is the actual code that you're looking for.
# Everything else is just for testing:
{
local #ARGV = $file;
local $^I = '.bac';
while (<>) {
print;
if (/ABC/ && !eof) {
$_ = <>;
s/.*/replaced string/;
print;
}
}
unlink "$file$^I";
}
# Compare new file.
print read_file($file);
1;
__DATA__
ABC:
string to be replaced
some other lines
ABC:
string to be replaced
some other lines
ABC:
string to be replaced
ABC:
outputs
ABC:
replaced string
some other lines
ABC:
replaced string
some other lines
ABC:
replaced string
ABC:
Implement a program that processes an input file by changing every occurrence of an old string into a new string. (The usage is: chstr file oldstring newstring, chstr is your program name, file, oldstring and newstring are parameters specified by user.)
if( #ARGV < 2)
{
print "usage: ReplaceString.pl filename OldString NewString\n";
print " example: perl ReplaceString.pl intelliquest.txt ";
print "IntelliQuest Kantar > kantar.txt\n";
exit 0;
}
$OldString = $ARGV[1];
$NewString = $ARGV[2];
open(MYFILE,$ARGV[0]) || die "Cannot open file \"$ARGV[0]\"";
while($line = <MYFILE>)
{
$line =~ s/$OldString/$NewString/g;
print STDOUT $line;
}
really not sure what is wrong here, I try and run
jd#jd-laptop:~/Desktop$ perl HW1-2.pl text.txt if the
To replace if with the and i get...
syntax error at HW1-2.pl line 11, near "<"
syntax error at HW1-2.pl line 11, near ">"
syntax error at HW1-2.pl line 15, near "}"
Execution of HW1-2.pl aborted due to compilation errors.
Do i need the < and >? I'm really new to Perl
Thanks in advance
Whatever tutorial you based this on was clearly written by someone who can't be bothered to check his work. < and > are supposed to be < and >, respectively, but somewhere along the line it got overly HTML-encoded.
Specifically, the line
while($line = <MYFILE>)
should be changed to:
while($line = <MYFILE>)
jwodder has the answer, but you seem confused by it:
This works on my Mac. If you are running this on a Linux, Mac, or Unix system, you need that
first line I have #! /usr/bin/env perl. Or else, you need to run your program as perl ReplaceString.pl from the command line.
One Windows, you have to make sure that the .pl suffix is mapped to your Perl interpreter.
#! /usr/bin/env perl
if( #ARGV < 2) {
print "usage: ReplaceString.pl filename OldString NewString\n";
print " example: perl ReplaceString.pl intelliquest.txt ";
print "IntelliQuest Kantar > kantar.txt\n";
exit 0;
}
$OldString = $ARGV[1];
$NewString = $ARGV[2];
open(MYFILE,$ARGV[0]) || die "Cannot open file \"$ARGV[0]\"";
while( $line = <MYFILE> ) {
chomp $line;
$line =~ s/$OldString/$NewString/g;
print "$line\n";
}
I take it your taking lessons and learning Perl.
I'm just curious where you're learning Perl. This is syntax I would expect to see back in the old Perl 3.x days. Perl has advanced quite a bit since then, and I would think your teacher would help you with the newer style of syntax.
There are some errors in my Perl script, I looked though the source code but couldn't find the problem.
#Tool: decoding shell codes/making shell codes
use strict;
use Getopt::Std;
my %opts=();
getopts("f:xa", \%opts);
my($infile, $hex);
my($gen_hex, $gen_ascii);
sub usage() {
print "$0 -f <file> [-x | -a] \n\t";
print '-p <path to input file>'."\n\t";
print '-x convert "\nxXX" hex to readable ascii'."\n\t";
print '-a convert ascii to "\xXX" hex'."\n\t";
print "\n";
exit;
}
$infile = $opts{f};
$gen_hex = $opts{a};
$gen_ascii = $opts{x};use
if((!opts{f} || (!$gen_hex && !$gen_ascii)) {
usage();
exit;
}
if($infile) {
open(INFILE,$infile) || die "Error Opening '$infile': $!\n";
while(<INFILE>) {
#Strips newlines
s/\n/g;
#Strips tabs
s/\t//g;
#Strips quotes
s/"//g;
$hex .= $_;
}
}
if($gen_ascii) {
# \xXX hex style to ASCII
$hex =~ s/\\x([a-fA-F0-9]{2,2})/chr(hex($1)/eg;
}
elsif ($gen_hex) {
$hex =~ s/([\W|\w)/"\\x" . uc(sprintf("%2.2x",ord($1)))/eg;
}
print "\n$hex\n";
if($infile) {
close(INFILE);
}
gives me the errors
Backslash found where operator expected at 2.txt line 36, near "s/\"
(Might be runaway multi-line // string starting on line 34)
syntax error at 2.txt line 25, near ") {"
syntax error at 2.txt line 28, near "}"
syntax error at 2.txt line 36, near "s/\"
syntax error at 2.txt line 41. nar "}"
Execution of 2.txt aborted due to compilation errors
Do you see the problems?
#Strips newlines
s/\n/g;
Is wrong. You forgot an extra /:
#Strips newlines
s/\n//g;
Also, there are too few parenthesis here:
if((!opts{f} || (!$gen_hex && !$gen_ascii)) {
Rather than add some, you appear to have one extra one. Just take it out.
As a side note, try to use warnings; whenever possible. It's a Good Thing™.
EDIT: While I'm at it, you might want to be careful with your open()s:
open(INPUT,$input);
can be abused. What if $input is ">file.txt"? Then open() will try to open the file for writing - not what you want. Try this instead:
open(INPUT, "<", $input);
There are many errors: trailing use, missing / in s operator, unbalanced brackets in if expression. Little bit tidy up:
use strict;
use Getopt::Std;
my %opts = ();
getopts( "f:xa", \%opts );
my ( $gen_hex, $gen_ascii );
sub usage() {
print <<EOU
$0 -f <file> [-x | -a]
-p <path to input file>
-x convert "\\xXX" hex to readable ascii
-a convert ascii to "\\xXX" hex
EOU
}
#ARGV = ( $opts{f} ) if exists $opts{f};
$gen_hex = $opts{a};
$gen_ascii = $opts{x};
if ( not( $gen_hex xor $gen_ascii ) ) {
usage();
exit;
}
my $transform = $gen_ascii
? sub {
s/\\x([a-fA-F0-9]{2,2})/pack'H2', $1/eg;
}
: sub {
s/([^[:print:]])/'\\x'.uc unpack'H2', $1/eg;
};
while (<>) {
s/\n #Strips newlines
| \t #Strips tabs
| " #Strips quotes
//xg;
&$transform;
print;
}
line25: if((!opts{f} || (!$gen_hex && !$gen_ascii)) {
line26: usage();
It's $opts{f}
Actually, I think the error is here :
s/"//g;
The double quotes should be escaped, so that the line would become :
s/\"//g;
You can notice that this is the line the syntax highlighting goes wrong on SO.