addIntronToEnsemblExons.pl

#!/usr/bin/perl -w
# Author: Abdullah Kahraman
# Date: 01.01.2000

###############################################################################
###############################################################################
### bla bla bla bla bla bla bla bla bla bla bla bla bla bla bla bla         ###
###############################################################################
###############################################################################

use strict;
use warnings;
use Getopt::Long;
no autovivification;

my (
    # variable for parameters which are read in from commandline
    $help,
    $hasHeader,
   );

##############################################################################
### read all needed parameters from commandline ##############################

&GetOptions(
    "help!"      => \$help,      # print this help
    "header!"    => \$hasHeader, # skip first line
) or die "\nTry \"$0 -h\" for a complete list of options\n\n";

##############################################################################

# help
if ($help) {printHelp(); exit}

##############################################################################
### SETTINGS #################################################################
##############################################################################
$| = 1;

##############################################################################
### SUBROUTINES ##############################################################
############################################################################## 

###############################################################################
sub printHelp {
###############################################################################
    # prints a help about the using and parameters of this scripts 
    # (execute if user types commandline parameter -h)
    # param:  no paramaters
    # return: no return value

    my (
	$usage,
	$sourceCode,
	@rows,
	$row,
	$option,
	$scriptInfo,
	$example,
       );

    $usage = "$0\n";


    print "\nUsage: " .  $usage . "\n";

    print "Valid options are:\n\n";
    open(MYSELF, "$0") or
      die "Cannot read source code file $0: $!\n";
    $sourceCode .= join "", <MYSELF>;
    close MYSELF;
    $sourceCode =~ s/^.+?\&GetOptions\(\n//s;
    $sourceCode =~ s/\n\).+$//s;
    @rows = split /\n/, $sourceCode;
    foreach $row (@rows){
        $option = $row;
	$option =~ s/\s+\"//g;
	$option =~ s/\"\s.+\#/\t\#/g;
	$option =~ s/=./\t<value> [required]/;
	$option =~ s/:./\t<value> [optional]/;
	$option =~ s/!/\t<non value> [optional]/;

	$row =~ s/^.*//;
	print "\t";
	printf("%-1s%-30s%-30s\n", "-",$option,$row);

    } # end of foreach $row (@rows)
    print "\n";
    print "Options may be abreviated, e.g. -h for --help\n\n";

    $example  = "$0";
}

##############################################################################
### END OF SUBROUTINES########################################################
############################################################################## 


############
### MAIN ###
############
my $end = "";
my $start = "";
my $preEnst = "";
my $preEnsp = "";
my $exonN = 1;
my $elementN = 1;
# print HEADER
my $header = <> if(defined $hasHeader);
my $exonPrinted = 0;
print "#GeneName\tENST\tENSP\tENSE\tOrder\tStrand\tChromosome\tStart\tEnd\tCDSlength\n";
while(my $l = <>) {
    chomp($l);
    my ($gene, $enst, $ensp, $ense, $strand, $chr, $eStart, $eEnd, $cdsLength, $utr5start, $utr5end, $utr3start, $utr3end) = split(/\t/, $l);

    $exonPrinted = 0;
    if($enst ne $preEnst) {
	# exons for new transcript
	$exonN = 1;
	$preEnst = $enst;
	$preEnsp = $ensp;
	$end = "";
	$start = "";
	$elementN = 1;
    }

    if($strand == 1) {
	print "$gene\t$enst\t$ensp\tIntron-".($exonN-1)."\t".($elementN++)."\t$strand\t$chr\t".($end+1)."\t".($eStart-1)."\t$cdsLength\n" if($end ne "");
    } else {
	print "$gene\t$enst\t$ensp\tIntron-".($exonN-1)."\t".($elementN++)."\t$strand\t$chr\t".($eEnd+1)."\t".($start-1)."\t$cdsLength\n" if($start ne "");
    }

    if($utr5start ne "") {
	if($strand == 1) {
	    print "$gene\t$enst\t$ensp\t$ense-5UTR-$exonN\t".($elementN++)."\t$strand\t$chr\t$utr5start\t$utr5end\t$cdsLength\n";
	    if($eEnd ne $utr5end) {
		print "$gene\t$enst\t$ensp\t$ense-$exonN\t".($elementN++)."\t$strand\t$chr\t".($utr5end+1)."\t".($utr3start eq "" ? $eEnd : $utr3start-1)."\t$cdsLength\n";
		$exonPrinted = 1;
	    }
	} else {
	    print "$gene\t$enst\t$ensp\t$ense-5UTR-$exonN\t".($elementN++)."\t$strand\t$chr\t$utr5start\t$utr5end\t$cdsLength\n";
	    if($eStart ne $utr5start) {
		print "$gene\t$enst\t$ensp\t$ense-$exonN\t".($elementN++)."\t$strand\t$chr\t".($utr3start eq "" ? $eStart : $utr3end+1)."\t".($utr5start-1)."\t$cdsLength\n";
		$exonPrinted = 1;
	    }
	}
    }

    if($utr3start ne "") {
	if($strand == 1) {
	    if($eStart ne $utr3start and $exonPrinted == 0) {
		print "$gene\t$enst\t$ensp\t$ense-$exonN\t".($elementN++)."\t$strand\t$chr\t".($utr5end eq "" ? $eStart : $utr5end+1)."\t".($utr3start-1)."\t$cdsLength\n";
		$exonPrinted = 1;
	    }
	    print "$gene\t$enst\t$ensp\t$ense-3UTR-$exonN\t".($elementN++)."\t$strand\t$chr\t$utr3start\t$utr3end\t$cdsLength\n";
	} else {
	    if($eEnd ne $utr3end and $exonPrinted == 0) {
		print "$gene\t$enst\t$ensp\t$ense-$exonN\t".($elementN++)."\t$strand\t$chr\t".($utr3end+1)."\t".($utr5start eq "" ? $eEnd : $utr5start-1)."\t$cdsLength\n";
		$exonPrinted = 1;
	    }
	    print "$gene\t$enst\t$ensp\t$ense-3UTR-$exonN\t".($elementN++)."\t$strand\t$chr\t$utr3start\t$utr3end\t$cdsLength\n";
	}
    }

    print "$gene\t$enst\t$ensp\t$ense-$exonN\t".($elementN++)."\t$strand\t$chr\t$eStart\t$eEnd\t$cdsLength\n" if($utr5start eq "" and $utr3start eq "");
    $exonPrinted = 1;

    $end = $eEnd;
    $start = $eStart;
    $exonN++;
}