#!/usr/bin/perl -w
use POSIX;
use Getopt::Long qw(:config bundling require_order auto_version);
use Pod::Usage;
use FAST;
use FAST::Bio::SeqIO;
use strict;
#no warnings 'once';

use vars qw($VERSION $DESC $NAME $COMMAND $DATE);
$VERSION = $FAST::VERSION; 
$DESC    = "character-based transformations on sequences";
$NAME    = $0;
$NAME    =~ s/^.*\///;
$COMMAND = join " ",$NAME,@ARGV;
$DATE = POSIX::strftime("%c",localtime());

use constant { true => 1, false => 0 };

## DEFAULT OPTION VALUES
my $def_format  = $FAST::DEF_FORMAT;  #7/1/13 "fasta";
my $def_logname = $FAST::DEF_LOGNAME; #7/1/13 "FAST.log.txt";
my $def_join_string = $FAST::DEF_JOIN_STRING;

## OPTION VARIABLES
my $man                  = undef;  # --man
my $help                 = undef;  # -h
my $moltype              = undef;  # -m, in case bioperl can't tell
my $format               = $def_format;  # --format
my $log                  = undef;        # -l
my $logname              = $def_logname; # -L
my $comment              = undef;        # -C
my $sequence             = undef; # -s
my $description          = undef; # -d
my $delete               = undef; # -D
my $squash               = undef; # -S
my $no_replace           = undef; # -n
my $complement           = undef; # -c
my $annotate             = undef; # -a
my $join                 = $def_join_string; #-j
my $degap                = undef; # --degap
my $strict               = undef; # --strict implies "-sc $strict_symbols{$moltype} ($ambig_char || $ambig{$moltype})"
my $iupac                = undef; # --iupac  implies "-sc $iupac_symbols{$moltype} ($ambig_char || $ambig{$moltype})"
my $ambig_char           = undef; # -N/-X

my %strict_symbols       = ();
my %iupac_symbols        = ();
my %ambig                = ();
my $fastq                = undef;

## TO GO INTO DICTIONARY
$strict_symbols{'dna'}     = 'ACTGactg\-';
$iupac_symbols{'dna'}      = 'ACTGactgMRWSYKVHDBXNmrwsykvhdbxn\-';
$strict_symbols{'rna'}     = 'ACUGacug\-';
$iupac_symbols{'rna'}      = 'ACUGacugMRWSYKVHDBXNmrwsykvhdbxn\-';
$strict_symbols{'protein'} = 'ACDEFGHIKLMNPQRSTVWYacdefghiklmnpqrstvwy\-';
$iupac_symbols{'protein'}  = 'ACDEFGHIKLMNPQRSTVWYacdefghiklmnpqrstvwyBZX\.bzx\*\-';

$ambig{'dna'}              = 'N';
$ambig{'rna'}              = 'N';
$ambig{'protein'}          = 'X';

GetOptions('help|h'         		 => \$help, 
	   'man'            		 => \$man,
	   'moltype|m=s'                 => sub{  my (undef,$val) = @_; 
						  die "$NAME: --moltype or -m option argument must be \"dna\", \"rna\" or \"protein\"\n" 
						    unless $val =~ /dna|rna|protein/i; 
						  $moltype = $val;
						},
	   'format=s'                    => \$format,
	   'log|l'                       => \$log,
	   'logname|L=s'                 => \$logname,
	   'comment|C=s'                 => \$comment,
	   'delete|D'                    => \$delete,
	   'squash|S'                    => \$squash,
	   'complement|c'                => \$complement,
	   'strict'                      => \$strict,
	   'iupac'                       => \$iupac,
	   'degap'                       => \$degap,
	   'sequence|s'                  => \$sequence,
	   'description|d'               => \$description,
	   'ambig|N|X=s'                   => sub{  my (undef,$val) = @_; 
						  die "$NAME: --ambig/-N/-X option arg must be length 1.\n" 
						    unless (length $val == 1); 
						  $ambig_char = $val;
						},
           'no-replace|n'                => \$no_replace,
           'q|fastq'                     => sub {$format = 'fastq'},
	  ) 
  or pod2usage(2);

my $iupac_or_strict  = ($iupac  || $strict );
my $delete_or_squash = ($delete || $squash);
		  
