view release on metacpan or  search on metacpan

lib/Bio/MAGETAB/Util/Writer/SDRF.pm  view on Meta::CPAN

# Copyright 2008-2010 Tim Rayner
# 
# This file is part of Bio::MAGETAB.
# 
# Bio::MAGETAB is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
# 
# Bio::MAGETAB is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with Bio::MAGETAB.  If not, see <http://www.gnu.org/licenses/>.
#
# $Id: SDRF.pm 378 2012-12-22 20:00:25Z tfrayner $

package Bio::MAGETAB::Util::Writer::SDRF;

use Moose;
use MooseX::FollowPBP;

use Carp;
use List::Util qw( sum max first );
use Scalar::Util qw( refaddr );

use MooseX::Types::Moose qw( ArrayRef );

BEGIN { extends 'Bio::MAGETAB::Util::Writer::Tabfile' };

has 'magetab_object'     => ( is         => 'ro',
                              isa        => 'Bio::MAGETAB::SDRF',
                              required   => 1 );

has '_table'             => ( is         => 'rw',
                              isa        => ArrayRef['ArrayRef'],
                              required   => 1,
                              default    => sub { [[]] }, );

has '_header'            => ( is         => 'rw',
                              isa        => ArrayRef,
                              required   => 1,
                              default    => sub { [] }, );

sub write {

    my ( $self ) = @_;

    # Create a defined matrix ($layers) indexed by columns and then
    # rows.
    my $sdrf       = $self->get_magetab_object();
    my @rows       = $sdrf->get_sdrfRows();
    my $node_lists = $self->_nodes_and_edges_from_rows( \@rows );

    # Generate the layer fragments to print out.
    my ( $table, $header ) = $self->_construct_lines( $node_lists );

    # Finally, dump everything to the file.
    my $max_column = max( map { scalar @{ $_ } } $header, @{ $table } );
    $self->set_num_columns( $max_column );
    foreach my $line ( $header, @{ $table } ) {
        $self->_write_line( @$line );
    }

    return;
}

sub _construct_lines {

    my ( $self, $node_lists ) = @_;

    # Quick Schwarzian transform to list the rows in order, longest
    # first.
    my @sorted_lists = map { $_->[1] }
                       reverse sort { $a->[0] <=> $b->[0] }
                       map { [ scalar @{ $_ }, $_ ] } @{ $node_lists };

    # Initialise our internal structures.
    $self->_set_header( [] );
    $self->_set_table( [ map { [] } 1 .. scalar @sorted_lists ] );

    # I think we're just processing Node, Edge and FactorValue objects here now.
    my %dispatch = (

        # Materials
        'Source'              => sub { $self->_process_sources( @_ )          },
        'Sample'              => sub { $self->_process_samples( @_ )          },
        'Extract'             => sub { $self->_process_extracts( @_ )         },
        'LabeledExtract'      => sub { $self->_process_labeledextracts( @_ )  },

        # Events
        'Assay'               => sub { $self->_process_assays( @_ )           },
        'DataAcquisition'     => sub { $self->_process_scans( @_ )            },
        'Normalization'       => sub { $self->_process_normalizations( @_ )   },

        # Data
        'DataFile'            => sub { $self->_process_datafiles( @_ )        },
        'DataMatrix'          => sub { $self->_process_datamatrices( @_ )     },

        # Edge
        'Edge'                => sub { $self->_process_edges( @_ )            },

        # FactorValue
        'FactorValue'         => sub { $self->_process_factorvalues( @_ )     },
    );

    while ( $self->_remaining_elements( \@sorted_lists ) ) {

        my ( $slice, $wanted ) = $self->_next_slice(
            \@sorted_lists,
            sub {
                my $id = ref $_[0];

                # FactorValues are a special case.
                if ( $id =~ /::FactorValue \z/xms ) {