#!/usr/bin/perl

# Cutter1_3.pl
# Version: 1.3
# 31.01.2003
# Sonja Prohaska (Paul Perco)
# cuts a sequence at specified positions
# and writes the substrings in fasta format to an outputfile
#
# Input: Sequence in fasta format
#        position of first cut [integer]
#        position of second cut [integer || "end" for last position of sequence]
#        outputfilename
#        a fasta-header name
#
# Output: outputfile (with specified outputfilename)
#         in fasta format (with specified fasta-header) and with '.fa' extention


# Program Usage
die "usage: Cutter1_3.pl READ_GENBANK_FILE\n" .
    "       Cutter1_3.pl sequence cutstart cutend outputfile fastaheader\n"
    unless (@ARGV == 1 ||  @ARGV == 4 || @ARGV == 5);

if (@ARGV == 5) {
  my ($sequence, $cutstart, $cutend, $output, $fastaheader) = @ARGV;
  cut_fasta($sequence, $cutstart, $cutend, $output, $fastaheader);
}

elsif (@ARGV == 4) {
  my ($sequence, $cutstart, $cutend, $output) = @ARGV;
  cut_fasta($sequence, $cutstart, $cutend, $output, $output);
}
else {
  while (<>){
    ($sequence, $cutstart, $cutend, $output, $fastaheader) = split;
    cut_fasta($sequence, $cutstart, $cutend, $output, $fastaheader);
  }
}

exit;

#---------------------------------------------------
# Methods - Functions - or whatever they are called
#---------------------------------------------------

sub cut_fasta
{
  my ($sequence, $cutstart, $cutend, $output, $fastaheader) = @_;

  my $string = fasta2string($sequence);
  my $len = length($string);
  
  # if cutting positions are given as negative integers
  # positions are determined from the end 
  if ($cutstart =~ /^-/) {
    $cutstart = $len + $cutstart +1;
  }
  if ($cutend =~ /^-/){
    $cutend = $len + $cutend +1;
  }
 
  # if cutend is given as 'end'
  # cutend equals the lenght of the sequence
  if ($cutend eq "end"){$cutend = $len;}
 
  foreach my $pos ($cutstart, $cutend) {
    die "Exit c1: Cut position $pos out of bounds (length= $len)!\n" . 
	"         $sequence $cutstart $cutend $output $fastaheader\n"
	if ($pos > $len);
  }

  if ($cutstart > $cutend) {
    die "Exit c2: cutstart ($cutstart) bigger then cutend ($cutend)!\n";
  } 

  # cut the sequence at the given positions and
  # write the fragment out as fasta
  my $substream = substr($string,$cutstart-1,($cutend-$cutstart)+1); # correct!
  my $fasta_header = build_fasta_header($fastaheader);
  string2fasta($substream,$fasta_header, "$output.fa");

  return 1;
}

sub fasta2string
{
  my ($fastafilename)=shift;
  open (SEQFILE, '<', $fastafilename) or
      die "Exit c3: Can\'t find/read SEQUENCEFILE \'$fastafilename\'!\n";
  my $fasta_header = <SEQFILE>;
  die "Exit c3: \'$fastafilename\' is not a fasta file!\n"
      unless (check_fasta_header($fasta_header));
  my $seq;
  while (<SEQFILE>)
  {
    chomp;
    my @seq = split;
    $seq .= join('', @seq);
  }
    
  #control if string is composed of valid letters
  #com# -> insert here

  close(SEQFILE);
  return $seq;
}


sub string2fasta
{
  my($string, $fasta_header, $filename)=@_;
  open (FASTAFILE, '>', $filename) or die "Exit c4: Can't open \'$filename\'!";
  print FASTAFILE "$fasta_header\n";
  while(length($string)>60)
  {
    my $line = substr($string, 0, 60, '');
    print FASTAFILE "$line\n";
  }
  print FASTAFILE "$string\n";
  close(FASTAFILE);
  return 1;
}

sub check_fasta_header
{
  chomp (my $fasta_header = shift);
  if ($fasta_header =~ m/^>/) { return 1 }
  else { return 0 }
}

sub build_fasta_header
{
  my @header = @_;
  my $fasta_header = '> ';
  $fasta_header .= join(', ', @header);
  return $fasta_header;
}