pod2usage(-verbose => 1) if $help;
pod2usage(-verbose => 2) if $man;
my $fromSTDIN = ((-t STDIN) ? false : true);

pod2usage("$NAME: with --strict or --iupac, no other options except --ambig, --fastq, or FAST generic options are allowed.\n")      
  if ( ($iupac_or_strict) &&  ($delete_or_squash || $complement || $description || $sequence || $no_replace || $degap));  
pod2usage("$NAME: with --degap, no other options except --fastq, or FAST generic options allowed.\n")      
  if ( ($degap) &&  ($iupac_or_strict || $delete_or_squash || $complement || $description || $sequence || $no_replace ));  
pod2usage("$NAME: expects 2 arguments, 1 with --no-replace/-n, if input on STDIN.\n")        if (!(-t STDIN) && !($iupac_or_strict || $degap) && !($no_replace) && @ARGV != 2);
pod2usage("$NAME: expects >= 3 arguments, 2 with --no-replace/-n, if input from file\n")     if ( (-t STDIN) && !($iupac_or_strict || $degap) && !($no_replace) && @ARGV  < 3);
pod2usage("$NAME: expects 1 argument with --no-replace/-n if input on STDIN.\n")          if (!(-t STDIN) && !($iupac_or_strict || $degap) &&  ($no_replace) && @ARGV != 1);
pod2usage("$NAME: expects >= 2 arguments with --no-replace/-n if input from file\n")         if ( (-t STDIN) && !($iupac_or_strict || $degap) &&  ($no_replace) && @ARGV  < 2);
pod2usage("$NAME: with --strict, --iupac or --degap expects zero arguments if input on STDIN.\n")          if (!(-t STDIN) &&  ($iupac_or_strict || $degap) && @ARGV  > 0);
pod2usage("$NAME: with --strict, --iupac or --degap expects at least one argument if input from file.\n")  if ( (-t STDIN) &&  ($iupac_or_strict || $degap) && @ARGV == 0);

&FAST::log($logname, $DATE, $COMMAND, $comment, $fromSTDIN) if ($log); 

my ($selector,$type);
if ($iupac_or_strict) {
  $selector = "seq";
  $type = "sequence";
  $complement = 1;
}
elsif ($degap){
  $selector = "seq";
  $type = "sequence";
}
elsif ($sequence) {
  $selector = "seq";
  $type = "sequence";
}
elsif ($description) { 
  $selector = "desc";
  $type = "description";
}
else {
  $selector = "id";
  $type = "identifier";
}

my ($search,$replace); 
unless ($iupac_or_strict || $degap) {
  $search               = shift @ARGV;
  unless ($no_replace) {
    $replace              = shift @ARGV;
  }
  else {
    $replace              = "";
  }
      
}

my $OUT = FAST::Bio::SeqIO->newFh('-format' => $format);
my $IN;
unless (@ARGV) {
    if ($moltype) {
	$IN = FAST::Bio::SeqIO->new(-fh => *STDIN{IO}, '-format' => $format, '-alphabet' => $moltype);
    }
    else {
	$IN = FAST::Bio::SeqIO->new(-fh => *STDIN{IO}, '-format' => $format);
    }
}

while ($IN or @ARGV) {
  if (@ARGV) {
    my $file = shift (@ARGV);
    unless (-e $file) {
      warn "$NAME: Could not find file $file. Skipping.\n";
      next;
    }
    elsif ($moltype) {
      $IN = FAST::Bio::SeqIO->new(-file => $file, '-format' => $format, '-alphabet' => $moltype);
    }
    else {
      $IN = FAST::Bio::SeqIO->new(-file => $file, '-format' => $format);
    }
  }
  if ($IN) { 
    while (my $seq = $IN->next_seq()) {
      my $data = $seq->$selector();
      $moltype ||= $seq->alphabet;
      if ($iupac_or_strict) { ## this needs to be here because moltype is set at runtime, most often automatically
	if ($strict) {
	  $search = $strict_symbols{$moltype};	  
	}
	else { # elsif ($iupac) 
	  $search = $iupac_symbols{$moltype};
	}
	$replace = $ambig_char || $ambig{$moltype};
      }
      elsif ($degap) {
	$delete = 1;
	$search = '-';
	$replace = "";
      }

      my $count;
      my @options = ();
      push @options, 'c' if ($complement);
      push @options, 'd' if ($delete);
      push @options, 's' if ($squash);
      my $options = join '',@options;
      eval sprintf "\$count = \$data =~ tr/%s/%s/%s", $search, $replace, $options; 
      die "$NAME: $@\n" if $@;
      $seq->$selector($data);
      # if ($append_info) {
      # 	$seq->desc(join ' ',$seq->desc(),"$NAME: $search|$replace|$options:$count");
      # }
      print $OUT $seq;
    }
    undef $IN;
  }
}



