# $Id: gameWriter.pm,v 1.3 2003/12/16 17:08:51 jason Exp $
#
# BioPerl module for Bio::SeqIO::game::gameWriter
#
# Cared for by Sheldon McKay <smckay@bcgsc.bc.ca>
#
# Copyright Sheldon McKay
#
# You may distribute this module under the same terms as perl itself
#

# POD documentation - main docs before the code

=head1 NAME

Bio::SeqIO::game::gameWriter -- a class for writing game-XML

=head1 SYNOPSIS

# insert sample code here

=head1 DESCRIPTION

# Description goes here

=head1 FEEDBACK

=head2 Mailing Lists

User feedback is an integral part of the evolution of this
and other Bioperl modules. Send your comments and suggestions preferably
to one of the Bioperl mailing lists.

Your participation is much appreciated.

  bioperl-l@bioperl.org                  - General discussion
  http://bioperl.org/MailList.shtml      - About the mailing lists

=head2 Reporting Bugs

Report bugs to the Bioperl bug tracking system to help us keep track
of the bugs and their resolution.

Bug reports can be submitted via email or the web:

  bioperl-bugs@bioperl.org
  http://bugzilla.bioperl.org/

=head1 AUTHOR - Sheldon McKay

Email smckay@bcgsc.bc.ca

=head1 APPENDIX

The rest of the documentation details each of the object
methods. Internal methods are usually preceded with a _

=cut

package Bio::SeqIO::game::gameWriter;

use strict;
use IO::String;
use XML::Writer;
use Bio::SeqFeature::Generic;
use Bio::SeqIO::game::gameSubs;
use Bio::SeqFeature::Tools::Unflattener;

use vars '@ISA';
@ISA = qw/Bio::SeqIO::game::gameSubs/;

=head2 new

 Title   : new
 Usage   : my $writer = Bio::SeqIO::game::gameWriter->new($seq);
 Function: constructor method for gameWriter 
 Returns : a game writer object 
 Args    : a Bio::SeqI implementing object

=cut

sub new {
    my ($caller, $seq) = @_;
    my $class = ref($caller) || $caller;
    my $self = bless ( { seq => $seq }, $class );
    return $self;
}

=head2 write_to_game

 Title   : write_to_game
 Usage   : $writer->write_to_game
 Function: writes the sequence object to game-XML 
 Returns : xml as a multiline string
 Args    : none

=cut

