UNIX for Dummies Questions & Answers

$ cat patterns.txt
pncA ^.*CCCGGGCAGTCGCCCGAACGTATGGTGGACGT|TGATGGCACCGCCGAACCGGGATGAACTGTTGGCGG.*$|^.*CCGCCAACAGTTCATCCCGGTTCGGCGGTGCCATCA|ACGTCCACCATACGTTCGGGCGACTGCCCGGG.*$ GTCTGGACACGTCGGCAATC|GATTGCCGACGTGTCCAGAC GTCTGGACACGTCGGCAATC
panD ^.*CACCAGGCTGCTGGACAACATTGCGATTGA|TAGCCGTGCTGCTGGCGATTGACGTCCGCAACACCCA.*$|^.*TGGGTGTTGCGGACGTCAATCGCCAGCAGCACGGCTA|TCAATCGCAATGTTGTCCAGCAGCCTGGTG.*$ TCAACGGTTCCGGTCGGCTGCT|AGCAGCCGACCGGAACCGTTGA TGGTCACCTACGCGATCACCGGCGAACGCGGCA
glpK ^.*GCTGCGGTGGACCATCATGGACGATTACATGCAGTGTCC|GACGTGTCCTAGCTTTCGCTGTGCGCCTGAACATGTCCGCA.*$|^.*TGCGGACATGTTCAGGCGCACAGCGAAAGCTAGGACACGTC|GGACACTGCATGTAATCGTCCATGATGGTCCACCGCAGC.*$ CGGCAAGCTGCAGTGGATCCTGGAA|TTCCAGGATCCACTGCAGCTTGCCG CGGCAAGCTGCAGTGGATCCTGGAA
pykA ^.*CGGCCCTACCGCCGTCGCGACTATGCTGAGTCGTCGTG|GACGTCTAGCCGGGTCGTGCCGGACGGTAAACCCATGTCC.*$|^.*GGACATGGGTTTACCGTCCGGCACGACCCGGCTAGACGTC|CACGACGACTCAGCATAGTCGCGACGGCGGTAGGGCCG.*$ CGTTGCCCGGAATGAACGTG|CACGTTCATTCCGGGCAACG CGTTGCCCGGAATGAACGTG

#!/usr/bin/perl
# xterra.pl
use strict;
use warnings;

my $settingsfile = shift or die "Missing settings file: $!\n";
open my $sfh, '<', $settingsfile or die "Could not open $settingsfile: $!\n";
my $fastafile = shift or die "Missing fasta file  $!\n";
open my $fh, '<', $fastafile or die "Could not open $fastafile: $!\n";
my %pattern;
my %genes;

while (<$sfh>) {
    chomp;
    my ($gene, $primers, $bait, $fwd) = split;
    @{$pattern{$gene}} = ($primers, $bait, $fwd);
    $genes{$gene} = undef;
}
close $sfh;

my %contig;
while (get_contig($fh, \%contig)) {
    find_gene(\%pattern, \%contig);
}
close $fh;

save_gene(\%genes);


sub save_gene {
    my ($results) = @_;
    for my $g (keys %$results) {
        print $results->{$g} if $results->{$g};
    }
}

sub find_gene {
    my ($test, $seq) = @_;
    for my $gene (keys %$test) {
        my $working_on;
        $working_on = $seq->{dna} if $seq->{dna} =~ /$test->{$gene}[1]/;
        if ($working_on) {
            $working_on =~ s/$test->{$gene}[0]//g;
        }
        else {
            next;
        }

        unless ($working_on =~ /$test->{$gene}[2]/) {
            $working_on =~ y/ACGT/TGCA/;
            $working_on = reverse $working_on;
        }
        $genes{$gene} = "\>$gene-$fastafile\n$working_on\n";
    }
}

sub get_contig {
    my ($fh, $seq) = @_;
    $seq->{label} = $seq->{next_label} if $seq->{next_label};
    my $done = 1;
    while (<$fh>) {
        $done = 0;
        next if /^\s*$/;
        chomp;
        if (/^>\w+/) {
            if ($seq->{label}) {
                $seq->{next_label} = $_;
                return $seq;
            }
            else {
                $seq->{label} = $_;
            }
        }
        else {
            s/\s+//;
            $seq->{dna} .= $_;
        }
    }
    unless ($done) {
        return $seq;
    }
    else {
        $seq->{label} = $seq->{dna} = $seq->{next_label} = undef;
        return;
    }
}