__END__

=head1 NAME

B<fastr> - character-based transformations on sequence records

=head1 SYNOPSIS

B<fastr>     [OPTION]... [SEARCHLIST] [REPLACELIST] [MULTIFASTA-FILE...]

B<fastr -n>  [OPTION]... [SEARCHLIST]               [MULTIFASTA-FILE...]

B<fastr --strict> [B<--ambig>=<char>]                  [MULTIFASTA-FILE...]

B<fastr --iupac>  [B<--ambig>=<char>]                  [MULTIFASTA-FILE...]

B<fastr --degap>                                       [MULTIFASTA-FILE...]

=head1 DESCRIPTION

B<fastr> takes multifasta format sequence or alignment data as input,
and faciliates character transliterations on identifiers (by default),
sequences or descriptions using the Perl B<tr///> character
transliteration operator. This faciliates character remapping, case
changes, character deletions, degapping, squashing of repeated
characters, and more. Special modes B<--strict>, B<--iupac>, and B<--degap> automatically direct transliterations on 
facilitate enforcement of sequence alphabets, and remapping illegal
characters to 'N' or 'X' or a user-defined character.

Options specific to B<fastr>:
  B<-s>, B<--sequence>         transliterate sequences
  B<-d>, B<--description>       transliterate descriptions  
  B<-D>, B<--delete>            delete found characters not replaced
  B<-S>, B<--squash>            squash duplicate replaced characters 
  B<-n>, B<--no-replace>        squash/delete characters in searchlist 
  B<-c>, B<--complement>        complement searchlist as a character set
  B<--strict>                map ambiguous/invalid nongap chars in sequences
  B<--iupac>                 map invalid nongap chars (to N/X by default)
  B<-N>, B<-X>, B<--ambig>=<char>  map ambig/invalid chars to <char>
  B<--degap>                 delete gap characters '-' 
  B<-a>, B<--annotate>          encodes transformation and count in description 
  B<-j>, B<--join>=<string>     use <string> to join data annotation

Options general to FAST:
  B<-h>, B<--help>                     print a brief help message
  B<--man>             	        print full documentation
  B<--version>                      print version
  B<-l>, B<--log>                      create/append to logfile	
  B<-L>, B<--logname>=<string>         use logfile name <string>
  B<-C>, B<--comment>=<string>         save comment <string> to log
  B<--format>=<format>              use alternative format for input  
  B<--moltype>=<[dna|rna|protein]>  specify input sequence type
  B<-q>, B<--fastq>                    fastq format for input and output

=head1 SEARCHLIST AND REPLACELIST

These arguments are strings of characters, or character ranges with
hyphens (like "A-Z" "0-9"), separated by the empty string. Characters
are remapped in corresponding order. If SEARCHLIST is longer than
REPLACELIST, the last character of REPLACELIST is repeated unless in
"delete-mode," in which case unmatched characters are deleted. In
"squash-mode" transliteration happens before squashing. With the
"no-replace" option, only SEARCHLIST is provided, no transliteration
occurs, and SEARCHLIST characters are directly squashed and
deleted. For more information see documentation for B<tr///> in the
B<perlop> manpage.

=head1 INPUT AND OUTPUT

B<fastr> is part of FAST, the FAST Analysis of Sequences Toolbox, based
on Bioperl. Most core FAST utilities expect input and return output in
multifasta format. Input can occur in one or more files or on
STDIN. Output occurs to STDOUT. The FAST utility B<fasconvert> can
reformat other formats to and from multifasta.

=head1 OPTIONS

