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 vars qw( @ISA @EXPORT );
  36
  37 @ISA = qw( Exporter );
  38
  39 use constant {
  40     S_ID        => 0,
  41     S_BEG       => 1,
  42     S_END       => 2,
  43     Q_ID        => 3,
  44     SCORE       => 4,
  45     STRAND      => 5,
  46     HITS        => 6,
  47     ALIGN       => 7,
  48     BLOCK_COUNT => 8,
  49     BLOCK_BEGS  => 9,
  50     BLOCK_LENS  => 10,
  51 };
  52
  53 #      0         1         2
  54 #      012345678901234567890
  55 #      ---------------------   S.aur complete genome
  56 #         -===__===-           TAG_000001
  57 #         0123456789
  58 #
  59 #    S_ID        = 'S.aur complete genome'
  60 #    S_BEG       = 3
  61 #    S_END       = 12
  62 #    Q_ID        = 'TAG_000001'
  63 #    SCORE       => 1
  64 #    STRAND      => +
  65 #    HITS        => 31
  66 #    ALIGN       => 0:A>T,3:G>C
  67 #    BLOCK_COUNT => 2
  68 #    BLOCK_BEGS  => 1,6
  69 #    BLOCK_LENS  => 3,3
  70 #
  71 #
  72 # 'S.aur complete genome'   3   12  'TAG_000001'    1   +   31   2   1,6 3,3
  73
  74
  75 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  76
  77
  78 sub kiss_entry_get
  79 {
  80     my ( $fh,    # file handle
  81        ) = @_;
  82
  83     # Returns a hashref.
  84
  85     my ( $line, @fields, %entry );
  86
  87     while ( $line = <$fh> )
  88     {
  89         chomp $line;
  90
  91         next if $line =~ /^$|^#/;
  92
  93         @fields = split /\t/, $line;
  94
  95         Maasha::Common::error( qq( BAD kiss entry: $line) ) if not @fields == 11;
  96
  97         $entry{ 'S_ID' }        = $fields[ S_ID ];
  98         $entry{ 'S_BEG' }       = $fields[ S_BEG ];
  99         $entry{ 'S_END' }       = $fields[ S_END ];
 100         $entry{ 'Q_ID' }        = $fields[ Q_ID ];
 101         $entry{ 'SCORE' }       = $fields[ SCORE ];
 102         $entry{ 'STRAND' }      = $fields[ STRAND ];
 103         $entry{ 'HITS' }        = $fields[ HITS ];
 104         $entry{ 'ALIGN' }       = $fields[ ALIGN ];
 105         $entry{ 'BLOCK_COUNT' } = $fields[ BLOCK_COUNT ];
 106         $entry{ 'BLOCK_BEGS' }  = $fields[ BLOCK_BEGS ];
 107         $entry{ 'BLOCK_LENS' }  = $fields[ BLOCK_LENS ];
 108
 109         return wantarray ? %entry : \%entry;
 110     }
 111 }
 112
 113
 114 sub kiss_entry_put
 115 {
 116     my ( $entry,   # KISS entry to output
 117          $fh,      # file handle  -  OPTIONAL
 118        ) = @_;
 119
 120     # Returns nothing.
 121
 122     my ( @fields );
 123
 124     $fh ||= \*STDOUT;
 125
 126     $fields[ S_ID ]   = $entry->{ 'S_ID' };
 127     $fields[ S_BEG ]  = $entry->{ 'S_BEG' };
 128     $fields[ S_END ]  = $entry->{ 'S_END' };
 129     $fields[ Q_ID ]   = $entry->{ 'Q_ID' };
 130     $fields[ SCORE ]  = $entry->{ 'SCORE' };
 131     $fields[ STRAND ] = $entry->{ 'STRAND' };
 132     $fields[ HITS ]   = $entry->{ 'HITS' };
 133     $fields[ ALIGN ]  = $entry->{ 'ALIGN' };
 134     $fields[ BLOCK_COUNT ] = $entry->{ 'BLOCK_COUNT' };
 135     $fields[ BLOCK_BEGS ]  = $entry->{ 'BLOCK_BEGS' };
 136     $fields[ BLOCK_LENS ]  = $entry->{ 'BLOCK_LENS' };
 137
 138     print $fh join( "\t", @fields ), "\n";
 139 }
 140
 141
 142 sub kiss2biopiece
 143 {
 144     my ( $entry,   # KISS entry
 145        ) = @_;
 146
 147     return wantarray ? %{ $entry } : $entry;
 148 }
 149
 150
 151 sub biopiece2kiss
 152 {
 153     my ( $record,   # Biopiece record
 154        ) = @_;
 155
 156     $record->{ 'HITS' }        ||= ".";
 157     $record->{ 'BLOCK_COUNT' } ||= ".";
 158     $record->{ 'BLOCK_BEGS' }  ||= ".";
 159     $record->{ 'BLOCK_LENS' }  ||= ".";
 160     $record->{ 'ALIGN' }       ||= $record->{ 'DESCRIPTOR' } || ".";
 161
 162     return wantarray ? %{ $record } : $record;
 163 }
 164
 165
 166 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 167
 168 1;
 169
 170