sub write_to_game {
    my $self   = shift;
    my $seq    = $self->{seq};

    # save the flat features, just in case
    $self->{feats} = [ $seq->remove_SeqFeatures ];

    # intercept snRNAs and transposons with contained genes
    my @gene_containers = ();
    for ( @{$self->{feats}} ) {
	if ( $_->primary_tag =~ /snRNA|repeat_region|transpos/ && 
             $_->has_tag('gene') ) {
	    my @genes = $_->get_tag_values('gene');
	    my ($min, $max) = (10000000000000,-10000000000000);
	    for my $g ( @genes ) {
		my $gene;
		for my $item ( @{$self->{feats}} ) {
		    next unless $item->primary_tag eq 'gene';
		    my ($n) = $item->get_tag_values('gene');
		    next unless $n eq $g;
		    $g = $item;
		    last;
		}
		$max = $g->end if $g->end > $max;
		$min = $g->start if $g->start < $min;
	    }
	    
	    push @gene_containers, $_ if $_->length >= ($max - $min);
	}
	else {
	    $seq->add_SeqFeature($_);
	}
    }

    # unflatten the gene containment hierarchies
    my $uf = Bio::SeqFeature::Tools::Unflattener->new;
    $uf->unflatten_seq( -seq => $seq, use_magic => 1 );

    # rearrange snRNA and transposon hierarchies
    $self->_rearrange($seq, @gene_containers);

    # explore nested features
    #for ( $seq->get_SeqFeatures ) {
    #	traverse($_);
    #}

    my $atts  = {};
    my $xml = '';
    # write the XML to a string
    my $xml_handle = IO::String->new($xml);
    my $writer = XML::Writer->new(OUTPUT      => $xml_handle,
			          DATA_MODE   => 1,
			          DATA_INDENT => 2,
				  NEWLINE     => 1
				 );
    $self->{writer} = $writer;
    $writer->xmlDecl("ISO-8859-1");
    $writer->doctype("game", 'game', "http://www.fruitfly.org/annot/gamexml.dtd.txt");
    $writer->comment("GAME-XML generated by Bio::SeqIO::game::gameWriter");
    $writer->comment("Created " . localtime);
    $writer->comment('Questions: smckay@bcgsc.bc.ca');
    $writer->startTag('game', version => 1.2);
    
    my @sources = grep { $_->primary_tag =~ /source|origin|region/i } $seq->get_SeqFeatures;

    for my $source ( @sources ) {
	next unless $source->length == $seq->length;
	for ( qw{ name description db_xref organism md5checksum } ) {
	    if ( $source->has_tag($_) ) {
		$self->{has_organism} = 1 if /organism/;
		($atts->{$_}) = $source->get_tag_values($_);
	    }
	}
    }
    
    my $seqname = $seq->accession unless $seq->accession eq 'unknown';
    $seqname ||= $seq->display_name;
    $atts->{name} ||= $seqname;
    $seq->display_name;
    $self->_seq($seq, $atts);

    # make a map_position element
    my $seqtype;
    if ( $atts->{mol_type} || $seq->alphabet ) {
	$seqtype = $atts->{mol_type} || $seq->alphabet;
    }
    else {
	$seqtype = 'unknown';
    }    

    $writer->startTag(
		      'map_position', 
		      seq => $atts->{name},
		      type => $seqtype
		     );
    
    my ($arm, $start, undef, $end) = $atts->{name} =~ /(\S+):(-?\d+)(\.\.|-)(-?\d+)/;
    $self->_element('arm', $arm) if $arm;
    $self->_span($start, $end);
    $writer->endTag('map_position');
    

    my @feats = $seq->top_SeqFeatures;
    my @addback;
    
    for ( @feats ) {
        # if the feature has subfeatures, we will assume it is a gene
	# (hope this is safe!)
	if ( $_->get_SeqFeatures ) {
	    $self->_write_gene($_);
	}
	else {
	    # non-gene stuff only
	    next if $_->primary_tag =~ /CDS|mRNA|exon|UTR/;
	    $self->_write_feature($_);
	}
    }    
    
    $writer->endTag('game');
    $writer->end;
    $xml;
}

=head2 _rearrange

 Title   : _rearrange
 Usage   : $self->_rearrange($seq)
 Function: internal method to rearrange gene containment hierarchies
           so that snRNA or transposon features contain their genes
           rather than the other way around
 Returns : nothing
 Args    : a Bio::RichSeq object

=cut

sub _rearrange {
    my ($self, $seq, @containers) = @_;
    my @feats   = $seq->remove_SeqFeatures;
    my @genes   = grep { $_->primary_tag eq 'gene' } @feats;
    my @addback = grep { $_->primary_tag ne 'gene' } @feats;
    
    for ( @containers ) {
	my @has_genes = $_->get_tag_values('gene');
	for my $has_gene ( @has_genes ) {
	    for my $gene ( @genes ) {
		next unless $gene;
		my ($gname) = $gene->get_tag_values('gene');
		if ( $gname eq $has_gene ) {
		    $_->add_SeqFeature($gene);
		    undef $gene;
		}
	    }
	}
    }    
   
    push @addback, (@containers, grep { defined $_ } @genes );
    $seq->add_SeqFeature(@addback);
}


=head2 _write_feature

 Title   : _write_feature
 Usage   : $seld->_write_feature($feat, 1)
 Function: internal method for writing generic features as <annotation> elements
 Returns : nothing
 Args    : a Bio::SeqFeature::Generic object and an optional flag to write a
           bare feature set with no annotation wrapper

=cut

sub _write_feature {
    my ($self, $feat, $bare) = @_;
    my $writer = $self->{writer};
    my $id = $self->_find_name($feat, 'standard_name') || $feat->primary_tag;

    unless ( $bare ) {
	$writer->startTag('annotation', id => $id); 
	$self->_element('name', $id);
	$self->_element('type', $feat->primary_tag);
	$self->_tags($feat);
    }

    $writer->startTag('feature_set', id => $id);
    $self->_element('name', $id);
    $self->_element('type', $feat->primary_tag);
    $self->_feature_set_tags($feat);
    $self->_feature_span($id, $feat);
    $writer->endTag('feature_set');
    $writer->endTag('annotation') unless $bare;
}

