code_perl/Maasha/KISS/IO.pm

   1 package Maasha::KISS::IO;
   2
   3 # Copyright (C) 2009 Martin A. Hansen.
   4
   5 # This program is free software; you can redistribute it and/or
   6 # modify it under the terms of the GNU General Public License
   7 # as published by the Free Software Foundation; either version 2
   8 # of the License, or (at your option) any later version.
   9
  10 # This program is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 # GNU General Public License for more details.
  14
  15 # You should have received a copy of the GNU General Public License
  16 # along with this program; if not, write to the Free Software
  17 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
  18
  19 # http://www.gnu.org/copyleft/gpl.html
  20
  21
  22 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DESCRIPTION <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  23
  24
  25 # Routines for parsing and emitting KISS records.
  26
  27
  28 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  29
  30
  31 use warnings;
  32 use strict;
  33 use Data::Dumper;
  34 use Maasha::Filesys;
  35 use Maasha::SQL;
  36 use vars qw( @ISA @EXPORT );
  37
  38 @ISA = qw( Exporter );
  39
  40 use constant {
  41     S_ID        => 0,
  42     S_BEG       => 1,
  43     S_END       => 2,
  44     Q_ID        => 3,
  45     SCORE       => 4,
  46     STRAND      => 5,
  47     HITS        => 6,
  48     ALIGN       => 7,
  49     BLOCK_COUNT => 8,
  50     BLOCK_BEGS  => 9,
  51     BLOCK_LENS  => 10,
  52     BLOCK_TYPE  => 11,
  53 };
  54
  55 #      0         1         2
  56 #      012345678901234567890
  57 #      ---------------------   S.aur complete genome
  58 #         -===__===-           TAG_000001
  59 #         0123456789
  60 #
  61 #    S_ID        = 'S.aur complete genome'
  62 #    S_BEG       = 3
  63 #    S_END       = 12
  64 #    Q_ID        = 'TAG_000001'
  65 #    SCORE       => 1
  66 #    STRAND      => +
  67 #    HITS        => 31
  68 #    ALIGN       => 0:A>T,3:G>C
  69 #    BLOCK_COUNT => 2
  70 #    BLOCK_BEGS  => 1,6
  71 #    BLOCK_LENS  => 3,3
  72 #    BLOCK_TYPE  => 1,1
  73 #
  74 #
  75 # 'S.aur complete genome'   3   12  'TAG_000001'    1   +   31   2   1,6 3,3    1,1
  76
  77
  78 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  79
  80
  81 sub kiss_entry_get
  82 {
  83     my ( $fh,    # file handle
  84        ) = @_;
  85
  86     # Returns a hashref.
  87
  88     my ( $line, @fields, %entry );
  89
  90     while ( $line = <$fh> )
  91     {
  92         chomp $line;
  93
  94         next if $line =~ /^$|^#/;
  95
  96         @fields = split /\t/, $line;
  97
  98         Maasha::Common::error( qq( BAD kiss entry: $line) ) if not @fields == 12;
  99
 100         $entry{ 'S_ID' }        = $fields[ S_ID ];
 101         $entry{ 'S_BEG' }       = $fields[ S_BEG ];
 102         $entry{ 'S_END' }       = $fields[ S_END ];
 103         $entry{ 'Q_ID' }        = $fields[ Q_ID ];
 104         $entry{ 'SCORE' }       = $fields[ SCORE ];
 105         $entry{ 'STRAND' }      = $fields[ STRAND ];
 106         $entry{ 'HITS' }        = $fields[ HITS ];
 107         $entry{ 'ALIGN' }       = $fields[ ALIGN ];
 108         $entry{ 'BLOCK_COUNT' } = $fields[ BLOCK_COUNT ];
 109         $entry{ 'BLOCK_BEGS' }  = $fields[ BLOCK_BEGS ];
 110         $entry{ 'BLOCK_LENS' }  = $fields[ BLOCK_LENS ];
 111         $entry{ 'BLOCK_TYPE' }  = $fields[ BLOCK_TYPE ];
 112
 113         return wantarray ? %entry : \%entry;
 114     }
 115 }
 116
 117
 118 sub kiss_entry_put
 119 {
 120     my ( $entry,   # KISS entry to output
 121          $fh,      # file handle  -  OPTIONAL
 122        ) = @_;
 123
 124     # Returns nothing.
 125
 126     my ( @fields );
 127
 128     $fh ||= \*STDOUT;
 129
 130     $fields[ S_ID ]        = $entry->{ 'S_ID' };
 131     $fields[ S_BEG ]       = $entry->{ 'S_BEG' };
 132     $fields[ S_END ]       = $entry->{ 'S_END' };
 133     $fields[ Q_ID ]        = $entry->{ 'Q_ID' };
 134     $fields[ SCORE ]       = $entry->{ 'SCORE' };
 135     $fields[ STRAND ]      = $entry->{ 'STRAND' };
 136     $fields[ HITS ]        = $entry->{ 'HITS' };
 137     $fields[ ALIGN ]       = $entry->{ 'ALIGN' };
 138     $fields[ BLOCK_COUNT ] = $entry->{ 'BLOCK_COUNT' };
 139     $fields[ BLOCK_BEGS ]  = $entry->{ 'BLOCK_BEGS' };
 140     $fields[ BLOCK_LENS ]  = $entry->{ 'BLOCK_LENS' };
 141     $fields[ BLOCK_TYPE ]  = $entry->{ 'BLOCK_TYPE' };
 142
 143     print $fh join( "\t", @fields ), "\n";
 144 }
 145
 146
 147 sub kiss_sql_get
 148 {
 149     my ( $dbh,     # Database handle
 150          $table,   # Table name
 151          $s_beg,   # Subject begin
 152          $s_end,   # Subject end
 153        ) = @_;
 154
 155     my ( $sql, $entries );
 156
 157     $sql = "SELECT * FROM $table WHERE S_BEG >= $s_beg AND S_END <= $s_end";
 158
 159     $entries = Maasha::SQL::query_hashref_list( $dbh, $sql );
 160
 161     return wantarray ? @{ $entries } : $entries;
 162 }
 163
 164
 165 sub kiss2biopiece
 166 {
 167     my ( $entry,   # KISS entry
 168        ) = @_;
 169
 170     return wantarray ? %{ $entry } : $entry;
 171 }
 172
 173
 174 sub biopiece2kiss
 175 {
 176     my ( $record,   # Biopiece record
 177        ) = @_;
 178
 179     $record->{ 'HITS' }        ||= ".";
 180     $record->{ 'BLOCK_COUNT' } ||= ".";
 181     $record->{ 'BLOCK_BEGS' }  ||= ".";
 182     $record->{ 'BLOCK_LENS' }  ||= ".";
 183     $record->{ 'BLOCK_TYPE' }  ||= ".";
 184     $record->{ 'ALIGN' }       ||= $record->{ 'DESCRIPTOR' } || ".";
 185
 186     return wantarray ? %{ $record } : $record;
 187 }
 188
 189
 190 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 191
 192 1;
 193
 194