view release on metacpan or  search on metacpan

lib/Bio/MAGETAB/Node.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: Node.pm 340 2010-07-23 13:19:27Z tfrayner $

package Bio::MAGETAB::Node;

use Moose;
use MooseX::FollowPBP;

use Scalar::Util qw(weaken);
use List::Util qw(first);

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

BEGIN { extends 'Bio::MAGETAB::BaseClass' };

# This is an abstract class; block direct instantiation.
sub BUILD {

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

    if ( blessed $self eq __PACKAGE__ ) {
        confess("ERROR: Attempt to instantiate abstract class " . __PACKAGE__);
    }
        
    if ( defined $params->{'inputEdges'} ) {
        $self->_reciprocate_edges_to_nodes(
            $params->{'inputEdges'},
            'outputNode',
        );
    }
    if ( defined $params->{'outputEdges'} ) {
        $self->_reciprocate_edges_to_nodes(
            $params->{'outputEdges'},
            'inputNode',
        );
    }
    if ( defined $params->{'sdrfRows'} ) {
        $self->_reciprocate_sdrf_rows_to_nodes(
            $params->{'sdrfRows'},
            'nodes',
        );
    }

    return;
}

has 'inputEdges'          => ( is         => 'rw',
                               isa        => ArrayRef['Bio::MAGETAB::Edge'],
                               auto_deref => 1,
                               clearer    => 'clear_inputEdges',
                               predicate  => 'has_inputEdges',
                               required   => 0 );

has 'outputEdges'         => ( is         => 'rw',
                               isa        => ArrayRef['Bio::MAGETAB::Edge'],
                               auto_deref => 1,
                               clearer    => 'clear_outputEdges',
                               predicate  => 'has_outputEdges',
                               required   => 0 );

has 'comments'            => ( is         => 'rw',
                               isa        => ArrayRef['Bio::MAGETAB::Comment'],
                               auto_deref => 1,
                               clearer    => 'clear_comments',
                               predicate  => 'has_comments',
                               required   => 0 );

has 'sdrfRows'            => ( is         => 'rw',
                               isa        => ArrayRef['Bio::MAGETAB::SDRFRow'],

lib/Bio/MAGETAB/Node.pm  view on Meta::CPAN

    $attr->( $self, $edges );

    $self->_reciprocate_edges_to_nodes(
        $edges,
        'inputNode',
    );

    return;
};

around 'set_sdrfRows' => sub {

    my ( $attr, $self, $sdrf_rows ) = @_;

    # Note that we have to handle the implicit delete here where a
    # member of $self->get_sdrfRows is being dropped during an update.
    foreach my $r ( $self->get_sdrfRows() ) {
        unless ( first { $r eq $_ } @$sdrf_rows ) {
            my @new_nodes = grep { $_ ne $self } $r->get_nodes();
            $r->{ 'nodes' } = \@new_nodes;
        }
    }

    # Set the appropriate $self attribute to point to $rows.
    $attr->( $self, $sdrf_rows );

    $self->_reciprocate_sdrf_rows_to_nodes(
        $sdrf_rows,
        'nodes',
    );

    return;
};

around 'clear_sdrfRows' => sub {

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

    foreach my $row ( $self->get_sdrfRows() ) {
        my @new_nodes = grep { $_ ne $self } $row->get_nodes();
        $row->{'nodes'} = \@new_nodes;
    }

    # Make sure we actually delete the sdrfRows.
    $attr->( $self );

    return;
};

# This method is used as a wrapper to ensure that reciprocating
# relationships are maintained, even when updating object attributes.
sub _reciprocate_edges_to_nodes {

    # $edges:       The edges with which $self has a reciprocal relationship.
    # $edge_slot:   The name of the slot pointing from $edge to $self.
    my ( $self, $edges, $edge_slot ) = @_;

    # Make sure $edges points to us. Since Edge->Node is 1..* we can
    # just overwrite the node attribute in the edges without worrying
    # about what else it might have pointed to. The Edge-to-Node
    # association is weakened to break a cicular reference on object
    # destruction.
    weaken $self;
    foreach my $t ( @$edges ) {
        $t->{ $edge_slot } = $self;
    }

    return;
}

# This method is used as a wrapper to ensure that reciprocating
# relationships are maintained, even when updating object attributes.
sub _reciprocate_sdrf_rows_to_nodes {

    # $rows:       The rows with which $self has a reciprocal relationship.
    # $row_slot:   The name of the slot pointing from $row to $self.
    my ( $self, $rows, $row_slot ) = @_;

    my $row_getter  = "get_$row_slot";

    # Make sure $rows points to us.
    foreach my $t ( @$rows ) {
       
        # Make sure $t points to us.
        my @current = $t->$row_getter();
        unless ( first { $_ eq $self } @current ) {
            push @current, $self;
            $t->{ $row_slot } = \@current;
        }
    }

    return;
}

__PACKAGE__->meta->make_immutable();

no Moose;

=pod

=head1 NAME

Bio::MAGETAB::Node - Abstract node class

=head1 SYNOPSIS

 use Bio::MAGETAB::Node;

=head1 DESCRIPTION

This class is an abstract class from which all MAGE-TAB SDRF Node
classes are derived. It cannot be instantiated directly. See the
L<BaseClass|Bio::MAGETAB::BaseClass> class for superclass methods.

=head1 ATTRIBUTES

=over 2

=item inputEdges (optional)

A list of Edges leading into this node (data type:
Bio::MAGETAB::Edge).