I'm entirely new to powershell and regex stuff, but i need help to do the following:
I need to replace 'VALUE' in a file given that i know the strings before and after it. It runs over multiple lines as well. eg:
<knownvalue1>
<knownvalue2>VALUE<knownvalue3>
knownvalue 2 and 3 are not unique so i need to include the knownvalue1 as the kind of 'identifier'
Also, To keep in a similar format as what has been previously done it needs to be along the lines of:
(gc $filename)-replace "(SEARCHPATTERN)","(REPLACEVAL)" | sc $filename
if you can't do it this way, then alternative ways will be okay.
I'm going crazy over this one so any help would be great.
Thanks.
Well, When you're importing the file and reading line for line you could split the line up like this:
Bassicly first we split it up on the delimiter > After doing so the string will be split up in these parts: <knownvalue2 and VALUE<knownvalue3 and (empty)
After that it would need to be split again on > however now that the string is in parts u need to split it on the parts. which makes it tricky.. and at the same time this is pretty dirty, atleast in my opinion..
$value = #()
$value += "<UniqueValue1>"
$value += "<knownvalue2>This Belongs to UniqueValue1<knownvalue3>"
$value += "</UniqueValue1>"
$value += "<UniqueValue2>"
$value += "<knownvalue2>This Belongs to UniqueValue2<knownvalue3>"
$value += "</UniqueValue2>"
[int]$count = 0
foreach($line in $value)
{
if($line.Equals("<UniqueValue1>"))
{
$parts = $value[($count + 1)].Split('>');
"Should be This Belongs to UnqiueValue1<knownvalue3"
$parts[1]
""
"Second Split"
$val = $parts[1].Split('<')
$val[0] + " #should be This belongs to UniqueValue1"
$val[1] + " #should be knownvalue3"
""
"Should be <knownvalue2"
$parts[0]
}
if($line.Equals("<UniqueValue2>"))
{
$parts = $value[($count + 1)].Split('>');
"Should be This belongs to UniqueValue2<knownvalue3"
$parts[1]
""
"Second Split"
$val = $parts[1].Split('<')
$val[0] + " #should be This Belongs to UniqueValue2"
$val[1] + " #should be knownvalue3"
""
"Should be <knownvalue2"
$parts[0]
}
"finished Reading line: $count"
$count++
}
Read the file as one string (gc outputs an array which is a very poor choice) and use a simple regex:
[IO.File]::ReadAllText($filename) -replace `
'(<knownvalue1>[\s\r\n]*<knownvalue2>)VALUE(<knownvalue3>)',
'$1(REPLACEVAL)$2'
Notes:
In PS3.0+ you can use (gc $filename -raw) instead of [IO.File]::ReadAllText($filename)
In case <knownvalue1>SKIP SOME OTHER TAGS<knownvalue2> to catch the SKIP section you can use <knownvalue1>(?s).*?<knownvalue2> to match any characters including newline (CR/LF).
Related
I am using a config file that contains some information as shown below.
User1:xyz#gmail.com
User1_Role:Admin
NAME:sdfdsfu4343-234324-ffsdf-34324d-dsfhdjhfd943
ID:xyz#abc-demo-test-abc-mssql
Password:rewrfsdv34354*fds*vdfg435434
I want to split each value from*: to newline* in my Powershell script.
I am using -split '[: \n]' it matches perfectly until there is no '' in the value. If there is an '*' it will fetch till that. For example, for Password, it matches only rewrfsdv34354. Here is my code:
$i = 0
foreach ($keyOrValue in $Contents -split '[: *\n]') {
if ($i++ % 2 -eq 0) {
$varName = $keyOrValue
}
else {
Set-Variable $varName $keyOrValue
}
}
I need to match all the chars after : to \n. Please share your ideas.
It's probably best to perform two separate splits here, it makes things easier to work out if the code is going wrong for some reason, although the $i % 2 -eq 0 part is a neat way to pick up key/value.
I would go for this:
# Split the Contents variable by newline first
foreach ($line in $Contents -split '[\n]') {
# Now split each line by colon
$keyOrValue = $line -split ':'
# Then set the variables based on the parts of the colon-split
Set-Variable $keyOrValue[0] $keyOrValue[1]
}
You could also convert to a hashmap and go from there, e.g.:
$h = #{}
gc config.txt | % { $key, $value = $_ -split ' *: *'; $h[$key] = $value }
Or with ConvertFrom-StringData:
$h = (gc -raw dims.txt) -replace ':','=' | ConvertFrom-StringData
Now you have convenient access to keys and values, e.g.:
$h
Output:
Name Value
---- -----
Password rewrfsdv34354*fds*vdfg435434
User1 xyz#gmail.com
ID xyz#abc-demo-test-abc-mssql
NAME sdfdsfu4343-234324-ffsdf-34324d-dsfhdjhfd943
User1_Role Admin
Or only keys:
$h.keys
Output:
Password
User1
ID
NAME
User1_Role
Or only values:
$h.values
Output:
rewrfsdv34354*fds*vdfg435434
xyz#gmail.com
xyz#abc-demo-test-abc-mssql
sdfdsfu4343-234324-ffsdf-34324d-dsfhdjhfd943
Admin
Or specific values:
$h['user1'] + ", " + $h['user1_role']
Output:
xyz#gmail.com, Admin
etc.
I have this string
my $word = "Chase_^%798(987%55,.#*&^*&Chase_$&^**&(()%%hjjlhh";
Desired output is
Chase_^%798(987%55,.#*&^*&
Chase_$&^**&(()%%hjjlhh
The string "Chase_" is the only clue using which I should separate them. Using split I lose the string "Chase_". Then I should concatenate them. I don't have the slightest idea of how to split it but also the string "Chase_" should be present.`
Use lookahead:
my $str = 'Chase_^%798(987%55,.#*&^*&Chase_$&^**&(()%%hjjlhh';
my #list = split(/(?=Chase_)/, $str);
say Dumper\#list;
Output:
$VAR1 = [
'Chase_^%798(987%55,.#*&^*&',
'Chase_$&^**&(()%%hjjlhh'
];
If you use grouping withing split's regex, you don't lose (single "o") it. Also, if you split on a string literal, not a pattern, there's no need to extract it:
#! /usr/bin/perl
use warnings;
use strict;
my $word = 'Chase_^%798(987%55,.#*&^*&Chase_$&^**&(()%%hjjlhh';
my #parts1 = split /(Chase_)/, $word;
for (my $i = 1; $i < $#parts1; $i += 2) {
print #parts1[ $i, $i + 1 ], "\n";
}
print "--------\n";
my #parts2 = split /Chase_/, $word;
print 'Chase_', $_, "\n" for #parts2[ 1 .. $#parts2 ];
I need to find match between two tab delimited files files like this:
File 1:
ID1 1 65383896 65383896 G C PCNXL3
ID1 2 56788990 55678900 T A ACT1
ID1 1 56788990 55678900 T A PRO55
File 2
ID2 34 65383896 65383896 G C MET5
ID2 2 56788990 55678900 T A ACT1
ID2 2 56788990 55678900 T A HLA
what I would like to do is to retrive the matching line between the two file. What I would like to match is everyting after the gene ID
So far I have written this code but unfortunately perl keeps giving me the error:
use of "Use of uninitialized value in pattern match (m//)"
Could you please help me figure out where i am doing it wrong?
Thank you in advance!
use strict;
open (INA, $ARGV[0]) || die "cannot to open gene file";
open (INB, $ARGV[1]) || die "cannot to open coding_annotated.var files";
my #sample1 = <INA>;
my #sample2 = <INB>;
foreach my $line (#sample1) {
my #tab = split (/\t/, $line);
my $chr = $tab[1];
my $start = $tab[2];
my $end = $tab[3];
my $ref = $tab[4];
my $alt = $tab[5];
my $name = $tab[6];
foreach my $item (#sample2){
my #fields = split (/\t/,$item);
if ( $fields[1] =~ m/$chr(.*)/
&& $fields[2] =~ m/$start(.*)/
&& $fields[4] =~ m/$ref(.*)/
&& $fields[5] =~ m/$alt(.*)/
&& $fields[6] =~ m/$name(.*)/
) {
print $line, "\n", $item;
}
}
}
On its surface your code seems to be fine (although I didn't debug it). If you don't have an error I cannot spot, could be that the input data has RE special character, which will confuse the regular expression engine when you put it as is (e.g. if any of the variable has the '$' character). Could also be that instead of tab you have spaces some where, in which case you'll indeed get an error, because your split will fail.
In any case, you'll be better off composing just one regular expression that contains all the fields. My code below is a little bit more Perl Idiomatic. I like using the implicit $_ which in my opinion makes the code more readable. I just tested it with your input files and it does the job.
use strict;
open (INA, $ARGV[0]) or die "cannot open file 1";
open (INB, $ARGV[1]) or die "cannot open file 2";
my #sample1 = <INA>;
my #sample2 = <INB>;
foreach (#sample1) {
(my $id, my $chr, my $start, my $end, my $ref, my $alt, my $name) =
m/^(ID\d+)\s+(\w+)\s+(\w+)\s+(\w+)\s+(\w+)\s+(\w+)\s+(\w+)/;
my $rex = "^ID\\d+\\s+$chr\\s+$start\\s+$end\\s+$ref\\s+$alt\\s+$name\\s+";
#print "$rex\n";
foreach (#sample2) {
if( m/$rex/ ) {
print "$id - $_";
}
}
}
Also, how regular is the input data? Do you have exactly one tab between the fields? If that is the case, there is no point to split the lines into 7 different fields - you only need two: the ID portion of the line, and the rest. The first regex would be
(my $id, my $restOfLine) = m/^(ID\d+)\s+(.*)$/;
And you are searching $restOfLine within the second file in a similar technique as above.
If your files are huge and performance is an issue, you should consider putting the first regular expressions (or strings) in a map. That will give you O(n*log(m)) where n and m are the number of lines in each file.
Finally, I have a similar challenge when I need to compare logs. The logs are supposed to be identical, with the exception of a time mark at the beginning of each line. But more importantly: most lines are the same and in order. If this is what you have, and it make sense for you, you can:
First remove the IDxxx from each line: perl -pe "s/ID\d+ +//" file >cleanfile
Then use BeyondCompare or Windiff to compare the files.
I played a bit with your code. What you wrote there was actually three loops:
one over the lines of the first file,
one over the lines of the second file, and
one over all fields in these lines. You manually unrolled this loop.
The rest of this answer assumes that the files are strictly tab-seperated and that any other whitespace matters (even at the end of fields and lines).
Here is a condensed version of the code (assumes open filehandles $file1, $file2, and use strict):
my #sample2 = <$file2>;
SAMPLE_1:
foreach my $s1 (<$file1>) {
my (undef, #fields1) = split /\t/, $s1;
my #regexens = map qr{\Q$_\E(.*)}, #fields1;
SAMPLE_2:
foreach my $s2 (#sample2) {
my (undef, #fields2) = split /\t/, $s2;
for my $i (0 .. $#regexens) {
$fields2[$i] =~ $regexens[$i] or next SAMPLE_2;
}
# only gets here if all regexes matched
print $s1, $s2;
}
}
I did some optimisations: precompiling the various regexes and storing them in an array, quoting the contents of the fields etc. However, this algorithm is O(n²), which is bad.
Here is an elegant variant of that algorithm that knows that only the first field is different — the rest of the line has to be the same character for character:
my #sample2 = <$file2>;
foreach my $s1 (<$file1>) {
foreach my $s2 (#sample2) {
print $s1, $s2 if (split /\t/, $s1, 2)[1] eq (split /\t/, $s2, 2)[1];
}
}
I just test for string equality of the rest of the line. While this algorithm is still O(n²), it outperforms the first solution roughly by an order of magnitude simply by avoiding braindead regexes here.
Finally, here is an O(n) solution. It is a variant of the previous one, but executes the loops after each other, not inside each other, therefore finishing in linear time. We use hashes:
# first loop via map
my %seen = map {reverse(split /\t/, $_, 2)}
# map {/\S/ ? $_ : () } # uncomment this line to handle empty lines
<$file1>;
# 2nd loop
foreach my $line (<$file2>) {
my ($id2, $key) = split /\t/, $line, 2;
if (defined (my $id1 = $seen{$key})) {
print "$id1\t$key";
print "$id2\t$key";
}
}
%seen is a hash that has the rest of the line as a key and the first field as a value. In the second loop, we retrieve the rest of the line again. If this line was present in the first file, we reconstruct the whole line and print it out. This solution is better than the others and scales well up- and downwards, because of its linear complexity
How about:
#!/usr/bin/perl
use File::Slurp;
use strict;
my ($ina, $inb) = #ARGV;
my #lines_a = File::Slurp::read_file($ina);
my #lines_b = File::Slurp::read_file($inb);
my $table_b = {};
my $ln = 0;
# Store all lines in second file in a hash with every different value as a hash key
# If there are several identical ones we store them also, so the hash values are lists containing the id and line number
foreach (#lines_b) {
chomp; # strip newlines
$ln++; # count current line number
my ($id, $rest) = split(m{[\t\s]+}, $_, 2); # split on whitespaces, could be too many tabs or spaces instead
if (exists $table_b->{$rest}) {
push #{ $table_b->{$rest} }, [$id, $ln]; # push to existing list if we already found an entry that is the same
} else {
$table_b->{$rest} = [ [$id, $ln] ]; # create new entry if this is the first one
}
}
# Go thru first file and print out all matches we might have
$ln = 0;
foreach (#lines_a) {
chomp;
$ln++;
my ($id, $rest) = split(m{[\t\s]+}, $_, 2);
if (exists $table_b->{$rest}) { # if we have this entry print where it is found
print "$ina:$ln:\t\t'$id\t$rest'\n " . (join '\n ', map { "$inb:$_->[1]:\t\t'$_->[0]\t$rest'" } #{ $table_b->{$rest} }) . "\n";
}
}
I'm tying to come up with some regex that will remove all space chars from a string as long as it's not inside of double quotes (").
Example string:
some string with "text in quotes"
Result:
somestringwith"text in quotes"
So far I've come up with something like this:
$str =~ /"[^"]+"|/g;
But it doesn't seem to be giving the intended result.
I'm honestly very new at perl and haven't had too much regexp experience. So if anyone willing to answer would also be willing to provide some insight into the why and how that would be great!
Thanks!
EDIT
String will not contain escaped "'s
It should actually always be formatted like this:
Some.String = "Some Value"
Result would be
Some.String="Some Value"
Here is a technique using split to separate the quoted strings. It relies on your data being consistent and will not work with loose quotes.
use strict;
use warnings;
my #line = split /("[^"]*")/;
for (#line) {
unless (/^"/) {
s/[ \t]+//g;
}
}
print #line; # line is altered
Basically, you split up the string in order to isolate the quoted strings. Once that is done, perform the substitution on all other strings. Since the array elements are aliased in the loop, substitutions are performed on the actual array.
You can run this script like so:
perl -n script.pl inputfile
To see the output. Or
perl -n -i.bak script.pl inputfile
To do in-place edit on inputfile, while saving backup in inputfile.bak.
With that said, I'm not sure what your edit means. Do you want to change
Some.String = "Some Value"
to
Some.String="Some Value"
Text::ParseWords is tailor-made for this:
#!/usr/bin/env perl
use strict;
use warnings;
use Text::ParseWords;
my #strings = (
q{This.string = "Hello World"},
q{That " string " and "another shoutout to my bytes"},
);
for my $s ( #strings ) {
my #words = quotewords '\s+', 1, $s;
print join('', #words), "\n";
}
Output:
This.string="Hello World"
That" string "and"another shoutout to my bytes"
Using Text::ParseWords means if you ever had to deal with quoted strings with escaped quotation marks in them, you'd be ready ;-)
Also, this sounds like you have a configuration file of some sort and you're trying to parse it. If that is the case, there are probably better solutions.
I suggest removing the quoted substrings using split and then recombining them with join after removing whitespace from the intermediate text.
Note that if the regex used for split contains captures then the captured values will also be included in the list returned.
Here's some sample code.
use strict;
use warnings;
my $source = <<END;
Some.String = "Some Value";
Other.String = "Other Value";
Last.String = "Last Value";
END
print join '', map {s/\s+// unless /"/; $_; } split /("[^"]*")/, $source;
output
Some.String= "Some Value";Other.String = "Other Value";Last.String = "Last Value";
I would simply loop through the string char by char. This way you can handle escaped strings too (just add an isEscaped variable).
my $text='lala "some thing with quotes " lala ... ';
my $quoteOpen = 0;
my $out;
foreach $char(split//,$text) {
if ($char eq "\"" && $quoteOpen==0) {
$quoteOpen = 1;
$out .= $char;
} elsif ($char eq "\"" && $quoteOpen==1) {
$quoteOpen = 0;
$out .= $char;
} elsif ($char =~ /\s/ && $quoteOpen==1) {
$out .= $char;
} elsif ($char !~ /\s/) {
$out .= $char;
}
}
print "$out\n";
Splitting on double quotes, removing spaces only from even fields (i.e. those in quotes):
sub remove_spaces {
my $string = shift;
my #fields = split /"/, $string . ' '; # trailing space needed to keep final " in output
my $flag = 1;
return join '"', map { s/ +//g if $flag; $flag = ! $flag; $_} #fields;
}
It can be done with regex:
s/([^ ]*|\"[^\"]*\") */$1/g
Note that this won't handle any kind of escapes inside the quotes.
I'm a student in an intro Perl class. I'm looking for suggestions on how to approach an assignment. My professor encourages forums. The assignment is:
Write a Perl program that will take two files from the command line, an enzyme file and a DNA file. Read the file with restriction enzymes and apply the restriction enzymes to the DNA file.
The output will be fragments of DNA arranged in the order they occur in the dna file. The name of the output files should be constructed by appending the name of the restriction enzyme to the name of the DNA file, with an underscore between them.
For example, if the enzyme is EcoRI and the DNA file is named BC161026, the output file should be named BC161026_EcoRI.
My approach is to create a main program and two subs as follows:
Main:
Not sure how to tie my subs together?
Sub program $DNA:
Take a DNA file and remove any new lines to make a single string
Sub program Enzymes:
Read and store the lines from the enzyme file which is from the command line
Parse the file in a way that it separates the enzyme acronym from the position of the cut.
Store the position of the cut as a regular expression in a hash table
Store the name of the acronym in a hash table
Note on enzyme file format:
The enzyme file follows a format known as Staden. Examples:
AatI/AGG'CCT//
AatII/GACGT'C//
AbsI/CC'TCGAGG//
The enzyme acronym consists of the characters before the first slash (AatI, in the first example. The recognition sequence is everything between the first and second slash (AGG'CCT, again, in the first example). The cut point is denoted by an apostrophe in the recognition sequence
There are standard abbreviations for dna within enzymes as follows:
R = G or A
B = not A (C or G or T)
etc...
Along with a recommendation for a main chunk, do you see any missing pieces that I've omitted? Can you recommend specific tools that you think would be useful in patching this program together?
Example input enzyme: TryII/RRR'TTT//
Example string to read: CCCCCCGGGTTTCCCCCCCCCCCCAAATTTCCCCCCCCCCCCAGATTTCCCCCCCCCCGAGTTTCCCCC
The output should be:
CCCCCCGGG
TTTCCCCCCCCCCCCAAA
TTTCCCCCCCCCCCCAGA
TTTCCCCCCCCCCGAG
TTTCCCCC
Ok, I know I shouldn't just do your homework, but there were some fun tricks to this one, so I played with it. Learn from this, not just copy. I didn't comment very well, so if there is something you don't understand, please ask. There is some slight magic in this that if you haven't covered it in your class, your prof will know, so be sure you understand.
#!/usr/bin/env perl
use strict;
use warnings;
use Getopt::Long;
my ($enzyme_file, $dna_file);
my $write_output = 0;
my $verbose = 0;
my $help = 0;
GetOptions(
'enzyme=s' => \$enzyme_file,
'dna=s' => \$dna_file,
'output' => \$write_output,
'verbose' => \$verbose,
'help' => \$help
);
$help = 1 unless ($dna_file && $enzyme_file);
help() if $help; # exits
# 'Main'
my $dna = getDNA($dna_file);
my %enzymes = %{ getEnzymes($enzyme_file) }; # A function cannot return a hash, so return a hashref and then store the referenced hash
foreach my $enzyme (keys %enzymes) {
print "Applying enzyme " . $enzyme . " gives:\n";
my $dna_holder = $dna;
my ($precut, $postcut) = ($enzymes{$enzyme}{'precut'}, $enzymes{$enzyme}{'postcut'});
my $R = qr/[GA]/;
my $B = qr/[CGT]/;
$precut =~ s/R/${R}/g;
$precut =~ s/B/${B}/g;
$postcut =~ s/R/${R}/g;
$postcut =~ s/B/${B}/g;
print "\tPre-Cut pattern: " . $precut . "\n" if $verbose;
print "\tPost-Cut pattern: " . $postcut . "\n" if $verbose;
#while(1){
# if ($dna_holder =~ s/(.*${precut})(${postcut}.*)/$1/ ) {
# print "\tFound section:" . $2 . "\n" if $verbose;
# print "\tRemaining DNA: " . $1 . "\n" if $verbose;
# unshift #{ $enzymes{$enzyme}{'cut_dna'} }, $2;
# } else {
# unshift #{ $enzymes{$enzyme}{'cut_dna'} }, $dna_holder;
# print "\tNo more cuts.\n" if $verbose;
# print "\t" . $_ . "\n" for #{ $enzymes{$enzyme}{'cut_dna'} };
# last;
# }
#}
unless ($dna_holder =~ s/(${precut})(${postcut})/$1'$2/g) {
print "\tHas no effect on given strand\n" if $verbose;
}
#{ $enzymes{$enzyme}{'cut_dna'} } = split(/'/, $dna_holder);
print "\t$_\n" for #{ $enzymes{$enzyme}{'cut_dna'} };
writeOutput($dna_file, $enzyme, $enzymes{$enzyme}{'cut_dna'}) if $write_output; #Note that $enzymes{$enzyme}{'cut_dna'} is an arrayref already
print "\n";
}
sub getDNA {
my ($dna_file) = #_;
open(my $dna_handle, '<', $dna_file) or die "Cannot open file $dna_file";
my #dna_array = <$dna_handle>;
chomp(#dna_array);
my $dna = join('', #dna_array);
print "Using DNA:\n" . $dna . "\n\n" if $verbose;
return $dna;
}
sub getEnzymes {
my ($enzyme_file) = #_;
my %enzymes;
open(my $enzyme_handle, '<', $enzyme_file) or die "Cannot open file $enzyme_file";
while(<$enzyme_handle>) {
chomp;
if(m{([^/]*)/([^']*)'([^/]*)//}) {
print "Found Enzyme " . $1 . ":\n\tPre-cut: " . $2 . "\n\tPost-cut: " . $3 . "\n" if $verbose;
$enzymes{$1} = {
precut => $2,
postcut => $3,
cut_dna => [] #Added to show the empty array that will hold the cut DNA sections
};
}
}
print "\n" if $verbose;
return \%enzymes;
}
sub writeOutput {
my ($dna_file, $enzyme, $cut_dna_ref) = #_;
my $outfile = $dna_file . '_' . $enzyme;
print "\tSaving data to $outfile\n" if $verbose;
open(my $outfile_handle, '>', $outfile) or die "Cannot open $outfile for writing";
print $outfile_handle $_ . "\n" for #{ $cut_dna_ref };
}
sub help {
my $filename = (split('/', $0))[-1];
my $enzyme_text = <<'END';
AatI/AGG'CCT//
AatII/GACGT'C//
AbsI/CC'TCGAGG//
TryII/RRR'TTT//
Test/AAA'TTT//
END
my $dna_text = <<'END';
CCCCCCGGGTTTCCCCCCC
CCCCCAAATTTCCCCCCCCCCCCAGATTTC
CCCCCCCCCGAGTTTCCCCC
END
print <<END;
Usage:
$filename --enzyme (-e) <enzyme-filename> --dna (-d) <dna-filename> [options] (files may come in either order)
$filename -h (shows this help)
Options:
--verbose (-v) print additional (debugging) information
--output (-o) output final data to files
Files:
The DNA file contains one DNA string which may be broken over many lines. E.G.:
$dna_text
The enzymes file constains enzyme definitions, one per line. E.G.:
$enzyme_text
END
exit;
}
Edit: Added cut_dna initialization explicitly because this is the final result holder for each enzyme, so I thought it would be good to see it more clearly.
Edit 2: Added output routine, call, flag and corresponding help.
Edit 3: Changed main routine to incorporate the best of canavanin's method while removing loops. Now its a global replace to add temporary cut mark (') and then split on cut mark into array. Left old method as comment, new method is the 5 lines following.
Edit 4: Additional test case for writing to multiple files. (Below)
my #names = ('cat','dog','sheep');
foreach my $name (#names) { #$name is lexical, ie dies after each loop
open(my $handle, '>', $name); #open a lexical handle for the file, also dies each loop
print $handle $name; #write to the handle
#$handles closes automatically when it "goes out of scope"
}
Note that in Enzymes, when you store an enzyme in the hash the name of the enzyme should be the key and the site should be the value (since in principle two enzymes could have identical sites).
In the Main routine, you can iterate through the hash; for each enzyme produce one output file. The most direct way is to translate the site to a regex (by means of other regexs) and apply it to the DNA sequence, but there are other ways. (It is probably worth splitting this off into at least one other sub.)
Here is how I have gone about trying to solve the problem (code below).
1) The file names are picked up from the arguments and respective filehandles are created.
2) A new file handle is created for the output file which in the specified format
3) The "cut points" are extracted from the first file
4) The DNA Sequences in the second file are looped over the cut points obtained in step 3.
#!/usr/bin/perl
use strict;
use warnings;
my $file_enzyme=$ARGV[0];
my $file_dna=$ARGV[1];
open DNASEQ, ">$file_dna"."_"."$file_enzyme";
open ENZYME, "$file_enzyme";
open DNA, "$file_dna";
while (<ENZYME>) {
chomp;
if( /'(.*)\/\//) { # Extracts the cut point between ' & // in the enzyme file
my $pattern=$1;
while (<DNA>) {
chomp;
#print $pattern;
my #output=split/$pattern/,;
print DNASEQ shift #output,"\n"; #first recognized sequence being output
foreach (#output) {
print DNASEQ "$pattern$_\n"; #prefixing the remaining sequences with the cut point pattern
}
}
}
}
close DNA;
close ENZYME;
close DNASEQ;
I know there have been several answers already, but hey... I just felt like trying my luck, so here's my suggestion:
#!/usr/bin/perl
use warnings;
use strict;
use Getopt::Long;
my ($enz_file, $dna_file);
GetOptions( "e=s" => \$enz_file,
"d=s" => \$dna_file,
);
if (! $enz_file || ! $dna_file) {
# some help text
print STDERR<<EOF;
Usage: restriction.pl -e enzyme_file -d DNA_file
The enzyme_file should contain one enzyme entry per line.
The DNA_file may contain the sequence on one single or on
several lines; all lines will be concatenated to yield a
single string.
EOF
exit();
}
my %enz_and_patterns; # stores enzyme name and corresponding pattern
open ENZ, "<$enz_file" or die "Could not open file $enz_file: $!";
while (<ENZ>) {
if (m#^(\w+)/([\w']+)//$#) {
my $enzyme = $1; # could also remove those two lines and use
my $pattern = $2; # the match variables directly, but this is clearer
$enz_and_patterns{$enzyme} = $pattern;
}
}
close ENZ;
my $dna_sequence;
open DNA, "<$dna_file" or die "Could not open file $dna_file: $!";
while (my $line = <DNA>) {
chomp $line;
$dna_sequence .= $line; # append the current bit to the sequence
# that has been read so far
}
close DNA;
foreach my $enzyme (keys %enz_and_patterns) {
my $dna_seq_processed = $dna_sequence; # local copy so that we retain the original
# now translate the restriction pattern to a regular expression pattern:
my $pattern = $enz_and_patterns{$enzyme};
$pattern =~ s/R/[GA]/g; # use character classes
$pattern =~ s/B/[^A]/g;
$pattern =~ s/(.+)'(.+)/($1)($2)/; # remove the ', but due to the grouping
# we "remember" its position
$dna_seq_processed =~ s/$pattern/$1\n$2/g; # in effect we are simply replacing
# each ' with a newline character
my $outfile = "${dna_file}_$enzyme";
open OUT, ">$outfile" or die "Could not open file $outfile: $!";
print OUT $dna_seq_processed , "\n";
close OUT;
}
I've tested my code with your TryII example, which worked fine.
As this is a task which can be handled by writing just a few lines of non-repetitive code I didn't feel creating separate subroutines would have been justified. I hope I will be forgiven... :)