#!/usr/bin/env perl
#  This script was generated by fastapl version 1.09

use IO::File;  # for ungetc()


my $usage  =  "Usage: $0 [fastaInputFile...]\n"
                  .  "$0  <  fastaInputFile";

#  Parameters normally read or configurable from fastapl command line
#  In this generated standalone program they are constants.'
my $validSeqChars_arg_  =  '-a-zA-Z';  #  Chars allowed in sequence, others are skipped.
my $seqLineLength_arg_   =  undef;  #  Otherwise, use this length if defined.
my $printSeqOn1Line_flag_  = undef;  #  If true, output sequences on one line.


# ----------  Open input and output files  ----------
my $os_  =  *STDOUT;   #  Output stream.
_standalone_parseArgvOptions();

my @fastaInputFilename_;  _setFastaInputFilenames();

# ----------  Declare variables intended for user  ----------

my $fs   = "'\t'"; # field separator used when computing @head.
my $head =     ""; # head line (line starting with '>').
my @head;          # head line after id, split by $fs into array.
my $id   = "";     # record id (non-white-space string following the '>').
my $comment = "";  #  record comment lines as single string (newlines included).
my $seq  = "";     # sequence as scalar.
# ----------   Private global variables  ----------


my $noHeadSeenYet_  =  'true';  #  no record has yet been seen?

my $commentAtStartOfStream = "";  #  Will hold comment lines at begining of stream;
                                  #  emptied after printed once by pr().
my $maxSeqLineLenSeen_ = 0;  #  Length of longest input sequence length seen so far.

for my $fastaInputFilename (@fastaInputFilename_){

    my $fastaInputStream;

    if(  $fastaInputFilename eq '-'  ){
        $fastaInputStream  =  *STDIN;
    }else{
        open( $fastaInputStream, '<', $fastaInputFilename )
            or  die(  "could not open fasta file '$fastaInputFilename', $!\n"  );
    }

    _processInputStream( $fastaInputStream );

}  # END:  for $fastaInputFilename (@fastaInputFilename_)




# ====================  End Main Program  ====================




#  Print input parsing error and exit.
sub _printInputError{
    my $message  =  shift;
    _printError(  'Input parsing error; '  .  $message  .  "\n"  );
    exit -1;
}


#  Print $message to STDERR and, if not connected to terminal, to $os_ as well.
sub _printError{
    my $message  =  shift;
    print STDERR $message;
    print $os_ "fastapl: $message"   unless(  -t $os_  );
}


#  Open and process each file found in global: @fastaInputFilename_.
sub _loopOverFastaInputFilenames{

    for my $fastaInputFilename (@fastaInputFilename_){

        my $fastaInputStream;

        if(  $fastaInputFilename eq '-'  ){
            $fastaInputStream  =  *STDIN;
        }else{
            open( $fastaInputStream, '<', $fastaInputFilename )
                or  die(  "could not open fasta file '$fastaInputFilename', $!\n"  );
        }

        _processInputStream( $fastaInputStream );

    }  # END:  for $fastaInputFilename (@fastaInputFilename_)

} # END: _loopOverFastaInputFilenames



#  Set @fastaInputFilename_ from @ARGV.
sub _setFastaInputFilenames{
    my $numStdinArgs  =  0;
    for my $filename (@ARGV){
        push  @fastaInputFilename_, $filename;
        if(  $filename eq '-'  ){
            if(  $numStdinArgs++  ){
                _printUsageError(  'STDIN given as input twice'  );
            }
            if(  -t *STDIN  ){
                _printUsageError(  'STDIN stipulated for input, but is attached to a terminal'  );
            }
        }
        else{  # filename ne '-'
            _looksLikeFastaFile( $filename )
                or  _printUsageError(  "file '$filename' is not a fasta file"  );
        }
    }

    if(  !@fastaInputFilename_  ){
        if(  -t *STDIN  ){
            my $m = "STDIN stipulated for input, but is attached to a terminal.\n"
                .   'Perhaps you forgot to give a fasta input file?';
            _printUsageError( $m );
        }
        push  @fastaInputFilename_, '-';  # no input arg given, so use STDIN.
    }
} #  END: _setFastaInputFilenames( filenames... )