=head2 _write_gene

 Title   : _write_gene
 Usage   : $self->_write_gene($feature)
 Function: internal method for rendering gene containment hierarchies into 
           an nested <annotation> element 
 Returns : nothing
 Args    : a nested Bio::SeqFeature::Generic gene feature
 Note    : A nested gene hierarchy (gene->mRNA->CDS->exon) is expected.  If other gene 
           subfeatures occur as level one subfeatures (same level as mRNA subfeats) 
           an attempt will be made to link them to transcripts via the 'standard_name'
           qualifier

=cut

sub _write_gene {
    my ($self, $feat) = @_;
    my $writer = $self->{writer};
    my $str = $feat->strand;
    my $id = $self->_find_name($feat, 'standard_name');
    $id ||= $self->_find_name($feat);
    my $gid = $self->_find_name($feat, 'gene') || $id;

    $writer->startTag('annotation', id => $id);
    $self->_element('name', $gid);
    $self->_element('type', $feat->primary_tag);
    $self->_tags($feat);
    
    my @genes;
    
    if ( $feat->primary_tag eq 'gene' ) {
	@genes = ($feat);
    }
    else {
	# we are in a gene container; gene must then be one level down
	@genes = grep { $_->primary_tag eq 'gene' } $feat->get_SeqFeatures;
    }

    for my $g ( @genes ) {
	my $id ||= $self->_find_name($g, 'standard_name');
	my $gid ||= $self->_find_name($g, 'gene') || $self->_find_name($g);
	$writer->startTag('gene', association => 'IS');
        $self->_element('name', $gid);
        $writer->endTag('gene');

        my $proteins;
	my @mRNAs = grep { $_->primary_tag =~ /mRNA|transcript/ } $g->get_SeqFeatures;
	my @other_stuff = grep { $_->primary_tag !~ /mRNA|transcript/ } $g->get_SeqFeatures;
	my @variants = ('A' .. 'Z');

	for my $mRNA (@mRNAs) {
	    my ($sn, @units);
            # if the mRNA is a generic transcript, it must be a non-spliced RNA gene
            # Make a synthetic exon to help build a hierarchy.  We have to assume that
            # the location is not segmented (otherwise it should be a mRNA)
	    if ( $mRNA->primary_tag eq 'transcript') {
		my $exon = Bio::SeqFeature::Generic->new ( -primary => 'exon' );
		$exon->location($mRNA->location);
		$mRNA->add_SeqFeature($exon);
	    }

            # no subfeats? Huh? revert to generic feature
	    unless ( $mRNA->get_SeqFeatures ) {
		$self->_write_feature($mRNA, 1); # 1 flag writes the bare feature
                                                 # with no annotation wrapper
		next;
	    }

	    my $name = $self->_find_name($mRNA, 'standard_name');

	    my %attributes;
            my ($cds) = grep { $_->primary_tag eq 'CDS' } $mRNA->get_SeqFeatures;

	    # make sure we have the right CDS for alternatively spliced genes
	    # (AAAAAARRRGGGHHHHH).  This is meant to deal with sequences 
            # from flattened game annotations, where both the mRNA and CDS
            # have split locations
	    if ( $cds && @mRNAs > 1 && $name ) {
		$cds = $self->_check_cds($cds, $name);
	    }
	    elsif ( $cds && @mRNAs > 1 ) {
		# The mRNA/CDS pairing must be right. Get the transcript name from the CDS
		if ( $cds->has_tag('standard_name') ) {
                    ($name) = $cds->get_tag_values('standard_name');
                }
	    }
	    else {
		# assign a name to the transcript if it has no 'standard_name' binder
		$name ||= @mRNAs > 1 ? $id . '-R' . (shift @variants) : $id;
	    }

	    my $pname;

	    if ( $cds ) {
		if ( $cds->has_tag('standard_name') ) {
		    ($sn) = $cds->get_tag_values('standard_name');
		}

		# catch missing protein ids
		if ( $cds->has_tag('protein_id' ) ) {
		    if ( !$cds->get_tag_values('protein_id') ) {
			$cds->remove_tag('protein_id');
			if ( $cds->has_tag('product') ) {
			    $cds->add_tag_value($cds->get_tag_values('product'));
			}
		    }
		}

		# define the translation offset
		my ($c_start, $c_end);
		if ( $cds->has_tag('codon_start') ){
		    ($c_start) = $cds->get_tag_values('codon_start');
		    $cds->remove_tag('codon_start');
		}
		else {
		    $c_start = 1;
		}
		my $cs  = Bio::SeqFeature::Generic->new;
		if ( $c_start == 1 ) {
		    $c_start = $cds->strand > 0 ? $cds->start : $cds->end;
		}
		if ( $cds->strand < 1 ) {
		    $c_end = $c_start;
		    $c_start = $c_start - 2;
		}
		else {
		    $c_end = $c_start + 2;
		}
		$cs->start($c_start);
		$cs->end($c_end);
		$cs->strand($cds->strand);
		$cs->primary_tag('start_codon');
		$cs->add_tag_value( 'standard_name' => $name );
		push @units, $cs;


		if ( $cds->has_tag('problem') ) {
		    my ($val) = $cds->get_tag_values('problem');
		    $cds->remove_tag('problem');
		    $attributes{problem} = $val;
		}
		
		my ($aa) = $cds->get_tag_values('translation')
		    if $cds->has_tag('translation');
		
		if ( $aa ) {
		    $proteins++;
		    my $psn = $sn;
		    $psn =~ s/-R/-P/;
		    $cds->remove_tag('translation');
		    my %add_seq = ();
		    $add_seq{residues} = $aa;
		    $add_seq{header} = ['seq',
					id     => $psn,
					length => length $aa,
					type   => 'aa' ];
		    
		    if ( $cds->has_tag('product_desc') ) {
			($add_seq{desc}) = $cds->get_tag_values('product_desc');
			$cds->remove_tag('product_desc');
		    }
		    
		    unless ( $add_seq{desc} && $add_seq{desc} =~ /cds_boundaries/ ) {
			my $start = $cds->start;
			my $end   = $cds->end;
			my $str   = $cds->strand;
			$str = $str < 0 ? '[-]' : '';
			$add_seq{desc}  = "translation from_gene[$id] " .
			    "cds_boundaries:(" . $self->{seq}->display_id . 
			    ":$start..$end$str) transcript_info:[$name]";
		    }
		    $self->{add_seqs} ||= [];
		    push @{$self->{add_seqs}}, \%add_seq;
		}
	    }
	    
	    $writer->startTag('feature_set', id => $name);
	    $self->_element('name', $name);
	    $self->_element('type', 'transcript');
	    $self->_feature_set_tags($mRNA);
	    $self->_feature_set_tags($cds) if $cds;
	     
	    # any UTR's, etc associated with this transcript?
	    for my $thing ( @other_stuff ) {
		if ( $thing->has_tag('standard_name') ) {
		    my ($v)  = $thing->get_tag_values('standard_name');
		    if ( $v eq $sn ) {
			push @units, $thing;
		    }
		}
	    }
	    
	    # add the exons
	    push @units, grep { $_->primary_tag eq 'exon' } $mRNA->get_SeqFeatures;
	    @units = sort { $a->start <=> $b->start } @units;

	    my $count  = 0;
	    
	    if ( $str < 0 ) {
		@units = reverse @units;
	    }
            
	    for my $unit ( @units ) {
		if ( $unit->primary_tag eq 'exon' ) {
		    my $ename = $id;
		    $ename .= ':' . ++$count;
		    $self->_feature_span($ename, $unit);
		}
		elsif ( $unit->primary_tag eq 'start_codon' ) {
		    $self->_feature_span(($sn || $gid), $unit, 1);
		}
		else {
		    my $uname = $unit->primary_tag . ":$id";
		    $self->_feature_span($uname, $unit);
		}
	    }
	    $writer->endTag('feature_set');
	}
	
	$self->{other_stuff} = \@other_stuff;
    }    
    
    $writer->endTag('annotation');

    # add the protein sequences
    for ( @{$self->{add_seqs}} ) {
	my %h = %$_;
	$writer->startTag(@{$h{header}});
	my @desc = split /\s+/, $h{desc};
	my $desc = '';
	for my $word (@desc) {
	    my ($lastline) = $desc =~ /.*^(.+)$/sm;
	    $lastline ||= '';
	    $desc .= length $lastline < 50 ? " $word " : "\n      $word ";
	}
        $self->_element('description', "\n     $desc\n    ");

	my $aa = $h{residues};
	$aa =~ s/\w{60}/$&\n      /g;
	$aa =~ s/\n\s+$//m;
	$aa = "\n      " . $aa . "\n    ";
	$self->_element('residues', $aa);
	$writer->endTag('seq');
	$self->{add_seqs} = [];
    }
    
    # Is there anything else associated with the gene?  We have to write other
    # features as stand-alone annotations or apollo will assume they are
    # transcripts
    for my $thing ( @{$self->{other_stuff}} ) {
	next if $thing->has_tag('standard_name');
	$self->_write_feature($thing);
    }
    $self->{other_stuff} = [];
}

