search and replace between two files -post#2 - regex

Question

I need to replace a variable in one file with information/regex found in another file. For example, I need to grab the first string/variable (that starts with MSTRG) from each row in file1:
MSTRG.5734 MSTRG.5734 509 -4 0 -14 0 0
MSTRG.19266 MSTRG.19266 842 -4 0 -12 0 0
MSTRG.26588 MSTRG.26588 196 5 0 12 0 0
and use this to search in file2 that will look something like this:
Chr1 StringTie transcript 24039360 24041181 1000 - . gene_id "MSTRG.5734"; transcript_id "MSTRG.5734.1";
Chr1 StringTie transcript 24039810 24040595 1000 - . gene_id "MSTRG.5734"; transcript_id "Transcript:AT1G64700.1"; ref_gene_id "Gene:AT1G64700"
Chr1 StringTie exon 24040560 24041181 1000 - . gene_id "MSTRG.19266"; transcript_id "MSTRG.19266.1"; exon_number "2";
Chr1 StringTie exon 24040560 24041181 1000 - . gene_id "MSTRG.26588"; transcript_id "MSTRG.26588.1"; exon_number "2";
Chr1 StringTie transcript 24039810 24040595 1000 - . gene_id "MSTRG.26588"; transcript_id "Transcript:AT5G41000.1"; ref_gene_id "Gene:AT5G41000";
Ideally when e.g. MSTRG.5734 is found on a line in file2 that also contains the string e.g. Gene:AT1G64700, it will grab the information Gene:AT1G64700 and replace MSTRG.5734 in file1. So, every MSTRG on each row in file1 is unique and it will theoretically match a unique Gene in file2. If it does not match a Gene then I need the original row in file1 to be maintained.
File1 output should then look like:
Gene:AT1G64700 MSTRG.5734 509 -4 0 -14 0 0
MSTRG.19266 MSTRG.19266 842 -4 0 -12 0 0
Gene:AT5G41000 MSTRG.26588 196 5 0 12 0 0
My current perl code is:
use strict;
use warnings;
use vars qw($outfile #id $mstrg $gene);
open(SEARCH, $ARGV[0]) or die "Couldn't open $ARGV[0]: $!";
open(FILE, $ARGV[1]) or die "Couldn't open $ARGV[1]: $!";
$outfile = "testout.txt";
open (OUT, ">$outfile") || die "Can't open $outfile for creation: $!\n";
my %mstrg;
while (<SEARCH>) {
chomp;
if (/^MSTRG/) {
chomp $_;
#id = split (/\t/, $_);
$mstrg{$id[1]}.="$id[1]";
}
}
while (<FILE>) # {#ffn=<FILE>};
{
chomp ($gene=$_);
if ($mstrg =~ /$gene/) {
print OUT "$id[1]\t$id[2]";}
else {
#print OUT "$_\n";
}
next;
}
close FILE;
This is unfortunately where I get stuck and not sure how to proceed?
Thanks for any help given, appreciated and apologies for the previous post where I did not include any code to those that saw.

Answer 1

I would do this somewhat like:
use 5.014; #needed min 5.014 because the /r modifier
use warnings;
use Path::Tiny '0.077'; #added the min. req. version
my $file1='file1.txt';
my $file2='file2.txt';
my %mstmap = map { split /\s+/, s/.*?gene_id\s*"\s*(MSTRG\.\d+).*ref_gene_id\s*"\s*(Gene:\w+)".*/$1 $2/r }
grep { /ref_gene_id.*Gene:/ } path($file2)->lines({chomp => 1});
path($file1)->edit_lines( sub { s/^(MSTRG\.\d+)/exists($mstmap{$1}) ? $mstmap{$1} : $1/e });
for your input files produces
Gene:AT1G64700 MSTRG.5734 509 -4 0 -14 0 0
MSTRG.19266 MSTRG.19266 842 -4 0 -12 0 0
Gene:AT5G41000 MSTRG.26588 196 5 0 12 0 0
It create a hash for the pairs: MSTRG.number => Gene:String (from the file2), and using the Path::Tiny module editing fucntion doing the replaces in the file1.
After #Borodin comments the above could be reduced to:
use 5.014;
use warnings;
use Path::Tiny '0.077';
my $file1='f1';
my $file2='f2';
my %mstmap = map {
/.*?gene_id\s*"\s*(MSTRG\.\d+).*ref_gene_id\s*"\s*(Gene:\w+).*/
} path($file2)->lines({chomp => 1});
path($file1)->edit_lines( sub { s/^(MSTRG\.\d+)/exists($mstmap{$1}) ? $mstmap{$1} : $1/e });

Answer 2

There's no need to write impregnable code to achieve the result you want
This program reads through $file2 building hash %mstrg from all the lines that contain both an MSTRG. and a Gene: string. It then creates a regex in $re that will match any one of the MSTR. strings found
$file1 is opened, and that regex is used to replace any of the hash keys with the corresponding hash value it appears at the start of the line. The line is then printed
It isn't clear whether the first two fields of file1.txt are always the same, but I've opted to alter only the first field
I've used the autodie pragma to avoid having to explicitly check for success of any file IO operations
The program prints the output to STDOUT, so you can redirect it wherever you like on the command line
use strict;
use warnings 'all';
use autodie;
my ( $file1, $file2 ) = #ARGV;
my %mstrg;
{
open my $fh, '<', $file2;
while ( <$fh> ) {
$mstrg{$1} = $2 if /"(MSTRG.\d+)".*"(Gene:\w+)"/;
}
}
my $re = join '|', sort { length $b <=> length $a } keys %mstrg;
open my $fh, '<', $file1;
while ( <$fh> ) {
s/^($re)\b/$mstrg{$1}/;
print;
}
output
Gene:AT1G64700 MSTRG.5734 509 -4 0 -14 0 0
MSTRG.19266 MSTRG.19266 842 -4 0 -12 0 0
Gene:AT5G41000 MSTRG.26588 196 5 0 12 0 0