#  Read records and run record script on contents of $fastaInputStream_
sub _processInputStream{
    my $fastaInputStream_  =  shift;

    my $line_;                #  Current input line.




    while(   $line_  =  <$fastaInputStream_>   ){

        if(  $line_ =~ /^#/  ){
            if(  $noHeadSeenYet_  ){   $commentAtStartOfStream  .=  $line_;   }
            else                   {   $comment                 .=  $line_;   }

            next;  #  Read Next Line.
        }

        chop $line_;

        #  ----------  $line is not a comment...

        if(  $line_ =~ /^>/  ){   # Start of new record.

            _printInputError( "record has no body. Head line is:\n$line_" )
                if(  _atEndOfRecord( $fastaInputStream_ )  );

            $noHeadSeenYet_  =  0;
            $head  =  substr $line_, 1;  #  remove '>'.
            ($id)  =  ( $head =~ /^ \s* (\S+) \s* (.*) $/x );
            @head  =   $2 ?  split( $fs, $2 )  :  ();

            next;  #  Read Next Line.
        }


        #  ----------  $line is from the body of a record...

        ++$numSeqLines_;

        $maxSeqLineLenSeen_  =   length( $line_ )
            if(   length( $line_ )  >  $maxSeqLineLenSeen_   );

        #  Append sequence in $line_ to $seq.
        $seq  .=  $line_;

        #  If record completely read in, process it.
        if(  _atEndOfRecord( $fastaInputStream_ )  ){

            $seq  =~ s/[^$validSeqChars_arg_]//g;

            $numSeqLines_
                or  _printInputError( "no sequence found in entry $id with head line\n>$head" );



                my $retVal  =  do{  #  User given record script
                    print $id, "\n";
                };




            #  -----  Reinitialize for next record  -----
            $comment = "";
            $head    = "";
            $seq     = "";
            $numSeqLines_  =  0;

        } # END:  if at end of record.

    }  # END:  while $line_ in fasta input stream.

} # END: _processInputStream( $fastaInputStream_ )



#  Return true iff $inputStream is at end of fasta record.
sub _atEndOfRecord{
    my $inputStream   =  shift;
    my $nextChar  =  getc $inputStream;

    if(  $nextChar  ){
        $inputStream->ungetc( ord $nextChar );
    }

    return(  !$nextChar  ||  $nextChar eq '>'  );
}



#  Print current fasta record to $os_
sub pr{

    # comments before first record are considered to belong to the stream, and are printed
    # exactly once, iff any part of the stream is printed.
    print $os_  $commentAtStartOfStream;
    $commentAtStartOfStream  = "";

    print $os_   ">$head\n$comment";

    _printSeq();
}



#  Print $seq with appropriate length lines.
sub _printSeq{

    my $on1Line  =  $printSeqOn1Line_flag_;


    if (  $on1Line  ){
        say $os_  $seq;
        return;
    }

    #  Else,
    _printSeqMultiline(   $seqLineLength_arg_
                          ||  $maxSeqLineLenSeen_
        );

} #  END: _printSeq()



#  Print $seq, wrapping lines at $lineLen characters.
sub _printSeqMultiline{
    my $lineLen  =  shift;

    my $seqLen       =  length $seq;

    my $numSeqLines  =  $seqLen / $lineLen;    # number of completely full lines.

    ++$numSeqLines  if(  $seqLen % $lineLen  );  # final line is only partially full.

    for my $i (   0 ..  $numSeqLines-1    ){
        say $os_  substr( $seq, $i * $lineLen, $lineLen );
    }

} #  END: _printSeqMultiline()


#  Return true iff file $filename appears to be a fasta file.
#  Determined heuristically by looking for a line starting with '>'.
sub _looksLikeFastaFile{
    my $filename  =  shift;
    open( my $file, '<', $filename )
        or  _printUsageError(  "could not open fasta file '$filename', $!\n"  );
    my $retVal = 0;

    while(  <$file>  ){
        if(  /^>/  ){   $retVal = 1;  last;   }
    }

    close $file;
    return $retVal;
}


#  Heuristically determine if $s looks like perl-code.
#  Only used for command line parsing error diagnostics.
sub _looksLikePerlCode{
    my $s  =  shift;
    return ( $s =~ /[\$@]/ );
}


#  Sets global $os_
sub _standalone_parseArgvOptions{
    my $usage = "$0 [-o outputFile] [fastInputFile...]\n";

    $ARGV[0]  or  return;  #  If no args given, do nothing.

    if(  $ARGV[0] =~ /^-o$|^--output-file$/  ){
        $ARGV[1]  or  die "output file missing\n$usage\n";
        _standalone_openOutStream( $ARGV[1] );
        splice( @ARGV, 0, 2 );
    }
}

#  open $os_
sub _standalone_openOutStream{
    my $outputFilename  =  shift;

    if(  $outputFilename  ){
        open $os_, '>', $outputFilename
            or   _printUsageError(  "could not open output file '$outputFilename'\n"  );
    }
}



#  Print $message to STDERR. If $os_ is a terminal print to $os_ as well.
sub _printUsageError{
    my $message  =  'Command line parsing error; '  .  $_[0]  .  "\n";
    print STDERR $message;
    print $os_ "$0: $message"   unless( -t $os_ );
    exit -1;
}