=head2 _check_cds

 Title   : _check_cds
 Usage   : $self->_check_cds($cds, $name)
 Function: internal method to check if the CDS associated with an mRNA is
           the correct alternative splice variant
 Returns : a Bio::SeqFeature::Generic CDS object
 Args    : the CDS object plus the transcript\'s 'standard_name'
 Note    : this method only works if alternatively spliced transcripts are bound
           together by a 'standard_name' qualifier.  If none is present, we will
           hope that the exons were derived from a segmented RNA or a CDS with no
           associated mRNA feature.  Neither of these two cases would be confused
           by alternative splice variants.

=cut


sub _check_cds {
    my ($self, $cds, $name) = @_;
    
    # this will only work if the 'standard_name' binder is used
    if ( $cds->has_tag('standard_name') ) {
	my ($cname) = $cds->get_tag_values('standard_name');
	if ( $cname eq $name ) {
	    return $cds;
	}
	else {
	    my @CDS = grep { $_->primary_tag eq 'CDS' } @{$self->{feats}};
	    for ( @CDS ) {
		next unless $_->has_tag('standard_name');
		my ($sname) = $_->get_tag_values('standard_name');
		return $_ if $sname eq $name;
	    }
	    return '';
	}
    }
    # otherwise, just pass back the CDS as is
    else {
	return $cds;
    }

}

