trimmer

#!/usr/bin/env perl

# L I C E N S E ###############################################################
#    Copyright (C) 2011 Indraniel Das <indraniel@gmail.com>
#                       and Washington University in St. Louis
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 3 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, see <http://www.gnu.org/licenses/>

# U S A G E ##################################################################
# see the "A simple adaptive trimmer" section at the following 
# wikipage "https://github.com/indraniel/fqgrep/wiki" for example usage

# P R A G M A S ###############################################################
use warnings;
use strict;

# M O D U L E S ###############################################################
use Getopt::Long;

# V E R S I O N ###############################################################
our $VERSION = "0.1.1";

# M A I N #####################################################################
$| = 1;  # enable AUTOFLUSH mode
my %opts;
GetOptions(\%opts, "5-prime", "3-prime");

unless ( $opts{'5-prime'} || $opts{'3-prime'} ) {
    die "[err] $0 : Need a direction to trim from '--5-prime or --3-prime'!\n";
}

my $i = 0;
while (<>) {
    $i++;
    next if ($i == 1);  # skip first head line of statistics report

    chomp($_);
    my @cols = split("\t", $_);
    my ( $read_name, 
         $start_match_pos, 
         $end_match_pos, 
         $match_string,
         $sequence, $quality ) = @cols[0, 6, 7, 8, 9, 10];
    
    # When the fastq record did not have a pattern match
    if ($match_string eq '*') {
        print_fastq($read_name, $sequence, $quality);
        next;
    }

    # 5-prime end (right-side) read trimming
    if ($opts{'5-prime'}) {
        my ($trim_seq, $trim_qual) =
          trim_5_prime_end($sequence, $quality, $end_match_pos);
        print_fastq($read_name, $trim_seq, $trim_qual);
    }

    # 3-prime end (left-side) read trimming
    else {
        my ($trim_seq, $trim_qual) =
          trim_3_prime_end($sequence, $quality, $start_match_pos);
        print_fastq($read_name, $trim_seq, $trim_qual);
    }
}

exit(0);

# S U B R O U T I N E S #######################################################
sub print_fastq {
    my ($name, $seq, $qual) = @_;
    print "\@$name\n$seq\n+\n$qual\n";
}

sub trim_5_prime_end {
    my ($seq, $qual, $end_match_pos) = @_;
    my $seq_trim = substr($seq, $end_match_pos);
    my $qual_trim = substr($qual, $end_match_pos);
    return ($seq_trim, $qual_trim);
}

sub trim_3_prime_end {
    my ($seq, $qual, $start_match_pos) = @_;
    my $seq_trim = substr($seq, 0, $start_match_pos);
    my $qual_trim = substr($qual, 0, $start_match_pos);
    return ($seq_trim, $qual_trim);
}

__END__