#!/usr/bin/perl -w
use strict;
use English;

# For pre 5.6 users.
use vars qw(%patterns @lengths $buf);

my $usage =<<END_USAGE_MESSAGE;
Usage: $0 patternfile dnafile [minmatches]
    patternfile    File containing one search string per line.
    dnafile        File containing DNA data.
    minmatches
END_USAGE_MESSAGE

die $usage if @ARGV < 2;

# check_for_matches - Finds matching patterns in our buffer.
# Accesses: %patterns, @lengths, and $buf
# Modifies: %patterns
#
sub check_for_matches {
    for (@lengths) {
        my $check = substr($buf,0,$_);
        $patterns{$check}++ if exists $patterns{$check};
    }
}


# Read in the patterns first. We require that all patterns can fit in memory.

open(PATS, $ARGV[0]) or die "Couldn't open $ARGV[0]: $!";
while (<PATS>) {
    chomp;
    $patterns{$_} = 0;
}
close PATS;


# Determine pattern lengths.

my %lengths;
$lengths{length($_)}++ for keys %patterns;
@lengths      = sort {$a<=>$b} keys %lengths;
my $minlength = $lengths[0];
my $maxlength = $lengths[-1];


# Prepare to sift through the DNA data.
open(DNA, $ARGV[1]) or die "Couldn't open $ARGV[1]: $!";

# We will be reading one character at a time.
$INPUT_RECORD_SEPARATOR = \1;

# Read data, check for matches, resize our buffer.
while (my $c = <DNA>) {
    next if $c eq "\n";
    $buf .= $c;
    next if length($buf) < $maxlength;
    check_for_matches();
    $buf = substr($buf,1);
}

# We need to continue checking for matches near the end.
while ($buf = substr($buf,1) and length($buf) >= $minlength) {
    check_for_matches();
}

# Finally, we output the patterns which matched more than once.
for (sort keys %patterns) {
    print "$_\n" if $patterns{$_} > 1;
}