################### DEBUGGING ###########################################
# explore the nested gene containment hierarchy
sub traverse {
    my $feat = shift;
    warn $feat->primary_tag, "\n";
    for ($feat->get_SeqFeatures) {
        warn "\t", $_->primary_tag, ' ', sname($_), "\n";
	for my $s ($_->get_SeqFeatures) {
	    warn "\t\t", $s->primary_tag, ' ', sname($s), "\n";
	    for my $ss($s->get_SeqFeatures) {
		warn "\t\t\t", $ss->primary_tag, ' ', sname($ss), "\n";
	    }
	}
    }
}

sub sname {
    my $f = shift;
    return '' unless $f->has_tag('standard_name');
    $f->get_tag_values('standard_name');
}
##########################################################################

=head2 _feature_set_tags

 Title   : _feature_set_tags
 Usage   : $self->_feature_set_tags($feature)
 Function: an internal method to handle tag/value attributes
           for a feature set element
 Returns : nothing
 Args    : a Bio::SeqFeatureI-compliant object

=cut

sub _feature_set_tags {
    my ($self, $feat) = @_;
    my $writer = $self->{'writer'};
    
    my @tags = $feat->get_all_tags;
    for my $tag ( @tags ) {
	next if $tag eq 'timestamp';
        	
	for my $val ( $feat->get_tag_values($tag) ) { 
	    if ( $tag eq 'date' ) {
		my ($date) = $feat->get_tag_values($tag);
		my %timestamp;
		if ( $feat->has_tag('timestamp') ) {
		    ($timestamp{'timestamp'}) = $feat->get_tag_values('timestamp'); 
		    $feat->remove_tag('timestamp');
		}
		$self->_element('date', $val, \%timestamp);
	    }
            elsif ( $tag eq 'comment' ) {
                unless ( $val =~ /=.+?;.+=/ ) {
                    $writer->startTag('comment');
                    $self->_element('text', $val);
                    $writer->endTag('comment');
                }
                else{
                    $self->_unflatten_attribute('comment', $val);
                }
            }
	    else {
		$self->_property($tag, $val);
	    }
	}
    }
}


=head2 _property

 Title   : _property
 Usage   : $self->_property($tag => $value); 
 Function: an internal method to write property XML elements
 Returns : nothing
 Args    : a tag/value pair

