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 };
  53
  54 #      0         1         2
  55 #      012345678901234567890
  56 #      ---------------------   S.aur complete genome
  57 #         -===__===-           TAG_000001
  58 #         0123456789
  59 #
  60 #    S_ID        = 'S.aur complete genome'
  61 #    S_BEG       = 3
  62 #    S_END       = 12
  63 #    Q_ID        = 'TAG_000001'
  64 #    SCORE       => 1
  65 #    STRAND      => +
  66 #    HITS        => 31
  67 #    ALIGN       => 0:A>T,3:G>C
  68 #    BLOCK_COUNT => 2
  69 #    BLOCK_BEGS  => 1,6
  70 #    BLOCK_LENS  => 3,3
  71 #
  72 #
  73 # 'S.aur complete genome'   3   12  'TAG_000001'    1   +   31   2   1,6 3,3
  74
  75
  76 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  77
  78
  79 sub kiss_entry_get
  80 {
  81     my ( $fh,    # file handle
  82        ) = @_;
  83
  84     # Returns a hashref.
  85
  86     my ( $line, @fields, %entry );
  87
  88     while ( $line = <$fh> )
  89     {
  90         chomp $line;
  91
  92         next if $line =~ /^$|^#/;
  93
  94         @fields = split /\t/, $line;
  95
  96         Maasha::Common::error( qq( BAD kiss entry: $line) ) if not @fields == 11;
  97
  98         $entry{ 'S_ID' }        = $fields[ S_ID ];
  99         $entry{ 'S_BEG' }       = $fields[ S_BEG ];
 100         $entry{ 'S_END' }       = $fields[ S_END ];
 101         $entry{ 'Q_ID' }        = $fields[ Q_ID ];
 102         $entry{ 'SCORE' }       = $fields[ SCORE ];
 103         $entry{ 'STRAND' }      = $fields[ STRAND ];
 104         $entry{ 'HITS' }        = $fields[ HITS ];
 105         $entry{ 'ALIGN' }       = $fields[ ALIGN ];
 106         $entry{ 'BLOCK_COUNT' } = $fields[ BLOCK_COUNT ];
 107         $entry{ 'BLOCK_BEGS' }  = $fields[ BLOCK_BEGS ];
 108         $entry{ 'BLOCK_LENS' }  = $fields[ BLOCK_LENS ];
 109
 110         return wantarray ? %entry : \%entry;
 111     }
 112 }
 113
 114
 115 sub kiss_entry_put
 116 {
 117     my ( $entry,   # KISS entry to output
 118          $fh,      # file handle  -  OPTIONAL
 119        ) = @_;
 120
 121     # Returns nothing.
 122
 123     my ( @fields );
 124
 125     $fh ||= \*STDOUT;
 126
 127     $fields[ S_ID ]   = $entry->{ 'S_ID' };
 128     $fields[ S_BEG ]  = $entry->{ 'S_BEG' };
 129     $fields[ S_END ]  = $entry->{ 'S_END' };
 130     $fields[ Q_ID ]   = $entry->{ 'Q_ID' };
 131     $fields[ SCORE ]  = $entry->{ 'SCORE' };
 132     $fields[ STRAND ] = $entry->{ 'STRAND' };
 133     $fields[ HITS ]   = $entry->{ 'HITS' };
 134     $fields[ ALIGN ]  = $entry->{ 'ALIGN' };
 135     $fields[ BLOCK_COUNT ] = $entry->{ 'BLOCK_COUNT' };
 136     $fields[ BLOCK_BEGS ]  = $entry->{ 'BLOCK_BEGS' };
 137     $fields[ BLOCK_LENS ]  = $entry->{ 'BLOCK_LENS' };
 138
 139     print $fh join( "\t", @fields ), "\n";
 140 }
 141
 142
 143 sub kiss_sql_get
 144 {
 145     my ( $dbh,     # Database handle
 146          $table,   # Table name
 147          $s_beg,   # Subject begin
 148          $s_end,   # Subject end
 149        ) = @_;
 150
 151     my ( $sql, $entries );
 152
 153     $sql = "SELECT * FROM $table WHERE S_BEG >= $s_beg AND S_END <= $s_end";
 154
 155     $entries = Maasha::SQL::query_hashref_list( $dbh, $sql );
 156
 157     return wantarray ? @{ $entries } : $entries;
 158 }
 159
 160
 161 sub kiss2biopiece
 162 {
 163     my ( $entry,   # KISS entry
 164        ) = @_;
 165
 166     return wantarray ? %{ $entry } : $entry;
 167 }
 168
 169
 170 sub biopiece2kiss
 171 {
 172     my ( $record,   # Biopiece record
 173        ) = @_;
 174
 175     $record->{ 'HITS' }        ||= ".";
 176     $record->{ 'BLOCK_COUNT' } ||= ".";
 177     $record->{ 'BLOCK_BEGS' }  ||= ".";
 178     $record->{ 'BLOCK_LENS' }  ||= ".";
 179     $record->{ 'ALIGN' }       ||= $record->{ 'DESCRIPTOR' } || ".";
 180
 181     return wantarray ? %{ $record } : $record;
 182 }
 183
 184
 185 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 186
 187 1;
 188
 189