use Bio::Location::Split;

    my $splitlocation = Bio::Location::Split->new();
    $splitlocation->add_sub_Location(Bio::Location::Simple->new(-start=>1,
							       -end=>30,
							       -strand=>1));
    $splitlocation->add_sub_Location(Bio::Location::Simple->new(-start=>50,
							       -end=>61,
							       -strand=>1));   
    my @sublocs = $splitlocation->sub_Location();

    my $count = 1;
    # print the start/end points of the sub locations
    foreach my $location ( sort { $a->start <=> $b->start } 
			   @sublocs ) {
	printf "sub feature %d [%d..%d]\n", 
	       $count, $location->start,$location->end, "\n";
        $count++;
    }

    my ($class, @args) = @_;
    my $self = $class->SUPER::new(@args);
    # initialize
    $self->{'_sublocations'} = [];
    my ( $type, $seqid, $locations ) = 
	$self->_rearrange([qw(SPLITTYPE
                              SEQ_ID
			      LOCATIONS
                              )], @args);
    if( defined $locations && ref($locations) =~ /array/i ) {
	$self->add_sub_Location(@$locations);
    }
    $seqid  && $self->seq_id($seqid);
    $type ||= 'JOIN';
    $type = lc ($type);
    $self->splittype($type);
    return $self;

    my ($self, $order) = @_;
    my @locs = ();
    foreach my $subloc ($self->sub_Location($order)) {
	# Recursively check to get hierarchical split locations:
	push @locs, $subloc->each_Location($order);
    }
    return @locs;

    my ($self, $order) = @_;
    $order = 0 unless defined $order;
    if( defined($order) && ($order !~ /^-?\d+$/) ) {
	$self->throw("value $order passed in to sub_Location is $order, an invalid value");
    } 
    $order = 1 if($order > 1);
    $order = -1 if($order < -1);
    my @sublocs = defined $self->{'_sublocations'} ? @{$self->{'_sublocations'}} : ();

    # return the array if no ordering requested
    return @sublocs if( ($order == 0) || (! @sublocs) );
    	
    # sort those locations that are on the same sequence as the top (`master')
    # if the top seq is undefined, we take the first defined in a sublocation
    my $seqid = $self->seq_id();
    my $i = 0;
    while((! defined($seqid)) && ($i <= $#sublocs)) {
		$seqid = $sublocs[$i++]->seq_id();
    }
    if((! $self->seq_id()) && $seqid) {
		$self->warn("sorted sublocation array requested but ".
				"root location doesn't define seq_id ".
				"(at least one sublocation does!)");
    }
    my @locs = ($seqid ?
		grep { $_->seq_id() eq $seqid; } @sublocs :
		@sublocs);
    if(@locs) {
		if($order == 1) {
			# Schwartzian transforms for performance boost	  
			@locs = map { $_->[0] }
			sort {
				(defined $a && defined $b) ? $a->[1] <=> $b->[1] :
                $a                         ?  -1                 : 1
				}
			map {
				[$_, (defined $_->start ? $_->start : $_->end)]
				} @locs;;
		} else { # $order == -1
			@locs = map { $_->[0]}
			sort { 
				(defined $a && defined $b) ? $b->[1] <=> $a->[1] :
				$a                         ? -1                  : 1
				}
			map {
				[$_, (defined $_->end ? $_->end : $_->start)]
				} @locs;
		}
    }
    # push the rest unsorted
    if($seqid) {
		push(@locs, grep { $_->seq_id() ne $seqid; } @sublocs);
    }
    # done!

    return @locs;

    my ($self,@args) = @_;
    my @locs;    
    foreach my $loc ( @args ) {
	if( !ref($loc) || ! $loc->isa('Bio::LocationI') ) {
	    $self->throw("Trying to add $loc as a sub Location but it doesn't implement Bio::LocationI!");
	    next;
	}	
	push @{$self->{'_sublocations'}}, $loc;
    }

    return scalar @{$self->{'_sublocations'}};

    my ($self, $value) = @_;
    if( defined $value || ! defined $self->{'_splittype'} ) {
	$value = 'JOIN' unless( defined $value );
	$self->{'_splittype'} = uc ($value);
    }
    return $self->{'_splittype'};

    my ($self) = @_;

    my $seqid = $self->seq_id();
    foreach my $loc ($self->sub_Location(0)) {
	$seqid = $loc->seq_id() if(! $seqid);
	if(defined($loc->seq_id()) && ($loc->seq_id() ne $seqid)) {
	    return 0;
	}
    }
    return 1;

	my $self = shift;
	return $self->{'strand'} = shift if @_;
	return $self->{'strand'};

    my ($self,$value) = @_;
    if( defined $value) {
		$self->{'strand'} = $value;
		# propagate to all sublocs
		foreach my $loc ($self->sub_Location(0)) {
			$loc->strand($value);
		}
    } else {
		my ($strand, $lstrand);
		foreach my $loc ($self->sub_Location(0)) {
			# we give up upon any location that's remote or doesn't have
			# the strand specified, or has a differing one set than 
			# previously seen.
			# calling strand() is potentially expensive if the subloc is also
			# a split location, so we cache it
			$lstrand = $loc->strand();
			if((! $lstrand) ||
			   ($strand && ($strand != $lstrand)) ||
			   $loc->is_remote()) {
			$strand = undef;
			last;
			} elsif(! $strand) {
			$strand = $lstrand;
			}
		}
		return $strand;
    }

    my $self = shift;
    for my $loc ( $self->sub_Location(0) ) {
		$loc->flip_strand;
		if ($loc->isa('Bio::Location::SplitLocationI')) {
			my $gs = ($self->guide_strand == -1) ? undef : -1;
			$loc->guide_strand($gs);
		}
    }

    my ($self,$value) = @_;    
    if( defined $value ) {
	$self->throw("Trying to set the starting point of a split location, ".
				 "that is not possible, try manipulating the sub Locations");
    }
    return $self->SUPER::start();

    my ($self,$value) = @_;    
    if( defined $value ) {
	$self->throw("Trying to set the ending point of a split location, ".
				 "that is not possible, try manipulating the sub Locations");
    }
    return $self->SUPER::end();

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

    if( defined $value ) {
	$self->throw("Trying to set the minimum starting point of a split ".
				 "location, that is not possible, try manipulating the sub Locations");
    }
    my @locs = $self->sub_Location(1);
    return $locs[0]->min_start() if @locs; 
    return;

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

    if( defined $value ) {
	$self->throw("Trying to set the maximum starting point of a split ".
				 "location, that is not possible, try manipulating the sub Locations");
    }
    my @locs = $self->sub_Location(1);
    return $locs[0]->max_start() if @locs; 
    return;

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

    if( defined $value ) {
	$self->throw("Trying to set the start_pos_type of a split location, ".
				 "that is not possible, try manipulating the sub Locations");
    }
    my @locs = $self->sub_Location();
    return ( @locs ) ? $locs[0]->start_pos_type() : undef;

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

    if( defined $value ) {
	$self->throw("Trying to set the minimum end point of a split location, ".
				 "that is not possible, try manipulating the sub Locations");
    }
    # reverse sort locations by largest ending to smallest ending
    my @locs = $self->sub_Location(-1);
    return $locs[0]->min_end() if @locs; 
    return;

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

    if( defined $value ) {
	$self->throw("Trying to set the maximum end point of a split location, ".
				 "that is not possible, try manipulating the sub Locations");
    }
    # reverse sort locations by largest ending to smallest ending
    my @locs = $self->sub_Location(-1);
    return $locs[0]->max_end() if @locs; 
    return;

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

    if( defined $value ) {
	$self->throw("Trying to set end_pos_type of a split location, ".
				 "that is not possible, try manipulating the sub Locations");
    }
    my @locs = $self->sub_Location();
    return ( @locs ) ? $locs[0]->end_pos_type() : undef;

    my $self = shift;

    if(@_ && !$self->is_remote()) {
	foreach my $subloc ($self->sub_Location(0)) {
	    $subloc->seq_id(@_) if !$subloc->is_remote();
	}
    }
    return $self->SUPER::seq_id(@_);

    my ($self) = @_;
    my @strs;
	my $strand = $self->strand() || 0;
	my $stype = lc($self->splittype());
	my $guide = $self->guide_strand();

    if( $strand < 0 ) {
		$self->flip_strand; # this will recursively set the strand
							# to +1 for all the sub locations
    }
	# If the split type is join, the order is important;
	# otherwise must be 5'->3' regardless
	
	my @locs = ($stype eq 'join' && (!$guide && $strand == -1)) ?
	           reverse $self->sub_Location() : $self->sub_Location() ;
	
    foreach my $loc ( @locs ) {
		$loc->verbose($self->verbose);
		my $str = $loc->to_FTstring();
		# we only append the remote seq_id if it hasn't been done already
		# by the sub-location (which it should if it knows it's remote)
		# (and of course only if it's necessary)
		if( (! $loc->is_remote) &&
			defined($self->seq_id) && defined($loc->seq_id) &&
			($loc->seq_id ne $self->seq_id) ) {
			$str = sprintf("%s:%s", $loc->seq_id, $str);
		} 
		push @strs, $str;
	}
	$self->flip_strand if $strand < 0;
	my $str;
	if( @strs == 1 ) {
		($str) = @strs;
	} elsif( @strs == 0 ) {
		$self->warn("no Sublocations for this splitloc, so not returning anything\n");
	} else { 
		$str = sprintf("%s(%s)",lc $self->splittype, join(",", @strs));
	}
	if( $strand < 0 ) {  # wrap this in a complement if it was unrolled
		$str = sprintf("%s(%s)",'complement',$str);
	}

    return $str;

  bioperl-l@bioperl.org                  - General discussion
  http://bioperl.org/wiki/Mailing_lists  - About the mailing lists

  https://redmine.open-bio.org/projects/bioperl/

  Title   : coordinate_policy
  Usage   : $policy = $location->coordinate_policy();
            $location->coordinate_policy($mypolicy); # set may not be possible
  Function: Get the coordinate computing policy employed by this object.

            See Bio::Location::CoordinatePolicyI for documentation about
            the policy object and its use.

            The interface *does not* require implementing classes to accept
            setting of a different policy. The implementation provided here
            does, however, allow to do so.

            Implementors of this interface are expected to initialize every
            new instance with a CoordinatePolicyI object. The implementation
            provided here will return a default policy object if none has
            been set yet. To change this default policy object call this
            method as a class method with an appropriate argument. Note that
            in this case only subsequently created Location objects will be
            affected.

  Returns : A Bio::Location::CoordinatePolicyI implementing object.
  Args    : On set, a Bio::Location::CoordinatePolicyI implementing object.

 Title   : valid_Location
 Usage   : if ($location->valid_location) {...};
 Function: boolean method to determine whether location is considered valid
           (has minimum requirements for Simple implementation)
 Returns : Boolean value: true if location is valid, false otherwise
 Args    : none