package Sequence;

use strict;
use warnings;
use Carp;
use base qw(Root);

sub id {
	my ($self, $id) = @_;
	defined $id ?
		$self->{__PACKAGE__."id"} = $id :
		return $self->{__PACKAGE__."id"};
}

sub seq {
	my ($self, @entries) = @_;
	if (@entries) { $self->{__PACKAGE__."seq"} = [ @entries ] }
	else {
		if (wantarray) {
			return defined $self->{__PACKAGE__."seq"} ?
				@{ $self->{__PACKAGE__."seq"} } :
				();
		}
		else { return $self->{__PACKAGE__."seq"} }
	}
}

sub length {
	my ($self) = @_;
	return scalar @{ [ $self->seq ] };
}

#sub numeric {
#	my ($self, $set) = @_;
#	return $set ? 
#		$self->{__PACKAGE__."numeric"} = $set :
#		$self->{__PACKAGE__."numeric"};
#}
#
#use Scalar::Util qw(looks_like_number);
#sub seq_compress {
#	my ($self, @entries) = @_;
#	if (@entries) {
#		my $numeric = grep { looks_like_number $_ } @entries;
#		if ($numeric != 0 && $numeric != @entries) {
#			die "Can't compress both numeric and non-numeric data";
#		}
#
#		if ($numeric) {
#			$self->numeric(1);
#			$self->seq(pack "d*", @entries)
#		}
#		else { $self->seq(join '', @entries) }
#	}
#	else {
#		return $self->seq
#	}
#}

sub sub_seq {
	my ($self, @segments) = @_;

	my $package = ref $self;

	return $self->seq unless @segments;
	confess "Passed an uneven number of segments" unless @segments % 2 == 0;

	{
		my %segments = @segments;
		# Find out if there are overlapping segments
		for my $pri (sort keys %segments) {
			for my $test (sort keys %segments) {
				next if $pri == $test;
				croak "Overlapping segments" if $test < $segments{$pri};
			}
		}
	}
	
	my @sections;
	my ($i, @seq) = (0, $self->seq);
	do {
		my ($start, $end) = @segments[$i, $i + 1];

		# Create a new sequence object in the correct package, and put the
		# segment into it
		my $new_seq = $package->new(id => $self->id);
		$new_seq->seq( @seq[ $start .. $end ] );
		push @sections, $new_seq;
		$i += 2;
	} while ($i < @segments);

	return @sections;
}

1;

__END__

=head1 NAME

Sequence - Holds information about a sequence

=head1 EXAMPLE

  my $seq = Sequence->new;

  $seq->id("Big wobbly molecule");
  my @residues = split //, "ASEQENCE";
  $seq->seq(@residues);

=head1 INHERITANCE

Inherits from the Root class.

=head1 METHODS

=head2 id()

Accessor for the sequence ID.

=head2 seq(@sequence_data)

Accessor for the sequence. Pass the information in as an array, one piece per position.

Returns an array reference if called in a scalar context, otherwise an array of the information.

=head2 length()

Returns the length of the sequence.

=head1 AUTHOR

Jonathan Barber <jon@compbio.dundee.ac.uk>

=cut