=cut

sub _property {
    my ($self, $tag, $val) = @_;
    my $writer = $self->{writer};
    
    if ( length $val > 45 ) {
	my @val = split /\s+/, $val;
	$val = '';
	
	for my $word (@val) {
	    my ($lastline) = $val =~ /.*^(.+)$/sm;
	    $lastline ||= '';
	    $val .= length $lastline < 45 ? " $word " : "\n          $word";
	}
	$val = "\n         $val\n        ";
	$val =~ s/(\S)\s{2}(\S)/$1 $2/g;
    }
    $writer->startTag('property');
    $self->_element('type', $tag);
    $self->_element('value', $val);
    $writer->endTag('property');
}

=head2 _tags

 Title   : _tags
 Usage   : $self->_tags($feat)
 Function: an internal method to intercept GO terms and
           db_xrefs and handle generic tag/value pairs for a gene
 Returns : nothing 
 Args    : a Bio::SeqFeatureI-compliant object

=cut

sub _tags {
    my ($self, $feat) = @_;
    my $writer = $self->{writer};
    my @tags = $feat->get_all_tags;
    
    for my $tag ( @tags ) {
	for my $val ( $feat->get_tag_values($tag) ) {
	    if ( $tag =~ /xref/ && $val =~ /GO/ ) {
		    $writer->startTag('aspect');
		    $self->_xref($val);
		    $writer->endTag('aspect');
	    }
	    elsif ( $tag eq 'comment' ) {
                unless ( $val =~ /=.+?;.+=/ ) {
                    $writer->startTag('comment');
                    $self->_element('text', $val);
                    $writer->endTag('comment');
                }
                else{
		    $self->_unflatten_attribute('comment', $val);
                }
            }
	    else {
		$self->_property($tag, $val);
	    }
	}
    }
}

=head2 _unflatten_attribute

 Title   : _unflatten_attribute
 Usage   : $self->_unflatten_attribute($name, $value)
 Function: an internal method to unflatten and write comment or evidence elements
 Returns : nothing
 Args    : a list of strings

=cut

sub _unflatten_attribute {
    my ($self, $name, $val) = @_;
    my $writer = $self->{writer};
    my %pair;
    my @pairs = split ';', $val;
    for my $p ( @pairs ) {
	my @pair = split '=', $p;
	$pair[0] =~ s/^\s+|\s+$//g;
	$pair[1] =~ s/^\s+|\s+$//g;
	$pair{$pair[0]} = $pair[1];
    }
    $writer->startTag($name);
    for ( keys %pair ) {
	$self->_element($_, $pair{$_});
    }
    $writer->endTag($name);
    

}

=head2 _xref

 Title   : _xref
 Usage   : $self->_xref($value) 
 Function: an internal method to write db_xref elements
 Returns : nothing 
 Args    : a list of strings

=cut

sub _xref {
    my ($self, @xrefs) = @_;
    my $writer = $self->{writer};
    for my $xref ( @xrefs ) {
	my ($db, $acc) = $xref =~ /(\S+):(\S+)/;
	$writer->startTag('dbxref');
	$self->_element('xref_db', $db);
	$acc = $xref if $db eq 'GO';
	$self->_element('db_xref_id', $acc);
	$writer->endTag('dbxref');
    }
}

=head2 _feature_span

 Title   : _feature_span
 Usage   : $self->_feature_span($name, $type, $loc)
 Function: an internal method to write a feature_span element
          (the actual feature with coordinates)
 Returns : nothing 
 Args    : a feature name and Bio::SeqFeatureI-compliant object

=cut

sub _feature_span {
    my ($self, $name, $feat, $p) = @_;
    my $type = $feat->primary_tag;
    my $writer = $self->{writer};
    my %atts = ( id => $name );
    
    if ( $p ) {
	my $pname = $name;
	$pname =~ s/-R/-P/;
	$atts{produces_seq} = $pname;
    }

    $writer->startTag('feature_span', %atts );
    $self->_element('name', $name);
    $self->_element('type', $type);
    $self->_seq_relationship('query', $feat);
    $writer->endTag('feature_span');
}

=head2 _seq_relationship

 Title   : _seq_relationship
 Usage   : $self->_seq_relationship($type, $loc)
 Function: an internal method to handle feature_span sequence relationships
 Returns : nothing 
 Args    : feature type and a Bio::LocationI-compliant object

