File Coverage

blib/lib/BioX/SeqUtils/Promoter/Sequences.pm

Criterion	Covered	Total	%
statement	3	3	100.0
branch			n/a
condition			n/a
subroutine	1	1	100.0
pod			n/a
total	4	4	100.0

package BioX::SeqUtils::Promoter::Sequences;
####################################################################
#	               Charles Stephen Embry			   #
#	            MidSouth Bioinformatics Center		   #
#	        University of Arkansas Little Rock	           #
####################################################################
use base qw(BioX::SeqUtils::Promoter::Base);
use Class::Std;
use Class::Std::Utils;
use BioX::SeqUtils::Promoter::Sequence;

use warnings;
use strict;
use Carp;

use version; our $VERSION = qv('0.1.1');

{
        my %sequences_of   :ATTR( :get   :set   :default<{}>    :init_arg );

	sub BUILD {
                my ($self, $ident, $arg_ref) = @_;


                return;
        }

        sub START {
                my ($self, $ident, $arg_ref) = @_;


                return;
        }

	sub add_sequence {
                my ($self, $arg_ref) = @_;
		my $sequence = defined $arg_ref->{sequence} ?  $arg_ref->{sequence} : '';
		my $label = defined $arg_ref->{label} ?  $arg_ref->{label} : '';
		my $seqobj = $self->get_sequence({label => $label});
		if (! $seqobj) {
			#if seequnece object with this label does not exist this creates one
			$seqobj = BioX::SeqUtils::Promoter::Sequence->new($arg_ref);
                	my $sequences = $self->get_sequences();
			$sequences->{$label} = $seqobj;
                	$self->set_sequences($sequences);
		}
                return;
        }

	sub get_dna {
		my ($self, $arg_ref) = @_;
		my $sequences = $self->get_sequences();

		return join('',@$sequences);
	}

	sub get_objects {
		my ($self, $arg_ref) = @_;
	        my $objects = $self->get_sequences();
		my @objects = values %$objects;
		#returns actual objects and not reference for use by other objects
		return @objects;
	}

	sub add_segment {
                my ($self, $arg_ref) = @_;
		my $sequence = defined $arg_ref->{sequence} ?  $arg_ref->{sequence} : '';
		my $label = defined $arg_ref->{label} ?  $arg_ref->{label} : '';
		#adds a segment of dna data to a sequence object
		my $seqobj = $self->get_sequence({label => $label});
		if ($seqobj) {
			$seqobj->add_segment({sequence => $sequence});
                	my $sequences = $self->get_sequences();
			$sequences->{$label} = $seqobj;
                	$self->set_sequences($sequences);
		} else {
			$self->add_sequence($arg_ref);
		}
                return;
        }

	sub set_color {
		my ($self, $arg_ref) = @_;
		my $bases = defined $arg_ref->{bases} ?  $arg_ref->{bases} : '';
		my $colors = defined $arg_ref->{colors} ?  $arg_ref->{colors} : '';
		#label identifies which sequence object in this collection object to set color
		my $label = defined $arg_ref->{label} ?  $arg_ref->{label} : '';

		my $colorobj = $self->get_sequence({label  => $label});

	 	if (! $colorobj) { $colorobj = $self->add_sequence($arg_ref); }

                $colorobj->set_color({bases => $bases, colors => $colors});
    		my $sequences = $self->get_sequences();
           	$sequences->{$label} = $colorobj;																		                          $self->set_sequences($sequences);
		#sets color list in a sequence object
		return;
        }

	sub get_sequence {
                my ($self, $arg_ref) = @_;
		my $label = defined $arg_ref->{label} ?  $arg_ref->{label} : '';
		my $found;
                my $sequences = $self->get_sequences();
		foreach my $key (keys %$sequences ){
			if ($key eq $label){
				$found = $sequences->{$key};
			}
		}
		#returns a sequence from a seqeunce object
		return $found;
        }
}

1; # Magic true value required at end of module
__END__