=over 8

=item B<-s>
      B<--sequence>

Transliterate sequences (identifiers by default).

=item B<-d>
      B<--description>

Transliterate descriptions.
 
=item B<-D>
      B<--delete>

Delete found but unreplaced characters. 

=item B<-S>
      B<--squash>

Squash duplicate replaced characters.

=item B<-c>
      B<--complement>

Character complement SEARCHLIST. The last character of REPLACELIST
replaces all characters not in SEARCHLIST.

=item B<-n>
      B<--no-replace>

Delete or squash characters in SEARCHLIST. 

=item B<--strict>

Transliterate illegal sequence characters to "N" (DNA or RNA) or "X"
(protein). Takes precedence over B<--iupac>. Other options disallowed
in combination except B<--ambig> and B<--fastq>. For DNA, equivalent
to: C<fastr -sc ACTGactg\- N>

=item B<--iupac>

Transliterate illegal sequence characters (including IUPAC
ambiguities) to "N" (DNA or RNA) or "X" (protein). Other options
disallowed in combination except B<--ambig> and B<--fastq>. For DNA,
equivalent to:

C<fastr -sc ACTGactgMRWSYKVHDBXNmrwsykvhdbxn\- N>

=item B<--degap>

Delete gap characters "-" from each sequence. May only be combined
with no other option except the --fastq option. Equivalent to:

C<fastr -snD -- ->

=item B<-a>
      B<--ambig char>

Use <char> to replace illegal characters instead of "N" or "X" with
B<--strict> or B<--iupac>

=item B<-h>,
      B<--help>

Print a brief help message and exit.

=item B<--man>

Print the manual page and exit.

=item B<--version>

Print version information and exit.

=item B<-l>,
      B<--log>

Creates, or appends to, a generic FAST logfile in the current working
directory. The logfile records date/time of execution, full command
with options and arguments, and an optional comment.

=item B<-L [string]>,
      B<--logname=[string]>

Use [string] as the name of the logfile. Default is "FAST.log.txt".

=item B<-C [string]>,
      B<--comment=[string]>

Include comment [string] in logfile. No comment is saved by default.

=item B<--format=[format]> 		  

Use alternative format for input. See man page for "fasconvert" for
allowed formats. This is for convenience; the FAST tools are designed
to exchange data in Fasta format, and "fasta" is the default format
for this tool.

=item B<-m [dna|rna|protein]>,
      B<--moltype=[dna|rna|protein]> 		  

Specify the type of sequence on input (should not be needed in most
cases, but sometimes Bioperl cannot guess and complains when
processing data).

=item B<-q>
      B<--fastq>

Use fastq format as input and output.

=back

=head1 EXAMPLES

Change all bars "|" to hashes ("#") in IDs: 

=over 8

B<fastr> '|' '#' t/data/P450.fas

=back

Change all square brackets to parens in description:

=over 8

B<fastr> -d '[]' '()' t/data/P450.fas

=back

Lower-case all sequence data:

=over 8

B<fastr> -s 'A-Z' 'a-z' t/data/P450.fas

=back

Delete all bars "|" in GenBank IDs: 

=over 8

B<fastr> -D '|' '' t/data/P450.fas

B<fastr> -nD '|' t/data/P450.fas

=back

Delete all non-strict characters from a DNA sequence: 

=over 8

B<fastr> -nscD 'ACGT' t/data/P450.fas

=back

Control and check the function of B<--strict>: 

=over 8

C<fastr --strict t/data/ArdellEtAl03_ncbi_popset_32329588.fas | fascomp -t>
C<cat t/data/ArdellEtAl03_ncbi_popset_32329588.fas | fascomp -t>

=back

=head1 SEE ALSO

=over 8

=item C<man perlre>

=item C<perldoc perlre>

Documentation on perl regular expressions.

=item C<man FAST>

=item C<perldoc FAST>

Introduction and cookbook for FAST

=item L<The FAST Home Page|http://compbio.ucmerced.edu/ardell/FAST>"

=back 

=head1 CITING

If you use FAST, please cite I<Lawrence et al. (2015). FAST: FAST Analysis of
Sequences Toolbox.> and Bioperl I<Stajich et al.>. 

=cut
