lib/CXGN/Chromatogram.pm

   1 #!/usr/bin/perl
   2 package CXGN::Chromatogram;
   3 use CXGN::Chromatogram::Draw;
   4 use SGN::Context;
   5 use strict;
   6 use warnings;
   7
   8 BEGIN {
   9     our @ISA = qw/Exporter/;
  10     use Exporter;
  11     our $VERSION = sprintf "%d.%03d", q$Revision: 1.1 $ =~ /(\d+)/g;
  12     our @EXPORT_OK = qw/create_image_file render_chromat_image/;
  13 }
  14 our @ISA;
  15 our @EXPORT_OK;
  16
  17 sub create_image_file
  18 {
  19     my($chromat_file,$temp_image_filename,$width,$height,$temp_path_for_output,$temp_path_for_display,$phred_path)=@_;
  20     my $message='';
  21     if(!$temp_image_filename)
  22     {
  23         die("create_image_file: No temporary image filename specified");
  24     }
  25     $height||=120;
  26     $width||=720;
  27     my $context = SGN::Context->new;
  28     my $website_path= $context->get_conf('basepath');
  29     $temp_path_for_display ||= $context->tempfiles_subdir('traceimages');
  30     $temp_path_for_output  ||= $website_path.$temp_path_for_display;
  31     $phred_path||='/usr/bin/';
  32     #image may already exist
  33     if(-f($temp_path_for_output.$temp_image_filename))
  34     {
  35         return($temp_path_for_display.$temp_image_filename);
  36     }
  37     #execute image creation script. if it returns a positive number (error code)...
  38     if(CXGN::Chromatogram::Draw::ABI_Display('-a',$chromat_file,'-o',$temp_path_for_output.$temp_image_filename,'-t',$temp_path_for_output,'-h',$height,'-w',$width,'-phred_path',$phred_path))#if(system("$website_path/programs/ABI_Display.pl -a $chromat_file -o $temp_path_for_output$temp_image_filename -t $temp_path_for_output -h $height -w $width -phred_path $phred_path"))
  39     {
  40         #then try it without phred. if it returns a positive number (error code)...
  41         if(CXGN::Chromatogram::Draw::ABI_Display('-a',$chromat_file,'-o',$temp_path_for_output.$temp_image_filename,'-t',$temp_path_for_output,'-h',$height,'-w',$width))#if(system("$website_path/programs/ABI_Display.pl -a $chromat_file -o $temp_path_for_output$temp_image_filename -t $temp_path_for_output -h $height -w $width"))
  42         {
  43             die("CXGN::Chromatogram::Draw::ABI_Display failed.");
  44         }
  45     }
  46     #check to make sure the image file is really there before returning a path to it
  47     if(-f($temp_path_for_output.$temp_image_filename))
  48     {
  49         return($temp_path_for_display.$temp_image_filename);
  50     }
  51     else
  52     {
  53         die("ABI_Display.pl executed successfully but temporary image file not found.");
  54     }
  55 }
  56
  57 #to tell if we have an abi chromatogram we can display, we must do the following:
  58 #
  59 #1. see if there is a database entry claiming we have one
  60 #2. use the incomplete filename in the database entry to guess what the full filename is (find_chromat_file)
  61 #3. uncompress it if it is compressed (uncompress_if_necessary)
  62 #4. figure out if the uncompressed file is indeed an abi file (is_abi_file)
  63 sub has_abi_chromatogram
  64 {
  65     my($read_id)=@_;
  66     my $context = SGN::Context->new;
  67     my $trace_basepath=$context->get_conf('trace_path');
  68     my $temp_image_path=$context->tempfiles_subdir('traceimages');
  69     if(!defined($read_id)||$read_id!~m/^[0-9]+$/){return;}
  70     my $dbh=CXGN::DB::Connection->new();
  71     my $traceq=$dbh->prepare("SELECT trace_location,trace_name from seqread where read_id=?");
  72     $traceq->execute($read_id);
  73     my($path,$name)=$traceq->fetchrow_array();
  74     unless($path and $name)
  75     {
  76         return;
  77     }
  78     my $basename=$trace_basepath."/$path/$name";
  79     my $full_pathname=CXGN::Chromatogram::find_chromat_file($basename);
  80     if(!$full_pathname)
  81     {
  82         #CXGN::Apache::Error::notify("could not find an abi chromatogram","Can't find chromatogram file at $path for trace $name, read id $read_id. Data in seqread table appears incorrect.\n");
  83         return;
  84     }
  85     my $tmp_tracename="SGN-T$read_id.mct";#"mct"="mystery chromatogram type" ;-) --john
  86     CXGN::Chromatogram::uncompress_if_necessary($full_pathname,$context->get_conf('basepath')."$temp_image_path/$tmp_tracename");
  87     return CXGN::Chromatogram::is_abi_file($context->get_conf('basepath')."$temp_image_path/$tmp_tracename");
  88 }
  89
  90 #chromats are hidden with obscure names and unspecified extensions, and we must try to find them. yay!
  91 sub find_chromat_file
  92 {
  93     my ($basename)=@_;
  94     # KONI's explanation of this:
  95     # "The actual extension used should have been stored in the database, but it
  96     # was not. This is because most chromatograms we had at the start did not have
  97     # an extension. Overtime, it became clear that preserving the facility's
  98     # specified filename is necessary, thus conventions for file extenstions are
  99     # not standardized. This nested loop below wastes some time, but is arguably
 100     # robust and easily extended to new types.
 101     #
 102     # find the actual file location using the partially specified filename by looking through all possible extensions
 103     my $full_pathname;
 104     TYPELOOP:
 105     foreach my $type_ext('',qw/.ab1 .abi .esd .SCF .scf/)
 106     {
 107         foreach my $comp_ext('',qw/.gz .Z .bz2/)
 108         {
 109             if(-f($basename.$type_ext.$comp_ext))
 110             {
 111                 $full_pathname=$basename.$type_ext.$comp_ext;
 112                 last TYPELOOP;
 113             }
 114         }
 115     }
 116     return $full_pathname;
 117 }
 118
 119 #chromats are usually zipped but i don't know if they always will be
 120 sub uncompress_if_necessary
 121 {
 122     my ($source,$dest)=@_;
 123     #if unzipping returns an error, it is usually because it is not zipped
 124     if(system("gzip -dc $source > $dest"))
 125     {
 126         #so try to copy it instead
 127         my $copy_command="cp $source $dest";
 128         if(system($copy_command))
 129         {
 130             die "could not copy chromatogram, Could not do '$copy_command': $!";
 131         }
 132     }
 133 }
 134
 135 #code snippet excised from ABI_Display.pl.
 136 sub is_abi_file
 137 {
 138     my($file)=@_;
 139     open(ABIFile,$file) or return;
 140     binmode ABIFile,":raw";
 141     my $CheckString;
 142     seek ABIFile,0,0;
 143     read(ABIFile,$CheckString,4);
 144     if($CheckString eq 'ABIF')
 145     {
 146         close ABIFile;
 147         return $file;
 148     }
 149     else
 150     {
 151         seek ABIFile,128,0;
 152         read(ABIFile,$CheckString,3);
 153         if($CheckString eq 'ABI')
 154         {
 155             close ABIFile;
 156             return $file;
 157         }
 158         else
 159         {
 160             close ABIFile;
 161             return;
 162         }
 163     }
 164 }
 165 ###
 166 1;# do not remove
 167 ###