Archive Ensembl HomeArchive Ensembl Home
ProjectedFileWriter.pm
Go to the documentation of this file.
00001 #
00002 # You may distribute this module under the same terms as perl itself
00003 #
00004 
00005 =pod
00006 
00007 =head1 NAME
00008 
00009 Bio::EnsEMBL::Compara::Production::Projection::Writer::ProjectedFileWriter
00010 
00011 =head1 DESCRIPTION
00012 
00013 This class writes out to a file location given at construction time using
00014 Text::CSV. If this is not present this class will not work.
00015 
00016 =head1 AUTHOR
00017 
00018 Andy Yates (ayatesatebiacuk)
00019 
00020 =head1 CONTACT
00021 
00022 This modules is part of the EnsEMBL project (http://www.ensembl.org)
00023 
00024 Questions can be posted to the dev mailing list: dev@ensembl.org
00025 
00026 =cut
00027 
00028 package Bio::EnsEMBL::Compara::Production::Projection::Writer::ProjectedFileWriter;
00029 
00030 use strict;
00031 use warnings;
00032 use Bio::EnsEMBL::Utils::Argument qw(rearrange);
00033 use Bio::EnsEMBL::Utils::Scalar qw(assert_ref);
00034 use Bio::EnsEMBL::Utils::Exception qw(throw);
00035 
00036 use File::Copy;
00037 use IO::Handle;
00038 use IO::File;
00039 
00040 use base qw(Bio::EnsEMBL::Compara::Production::Projection::Writer::BaseWriter);
00041 
00042 =head2 new()
00043 
00044   Arg[-file] : required if file_handle is not given;
00045   Arg[-file_handle] : required if file is not given; 
00046   Description : New method used for a new instance of the given object. 
00047                 Required fields are indicated accordingly. Fields are specified
00048                 using the Arguments syntax (case insensitive).
00049 
00050 =cut
00051 
00052 sub new {
00053   my ( $class, @args ) = @_;
00054   my $self = $class->SUPER::new(@args);
00055   my ( $file, $file_handle ) = rearrange( [qw(file file_handle)], @args );
00056 
00057   confess(
00058 'The attribute file or file_handle must be specified during construction or provide a builder subroutine'
00059   ) if !defined $file && ! defined $file_handle;
00060   $self->{file} = $file if defined $file;
00061   $self->{file_handle} = $file_handle if defined $file_handle;
00062 
00063   return $self;
00064 }
00065 
00066 =head2 write_projection()
00067 
00068 Writes the projection data to configured file handle or to the given 
00069 file location. The output is a CSV of the following columns:
00070 
00071 =over 8
00072 
00073 =item DBEntry accession
00074 
00075 =item Source's stable ID i.e. the object the transferred accession was originally attached to
00076 
00077 =item Target's stable ID i.e. the end point for this transfer
00078 
00079 =item Source's % identity
00080 
00081 =item Target's % identity
00082 
00083 =item Type of homology
00084 
00085 =back
00086 
00087 =cut
00088 
00089 sub write_projection {
00090   my ($self, $p) = @_;
00091   my $csv = $self->_csv_writer();
00092   my $fh = $self->file_handle();
00093   $csv->combine(@{
00094     $self->_projection_to_array($p)
00095   }) or throw('Could not create line '.Text::CSV->error_input());
00096   my $str = $csv->string();
00097   $fh->print($str, "\n");
00098   return;
00099 }
00100 
00101 sub _projection_to_array {
00102   my ($self, $p) = @_;
00103   return [
00104     $p->entry()->primary_id(),
00105     $p->from()->stable_id(),
00106     $p->from_identity(),
00107     $p->to()->stable_id(),
00108     $p->to_identity(),
00109     $p->type()
00110   ];
00111 }
00112 
00113 =head2 file()
00114 
00115   Description : Getter for the file name 
00116 
00117 =cut
00118 
00119 sub file {
00120   my ($self) = @_;
00121   return $self->{file};
00122 }
00123 
00124 =head2 file_handle()
00125   
00126   Description : Getter for the file handle 
00127   
00128 =cut
00129 
00130 sub file_handle {
00131   my ($self, $file_handle) = @_;
00132   if(! defined $self->{file_handle}) {
00133     $self->{file_handle} = $self->_build_file_handle();
00134     $self->{_self_generated_file_handle} = 1;
00135   }
00136   return $self->{file_handle};
00137 }
00138 
00139 sub _build_file_handle {
00140   my ($self) = @_;
00141   my $f = $self->file();
00142   # - means go to STDOUT
00143   if($f eq '-') {
00144     return IO::Handle->new_from_fd(fileno(STDOUT), 'w');
00145   }
00146   else {
00147     if( -f $f ) {
00148       warn("The file $f already exists; moving out of the way to ${f}.old");
00149       move($f, $f.'.old');
00150     }
00151     return IO::File->new($f, 'w');
00152   }
00153 }
00154 
00155 =head2 close()
00156 
00157 Used to close down the underlying file handle
00158 
00159 =cut
00160 
00161 sub close {
00162   my ($self) = @_;
00163   close $self->file_handle();
00164 }
00165 
00166 sub _csv_writer {
00167   my ($self, $_csv_writer) = @_;
00168   if(! defined $self->{_csv_writer}) {
00169     eval 'require Text::CSV';
00170     throw('Cannot bring in Text::CSV : '.$@) if $@;
00171     my $csv = Text::CSV->new() or throw('Cannot use CSV: '.Text::CSV->error_diag());
00172     $self->{_csv_writer} = $csv;
00173   }
00174   return $self->{_csv_writer};
00175 }
00176 
00177 
00178 =head2 DESTROY 
00179 
00180 Destroys the file handle generated by this object if we were not given 
00181 one during construction
00182 
00183 =cut
00184 
00185 sub DESTROY {
00186   my ($self) = @_;
00187   if($self->{_self_generated_file_handle} && $self->file_handle()->opened()) {
00188     $self->file_handle()->close();
00189   }
00190   return;
00191 }
00192  
00193 1;