=cut

sub _seq_relationship {
    my ($self, $type, $loc) = @_;
    my $writer = $self->{'writer'};
    
    $writer->startTag(
		      'seq_relationship',
		      type => $type,
		      seq  => ($self->{seq}->accession || $self->{seq}->display_id)
		     );
    $self->_span($loc);
    $writer->endTag('seq_relationship');
}

=head2 _element

 Title   : _element
 Usage   : $self->_element($name, $chars, $atts)
 Function: an internal method to generate 'generic' XML elements
 Example : 
 my $name = 'foo';
 my $content = 'bar';
 my $attributes = { baz => 1 }; 
 # print the element
 $self->_element($name, $content, $attributes);
 Returns : nothing 
 Args    : the element name and content plus a ref to an attribute hash

=cut

sub _element {
    my ($self, $name, $chars, $atts) = @_;
    my $writer = $self->{writer};
    my %atts = $atts ? %$atts : ();
    
    $writer->startTag($name, %atts);
    $writer->characters($chars);
    $writer->endTag($name);
}

=head2 _span

 Title   : _span
 Usage   : $self->_span($loc)
 Function: an internal method to write the 'span' element
 Returns : nothing
 Args    : a Bio::LocationI-compliant object

=cut

sub _span {
    my ($self, @loc) = @_;
    my ($loc, $start, $end);

    if ( @loc == 1 ) {
	$loc = $loc[0];
    }
    elsif ( @loc == 2 ) {
	($start, $end) = @loc;
    }

    if ( $loc ) {
	($start, $end) = ($loc->start, $loc->end);
	($start, $end) = ($end, $start) if $loc->strand < 0;
    } 
    elsif ( !$start ) {
	($start, $end) = (1, $self->{seq}->length);
    }
    
    my $writer = $self->{writer};
    $writer->startTag('span');
    $self->_element('start', $start);
    $self->_element('end', $end);
    $writer->endTag('span');
}

=head2 _seq

 Title   : _seq
 Usage   : $self->_seq($seq, $dna) 
 Function: an internal method to print the 'sequence' element
 Returns : nothing
 Args    : and Bio::SeqI-compliant object and a reference to an attribute  hash

=cut

sub _seq {
    my ($self, $seq, $atts) = @_;

    my $writer = $self->{'writer'};
    
    # game moltypes
    my $alphabet = $seq->alphabet;
    $alphabet ||= $seq->mol_type if $seq->can('mol_type');
    $alphabet =~ s/protein/aa/;
    $alphabet =~ s/rna/cdna/;
    
    my @seq = ( 'seq',
		id     => $atts->{name},
		length => $seq->length,
		type   => $alphabet,
	       	focus  => "true"	       
	      );

    if ( $atts->{md5checksum} ) {
	push @seq, (md5checksum => $atts->{md5checksum});
	delete $atts->{md5checksum};
    }
    $writer->startTag(@seq);

    for my $k ( keys %{$atts} ) {
	$self->_element($k, $atts->{$k});
    }
    
    # add leading spaces and line breaks for 
    # nicer xml formatting/indentation
    my $sp  = (' ' x 6);
    my $dna = $seq->seq;
    $dna =~ s/\w{60}/$&\n$sp/g;
    $dna = "\n$sp" . $dna . "\n    ";
    
    if ( $seq->species && !$self->{has_organism}) {
        my $species = $seq->species->binomial;
	$self->_element('organism', $species);
    }
    
    $self->_element('residues', $dna);
    $writer->endTag('seq');
}

=head2 _find_name

 Title   : _find_name
 Usage   : my $name = $self->_find_name($feature)
 Function: an internal method to look for a gene name
 Returns : a string 
 Args    : a Bio::SeqFeatureI-compliant object

=cut

sub _find_name {
    my ($self, $feat, $key) = @_;
    my $name;
    
    if ( $key && $feat->has_tag($key) ) {
	($name) = $feat->get_tag_values($key);
	return $name;
    }

    for ( qw/ gene standard_name locus_tag symbol / ) {
	($name) = $feat->get_tag_values($_) if $feat->has_tag($_);
        if ( $name ) {
	    return $name;
	}
    }

    # I give up!!!
    return $feat->display_name || '';
}

1;