rsem_perl_utils.pm

   1 #!/usr/bin/env perl
   2
   3 package rsem_perl_utils;
   4
   5 use strict;
   6
   7 require Exporter;
   8 our @ISA = qw(Exporter);
   9 our @EXPORT = qw(runCommand);
  10 our @EXPORT_OK = qw(runCommand collectResults showVersionInfo);
  11
  12 # command, {err_msg}
  13 sub runCommand {
  14     print $_[0]."\n";
  15     my $status = system($_[0]);
  16
  17     if ($? == -1) {
  18         my @arr = split(/[ \t]+/, $_[0]);
  19         print "$arr[0] : $!!\n";
  20         print "Please check if you have compiled the associated codes by typing related \"make\" commands and/or made related executables ready to use.\n";
  21         exit(-1);
  22     }
  23
  24     if ($status != 0) {
  25         my $errmsg = "";
  26         if (scalar(@_) > 1) { $errmsg .= $_[1]."\n"; }
  27         $errmsg .= "\"$_[0]\" failed! Plase check if you provide correct parameters/options for the pipeline!\n";
  28         print $errmsg;
  29         exit(-1);
  30     }
  31     print "\n";
  32 }
  33
  34 my @allele_title = ("allele_id", "transcript_id", "gene_id", "length", "effective_length", "expected_count", "TPM", "FPKM", "AlleleIsoPct", "AlleleGenePct", "posterior_mean_count", "posterior_standard_deviation_of_count", "pme_TPM", "pme_FPKM", "AlleleIsoPct_from_pme_TPM", "AlleleGenePct_from_pme_TPM", "TPM_ci_lower_bound", "TPM_ci_upper_bound", "FPKM_ci_lower_bound", "FPKM_ci_upper_bound");
  35
  36 my @transcript_title = ("transcript_id", "gene_id", "length", "effective_length", "expected_count", "TPM", "FPKM", "IsoPct", "posterior_mean_count", "posterior_standard_deviation_of_count", "pme_TPM", "pme_FPKM", "IsoPct_from_pme_TPM", "TPM_ci_lower_bound", "TPM_ci_upper_bound", "FPKM_ci_lower_bound", "FPKM_ci_upper_bound");
  37
  38 my @gene_title = ("gene_id", "transcript_id(s)", "length", "effective_length", "expected_count", "TPM", "FPKM", "posterior_mean_count", "posterior_standard_deviation_of_count", "pme_TPM", "pme_FPKM", "TPM_ci_lower_bound", "TPM_ci_upper_bound", "FPKM_ci_lower_bound", "FPKM_ci_upper_bound");
  39
  40 # type, inpF, outF
  41 sub collectResults {
  42     my $local_status;
  43     my ($inpF, $outF);
  44     my @results = ();
  45     my $line;
  46
  47     $inpF = $_[1];
  48     $outF = $_[2];
  49
  50     $local_status = open(INPUT, $inpF);
  51     if ($local_status == 0) { print "Fail to open file $inpF!\n"; exit(-1); }
  52
  53     @results = ();
  54
  55     while ($line = <INPUT>) {
  56         chomp($line);
  57         my @local_arr = split(/\t/, $line);
  58         push(@results, \@local_arr);
  59     }
  60
  61     close(INPUT);
  62
  63     $local_status = open(OUTPUT, ">$outF");
  64     if ($local_status == 0) { print "Fail to create file $outF!\n"; exit(-1); }
  65
  66     my $n = scalar(@results);
  67     my $m = scalar(@{$results[0]});
  68
  69     $" = "\t";
  70
  71     my @out_arr = ();
  72     for (my $i = 0; $i < $n; $i++) {
  73         if ($_[0] eq "allele") { push(@out_arr, $allele_title[$i]); }
  74         elsif ($_[0] eq "isoform") { push(@out_arr, $transcript_title[$i]); }
  75         elsif ($_[0] eq "gene") { push(@out_arr, $gene_title[$i]); }
  76         else { print "A bug on 'collectResults' is detected!\n"; exit(-1); }
  77     }
  78     print OUTPUT "@out_arr\n";
  79
  80     for (my $i = 0; $i < $m; $i++) {
  81         @out_arr = ();
  82         for (my $j = 0; $j < $n; $j++) { push(@out_arr, $results[$j][$i]); }
  83         print OUTPUT "@out_arr\n";
  84     }
  85
  86     close(OUTPUT);
  87 }
  88
  89 # 0, dir
  90 sub showVersionInfo {
  91     open(INPUT, "$_[0]/WHAT_IS_NEW");
  92     my $line = <INPUT>;
  93     chomp($line);
  94     close(INPUT);
  95     print "Current version is $line\n";
  96     exit(0);
  97 }
  98
  99 1;