Bio::SeqIO
bsml
Toolbar
Summary
Bio::SeqIO::bsml - BSML sequence input/output stream
Package variables
Privates (from "my" definitions)
$idcounter = {}
$nvtoken = ": "
Included modules
Inherit
Synopsis
It is probably best not to use this object directly, but rather go
through the SeqIO handler system. To read a BSML file:
$stream = Bio::SeqIO->new( -file => $filename, -format => 'bsml');
while ( my $bioSeqObj = $stream->next_seq() ) {
# do something with $bioSeqObj
}
To write a Seq object to the current file handle in BSML XML format:
$stream->write_seq( -seq => $seqObj);
If instead you would like a XML::DOM object containing the BSML, use:
my $newXmlObject = $stream->to_bsml( -seq => $seqObj);
Description
This object can transform Bio::Seq objects to and from BSML (XML)
flatfiles.
2/1/02 - I have changed the API to more closely match argument
passing used by other BioPerl methods ( -tag => value ). Internal
methods are using the same API, but you should not be calling those
anyway...
Methods
Methods description
Title : _add_page
Usage : $obj->_add_page($xmlDocument, $xmlSequenceObject)
Function: Adds a simple <Page> and <View> structure for a <Sequence>
Returns : a reference to the newly created <Page>
Args : 0 The DOM::Document being modified
1 Reference to the <Sequence> object |
Title : _addel
Usage : $obj->_addel($parentElem, 'ChildName',
{ anAttr => 'someValue', anotherAttr => 'aValue',})
Function: Add an element with attribute values to a DOM tree
Returns : a reference to the newly added element
Args : 0 The DOM::Element parent that you want to add to
1 The name of the new child element
2 Optional hash reference containing
attribute name => attribute value assignments |
Title : _initialize
Usage : $dom = $obj->_initialize(@args)
Function: Coppied from embl.pm, and augmented with initialization of the
XML DOM tree
Returns :
Args : -file => the XML file to be parsed |
Title : _parse_annotation
Usage : $obj->_parse_annotation(@args )
Function: Will examine any Annotations found in -obj. Data found in
::Comment and ::DBLink structures, as well as Annotation
description fields are stored in -desc for later
generation of <Attribute>s. <Reference> objects are generated
from ::References, and are stored in -refs - these will
be appended to the XML tree later.
Returns :
Args : Argument array. Recognized keys:
-xml The DOM::Document being modified
-obj Reference to the Bio object being analyzed
-descr An array reference for holding description text items
-refs An array reference to hold DOM objects
-id Optional. If the XML id for the 'calling' element is
provided, it will be placed in any refs
attribute. |
Title : _parse_annotation_old
Usage : $obj->_parse_annotation_old(@args)
Function: As above, but for the old Annotation system.
Apparently needed because Features are still using the old-style
annotations?
Returns :
Args : Argument array. Recognized keys:
-xml The DOM::Document being modified
-obj Reference to the Bio object being analyzed
-descr An array reference for holding description text items
-refs An array reference to hold DOM objects
-id Optional. If the XML id for the 'calling' element is
provided, it will be placed in any refs
attribute. |
Title : _parse_bsml_feature
Usage : $obj->_parse_bsml_feature($xmlFeature )
Function: Will examine the <Feature> element provided by $xmlFeature and
return a generic seq feature.
Returns : Bio::SeqFeature::Generic
Args : 0 XML::DOM::Element <Feature> being analyzed. |
Title : _parse_bsml_location
Usage : $obj->_parse_bsml_feature( $intOrSiteLoc, $gsfObject )
Function: Will examine the <Interval-loc> or <Site-loc> element provided
Returns : Bio::SeqFeature::Generic
Args : 0 XML::DOM::Element <Interval/Site-loc> being analyzed.
1 Optional SeqFeature::Generic to use |
Title : _parse_location
Usage : $obj->_parse_location($xmlDocument, $parentElem, $SeqFeatureObj)
Function: Adds <Interval-loc> and <Site-loc> children to <$parentElem> based
on locations / sublocations found in $SeqFeatureObj. If
sublocations exist, the original location will be ignored.
Returns : An array ref containing the elements added to the parent.
These will have already been added to <$parentElem>
Args : 0 The DOM::Document being modified
1 The DOM::Element parent that you want to add to
2 Reference to the Bio::SeqFeature being analyzed |
Title : _parse_reference
Usage : $obj->_parse_reference(@args )
Function: Makes a new <Reference> object from a ::Reference, which is
then stored in an array provide by -refs. It will be
appended to the XML tree later.
Returns :
Args : Argument array. Recognized keys:
-xml The DOM::Document being modified
-refobj The Annotation::Reference Object
-refs An array reference to hold the new DOM object
-id Optional. If the XML id for the 'calling' element is
provided, it will be placed in any refs
attribute. |
Title : _parse_xml
Usage : $dom = $obj->_parse_xml($filename)
Function: uses XML::DOM to construct a DOM tree from the BSML document
Returns : a reference to the parsed DOM tree
Args : 0 Path to the XML file needing to be parsed |
Title : _parseparams
Usage : my $paramHash = $obj->_parseparams(@args)
Function: Borrowed from Bio::Parse.pm, who borrowed it from CGI.pm
Lincoln Stein -> Richard Resnick -> here
Returns : A hash reference of the parameter keys (uppercase) pointing to
their values.
Args : An array of key, value pairs. Easiest to pass values as:
-key1 => value1, -key2 => value2, etc
Leading "-" are removed. |
Title : _show_dna
Usage : $obj->_show_dna($newval)
Function: (cut-and-pasted directly from embl.pm)
Returns : value of _show_dna
Args : newvalue (optional) |
Title : next_seq
Usage : my $bioSeqObj = $stream->next_seq
Function: Retrieves the next sequence from a SeqIO::bsml stream.
Returns : A reference to a Bio::Seq::RichSeq object
Args : |
Title : to_bsml
Usage : my $domDoc = $obj->to_bsml(@args)
Function: Generates an XML structure for one or more Bio::Seq objects.
If $seqref is an array ref, the XML tree generated will include
all the sequences in the array.
Returns : A reference to the XML DOM::Document object generated / modified
Args : Argument array in form of -key => val. Recognized keys:
-seq A Bio::Seq reference, or an array reference of many of them
-xmldoc Specifies an existing XML DOM document to add the sequences
to. If included, then only data (no page formatting) will
be added. If not, a new XML::DOM::Document will be made,
and will be populated with both data, as well as
display elements.
-nodisp Do not generate elements, or any children
thereof, even if -xmldoc is not set.
-skipfeat If set to 'all', all s will be skipped. If it is
a hash reference, any with a class matching a key
in the hash will be skipped - for example, to skip 'source'
and 'score' features, use:
-skipfeat => { source => 'Y', score => 'Y' }
-skiptags As above: if set to 'all', no tags are included, and if a
hash reference, those specific tags will be ignored.
Skipping some or all tags and features can result in
noticable speed improvements.
-nodata If true, then will not be included. This may be
useful if you just want annotations and do not care about
the raw ACTG information.
-return Default is 'xml', which will return a reference to the BSML
XML object. If set to 'seq' will return an array ref of the
objects added (rather than the whole XML object)
-close Early BSML browsers will crash if an element *could* have
children but does not, and is closed as an empty element
e.g. . If -close is true, then such tags are given
a comment child to explicitly close them e.g. . This is default true, set to "0" if you do
not want this behavior.
Examples : my $domObj = $stream->to_bsml( -seq => \@fourCoolSequenceObjects,
-skipfeat => { source => 1 },
);
# Or add sequences to an existing BSML document:
$stream->to_bsml( -seq => \@fourCoolSequenceObjects,
-skipfeat => { source => 1 },
-xmldoc => $myBsmlDocumentInProgress, ); |
Title : write_seq
Usage : $obj->write_seq(@args)
Function: Prints out an XML structure for one or more Bio::Seq objects.
If $seqref is an array ref, the XML tree generated will include
all the sequences in the array. This method is fairly simple,
most of the processing is performed within to_bsml.
Returns : A reference to the XML object generated / modified
Args : Argument array. Recognized keys:
-seq A Bio::Seq reference, or an array reference of many of them
Alternatively, the method may be called simply as...
$obj->write_seq( $bioseq )
... if only a single argument is passed, it is assumed that
it is the sequence object (can also be an array ref of
many Seq objects )
-printmime If true prints "Content-type: $mimetype\n\n" at top of
document, where $mimetype is the value designated by this
key. For generic XML use text/xml, for BSML use text/x-bsml
-return This option will be supressed, since the nature of this
method is to print out the XML document. If you wish to
retrieve the <Sequence> objects generated, use the to_bsml
method directly. |
Methods code
sub DESTROY
{ my $self = shift;
my $dom = $self->{'domtree'};
$dom->dispose if ($dom);} | sub FIRSTDATA
{ my $element = shift;
return undef unless ($element);
my $hopefuls = $element->getChildNodes;
my $data;
for (my $i = 0; $i < $hopefuls->getLength; $i++) {
if ($hopefuls->item($i)->getNodeType ==
XML::DOM::Node::TEXT_NODE() ) {
$data = $hopefuls->item($i)->getNodeValue;
last;
}
}
return $data;
}
} | sub FLOPPYVALS
{ my $obj = shift;
my ($name, $value);
if ($obj->getNodeName eq "Attribute") {
$name = $obj->getAttribute('name');
$value = $obj->getAttribute('content');
} elsif ($obj->getNodeName eq "Qualifier") {
my $n = $obj->getAttribute('value-type');
$name = $n if ($n ne "");
my $v = $obj->getAttribute('value');
$value = $v if ($v ne "");
}
return ($name, $value);
}
} | sub GETFLOPPIES
{ my $obj = shift;
my @floppies;
my $attributes = $obj->getElementsByTagName ("Attribute");
for (my $i = 0; $i < $attributes->getLength; $i++) {
push @floppies, $attributes->item($i);
}
my $qualifiers = $obj->getElementsByTagName ("Qualifier");
for (my $i = 0; $i < $qualifiers->getLength; $i++) {
push @floppies, $qualifiers->item($i);
}
return\@ floppies;
}
} | sub STRIP
{ my $string = shift;
$string =~ s/[\s\r\n]+/ /g;
return $string;} | sub _add_page
{ my $self = shift;
my ($xml, $seq) = @_;
my $disp = $xml->getElementsByTagName("Display")->item(0);
my $page = $self->_addel($disp, "Page");
my ($width, $height) = ( 7.8, 5.5);
my $screen = $self->_addel($page, "Screen", {
width => $width, height => $height, });
my $view = $self->_addel($page, "View", {
seqref => $seq->getAttribute('id'),
title => $seq->getAttribute('title'),
title1 => "{NAME}",
title2 => "{LENGTH} {UNIT}",
});
$self->_addel($view, "View-line-widget", {
shape => 'horizontal',
hcenter => $width/2 + 0.7,
'linear-length' => $width - 2,
});
$self->_addel($view, "View-axis-widget");
return $page;} | sub _addel
{ my $self = shift;
my ($root, $name, $attr) = @_;
my $doc = $root->getOwnerDocument || $root;
my $elem = $doc->createElement($name);
foreach my $a (keys %{$attr}) {
$elem->setAttribute($a, $attr->{$a});
}
$root->appendChild($elem);
return $elem;} | sub _initialize
{ my($self,@args) = @_;
$self->SUPER::_initialize(@args);
$self->{'_func_ftunit_hash'} = {};
$self->_show_dna(1);
my %param = @args;
@param{ map { lc $_ } keys %param } = values %param;
if ( exists $param{-file} && $param{-file} !~ /^>/) {
$self->{'domtree'} = $self->_parse_xml( $param{-file} );
$self->{'current_node'} = 0;
}
$self->sequence_factory( new Bio::Seq::SeqFactory
( -verbose => $self->verbose(),
-type => 'Bio::Seq::RichSeq'))
if( ! defined $self->sequence_factory ); } | sub _parse_annotation
{ my $self = shift;
my $args = $self->_parseparams( @_);
my ($xml, $obj, $descRef, $refRef) =
( $args->{XML}, $args->{OBJ}, $args->{DESC}, $args->{REFS} );
my $ann = $obj->annotation;
return undef unless ($ann);
unless (ref($ann) =~ /Collection/) {
$self->_parse_annotation_old(@_);
return;
}
foreach my $key ($ann->get_all_annotation_keys()) {
foreach my $thing ($ann->get_Annotations($key)) {
if ($key eq 'description') {
push @{$descRef}, ["description" , $thing->value];
} elsif ($key eq 'comment') {
push @{$descRef}, ["comment" , $thing->text];
} elsif ($key eq 'dblink') {
push @{$descRef}, ["db_xref" , $thing->database . ":"
. $thing->primary_id ];
if (my $com = $thing->comment) {
push @{$descRef}, ["link" , $com->text ];
}
} elsif ($key eq 'reference') {
$self->_parse_reference( @_, -refobj => $thing );
} elsif (ref($thing) =~ /SimpleValue/) {
push @{$descRef}, [$key , $thing->value];
} else {
push @{$descRef}, ["error", "bsml.pm did not understand ".
"'$key' = '$thing'" ];
}
}
}} | sub _parse_annotation_old
{ my $self = shift;
my $args = $self->_parseparams( @_);
my ($xml, $obj, $descRef, $refRef) =
( $args->{XML}, $args->{OBJ}, $args->{DESC}, $args->{REFS} );
if (my $ann = $obj->annotation) {
push @{$descRef}, ["annotation", $ann->description];
foreach my $com ($ann->each_Comment) {
push @{$descRef}, ["comment" , $com->text];
}
foreach my $gene ($ann->each_gene_name) {
push @{$descRef}, ["gene" , $gene];
}
foreach my $link ($ann->each_DBLink) {
push @{$descRef}, ["db_xref" ,
$link->database . ":" . $link->primary_id ];
if (my $com = $link->comment) {
push @{$descRef}, ["link" , $com->text ];
}
}
foreach my $ref ($ann->each_Reference) {
$self->_parse_reference( @_, -refobj => $ref );
}
}} | sub _parse_bsml_feature
{ my $self = shift;
my ($feat) = @_;
my $basegsf = new Bio::SeqFeature::Generic;
if ( my $val = $feat->getAttribute("class") ) {
$basegsf->primary_tag($val);
}
my @locations = ();
foreach my $kid ($feat->getChildNodes) {
my $nodeName = $kid->getNodeName;
next unless ($nodeName eq "Interval-loc" ||
$nodeName eq "Site-loc");
push @locations, $kid;
}
if ($#locations == 0) {
$self->_parse_bsml_location($locations[0], $basegsf);
} elsif ($#locations > 0) {
foreach my $location (@locations) {
my $subgsf = $self->_parse_bsml_location($location);
$basegsf->add_sub_SeqFeature($subgsf, 'EXPAND');
}
} else {
}
my $floppies = &GETFLOPPIES($feat);
foreach my $attr (@{$floppies}) {
my ($name, $content) = &FLOPPYVALS($attr);
if ($name =~ /xref/i) {
}
$basegsf->add_tag_value(lc($name), $content);
}
if ( (my $val = $feat->getAttribute('id')) &&
!$basegsf->has_tag('bsml-id')) {
}
return $basegsf;} | sub _parse_bsml_location
{ my $self = shift;
my ($loc, $gsf) = @_;
$gsf ||= new Bio::SeqFeature::Generic;
my $type = $loc->getNodeName;
my ($start, $end);
if ($type eq 'Interval-loc') {
$start = $loc->getAttribute('startpos');
$end = $loc->getAttribute('endpos');
} elsif ($type eq 'Site-loc') {
$start = $end = $loc->getAttribute('sitepos');
} else {
warn "Unknown location type '$type', could not make GSF\n";
return undef;
}
$gsf->start($start);
$gsf->end($end);
if (my $s = $loc->getAttribute("complement")) {
if ($s) {
$gsf->strand(-1);
} else {
$gsf->strand(1);
}
} else {
$gsf->strand(0);
}
return $gsf;} | sub _parse_location
{ my $self = shift;
my ($xml, $xmlFeat, $bioFeat) = @_;
my $bioLoc = $bioFeat->location;
my @locations;
if (ref($bioLoc) =~ /Split/) {
@locations = $bioLoc->sub_Location;
@locations = ($bioLoc);
} else {
@locations = ($bioLoc);
}
my @added = ();
foreach my $loc (@locations) {
my ($start, $end) = ($loc->start, $loc->end);
my %locAttr;
$locAttr{complement} = 1 if ($loc->strand == -1);
if ($start ne "" && ($start == $end || $end eq "")) {
$locAttr{sitepos} = $start;
push @added, $self->_addel($xmlFeat,'Site-loc',\%locAttr);
} elsif ($start ne "" && $end ne "") {
if ($start > $end) {
($start, $end) = ($end, $start);
$locAttr{complement} = 1;
}
$locAttr{startpos} = $start;
$locAttr{endpos} = $end;
push @added, $self->_addel($xmlFeat,'Interval-loc',\%locAttr);
} else {
warn "Failure to parse SeqFeature location. Start = '$start' & End = '$end'";
}
}
return\@ added;} | sub _parse_reference
{ my $self = shift;
my $args = $self->_parseparams( @_);
my ($xml, $ref, $refRef) = ($args->{XML}, $args->{REFOBJ}, $args->{REFS});
my $xmlRef = $xml->createElement("Reference");
if (my $link = $ref->medline) {
$xmlRef->setAttribute('dbxref', $link);
}
my %stuff = ( start => $ref->start,
end => $ref->end,
rp => $ref->rp,
comment => $ref->comment,
pubmed => $ref->pubmed,
);
foreach my $s (keys %stuff) {
$self->_addel($xmlRef, "Attribute", {
name => $s, content => $stuff{$s} }) if ($stuff{$s});
}
$xmlRef->setAttribute('refs', $args->{ID}) if ($args->{ID});
$self->_addel($xmlRef, "RefAuthors")->
appendChild( $xml->createTextNode(&STRIP($ref->authors)) );
$self->_addel($xmlRef, "RefTitle")->
appendChild( $xml->createTextNode(&STRIP($ref->title)) );
$self->_addel($xmlRef, "RefJournal")->
appendChild( $xml->createTextNode(&STRIP($ref->location)) );
push @{$refRef}, $xmlRef;} | sub _parse_xml
{ my $self = shift;
my $file = shift;
unless (-e $file) {
$self->throw("Could not parse non-existant XML file '$file'.");
return undef;
}
my $parser = new XML::DOM::Parser;
my $doc = $parser->parsefile ($file);
return $doc;} | sub _parseparams
{ my $self = shift;
my %hash = ();
my @param = @_;
for (my $i=0;$i<@param;$i+=2) {
$param[$i]=~s/^\-//;
$param[$i]=~tr/a-z/A-Z/;
}
pop @param if @param %2;
%hash = @param;
return\% hash;} | sub _show_dna
{ my $obj = shift;
if( @_ ) {
my $value = shift;
$obj->{'_show_dna'} = $value;
}
return $obj->{'_show_dna'};} | sub next_seq
{ my $self = shift;
my ($desc);
my $bioSeq = $self->sequence_factory->create(-verbose =>$self->verbose());
unless (exists $self->{'domtree'}) {
$self->throw("A BSML document has not yet been parsed.");
return undef;
}
my $dom = $self->{'domtree'};
my $seqElements = $dom->getElementsByTagName ("Sequence");
if ($self->{'current_node'} == $seqElements->getLength ) {
return undef;
}
my $xmlSeq = $seqElements->item($self->{'current_node'});
if (my $val = $xmlSeq->getAttribute( "title")) {
$bioSeq->display_id($val);
}
if (my $val = $xmlSeq->getAttribute( "molecule" )) {
my %mol = ('dna' => 'DNA', 'rna' => 'RNA', 'aa' => 'protein');
$bioSeq->molecule($mol{ lc($val) });
}
if (my $val = $xmlSeq->getAttribute( "ic-acckey" )) {
$bioSeq->accession_number($val);
}
if (my $seqData = &FIRSTDATA($xmlSeq->getElementsByTagName("Seq-data")
->item(0) ) ) {
$seqData =~ s/[\s\n\r]//g;
$bioSeq->seq($seqData);
} elsif (my $import = $xmlSeq->getElementsByTagName("Seq-dataimport")
->item(0) ) {
} elsif (my $val = $xmlSeq->getAttribute("length")) {
$bioSeq->length($val);
}
my $species = Bio::Species->new();
my @classification = ();
my @seqDesc = ();
my %specs = ('common_name' => 'y',
'genus' => 'y',
'species' => 'y',
'sub_species' => 'y', );
my %seqMap = (
'add_date' => [ 'date' ],
'keywords' => [ 'keyword', ],
'seq_version' => [ 'version' ],
'division' => [ 'division' ],
'add_secondary_accession' => ['accession'],
'pid' => ['pid'],
'primary_id' => [ 'primary.id', 'primary_id' ],
);
my $floppies = &GETFLOPPIES($xmlSeq);
foreach my $attr (@{$floppies}) {
my $parent = $attr->getParentNode->getNodeName;
next unless($parent eq "Sequence" || $parent eq "Feature-tables");
my ($name, $content) = &FLOPPYVALS($attr);
$name = lc($name);
if (exists $specs{$name}) {
$species->$name($content);
next;
}
my $value = "";
foreach my $method (keys %seqMap) {
foreach my $match (@{$seqMap{$method}}) {
$value ||= $content if ($name =~ /$match/i);
}
if ($value ne "") {
$bioSeq->$method($value);
last;
}
}
next if ($value ne "");
if ($name =~ /^species$/i) {
if ($content =~ / /) {
my @break = split " ", $content;
@classification = reverse @break;
} else {
$classification[0] = $content;
}
next;
}
if ($name =~ /sub[_ ]?species/i) {
$species->sub_species( $content );
next;
}
if ($name =~ /classification/i) {
my @bits = split " ", $content;
for my $i (0..$#bits) {
$bits[$i] =~ /(\w+)/;
$bits[$i] = $1;
}
$species->classification( @bits );
next;
}
if ($name =~ /comment/) {
my $com = Bio::Annotation::Comment->new('-text' => $content);
$bioSeq->annotation->add_Annotation('comment', $com);
next;
}
if ($name =~ /descr/) {
push @seqDesc, $content;
next;
}
my $simp = Bio::Annotation::SimpleValue->new( -value => $content);
$bioSeq->annotation->add_Annotation($name, $simp);
}
unless ($#seqDesc < 0) {
$bioSeq->desc( join "; ", @seqDesc);
}
my @refs;
my %tags = (
-title => "RefTitle",
-authors => "RefAuthors",
-location => "RefJournal",
);
foreach my $ref ( $xmlSeq->getElementsByTagName ("Reference") ) {
my %refVals;
foreach my $tag (keys %tags) {
my $rt = &FIRSTDATA($ref->getElementsByTagName($tags{$tag})
->item(0));
$rt =~ s/^[\s\r\n]+//;
$rt =~ s/[\s\r\n]+$//;
$rt =~ s/[\s\r\n]+/ /;
$refVals{$tag} = $rt;
}
my $reference = Bio::Annotation::Reference->new( %refVals );
my %refMap = (
comment => [ 'comment', 'remark' ],
medline => [ 'medline', ],
pubmed => [ 'pubmed' ],
start => [ 'start', 'begin' ],
end => [ 'stop', 'end' ],
);
my @refCom = ();
my $floppies = &GETFLOPPIES($ref);
foreach my $attr (@{$floppies}) {
my ($name, $content) = &FLOPPYVALS($attr);
my $value = "";
foreach my $method (keys %refMap) {
foreach my $match (@{$refMap{$method}}) {
$value ||= $content if ($name =~ /$match/i);
}
if ($value ne "") {
my $str = '$reference->' . $method . "($value)";
eval($str);
next;
}
}
next if ($value ne "");
push @refCom, $name . $nvtoken . $content;
}
unless ($#refCom < 0) {
my $exist = $reference->comment;
$exist .= join ", ", @refCom;
$reference->comment($exist);
}
push @refs, $reference;
}
$bioSeq->annotation->add_Annotation('reference'=>$_) foreach @refs;
foreach my $feat ( $xmlSeq->getElementsByTagName("Feature") ) {
$bioSeq->add_SeqFeature( $self->_parse_bsml_feature($feat) );
}
$species->classification( @classification );
$bioSeq->species( $species );
$self->{'current_node'}++;
return $bioSeq;
}
} | sub to_bsml
{ my $self = shift;
my $args = $self->_parseparams( -close => 1,
-return => 'xml',
@_);
$args->{NODISP} ||= $args->{NODISPLAY};
my $seqref = $args->{SEQ};
$seqref = (ref($seqref) eq 'ARRAY') ? $seqref : [ $seqref ];
my $xml;
my ($bsmlElem, $defsElem, $seqsElem, $dispElem);
if ($args->{XMLDOC}) {
$xml = $args->{XMLDOC};
unless ($xml->isa("XML::DOM::Document")) {
die ('SeqIO::bsml.pm error:\n'.
'When calling ->to_bsml( { xmldoc => $myDoc }), $myDoc\n ' .
'should be an XML::DOM::Document object, or an object that\n'.
'inherits from that class (like BsmlHelper.pm)');
}
} else {
$xml = XML::DOM::Document->new();
$xml->setXMLDecl( $xml->createXMLDecl("1.0") );
my $url = "http://www.labbook.com/dtd/bsml2_2.dtd";
my $doc = $xml->createDocumentType("Bsml",$url);
$xml->setDoctype($doc);
$bsmlElem = $self->_addel( $xml, 'Bsml');
$defsElem = $self->_addel( $bsmlElem, 'Definitions');
$seqsElem = $self->_addel( $defsElem, 'Sequences');
unless ($args->{NODISP}) {
$dispElem = $self->_addel( $bsmlElem, 'Display');
my $stylElem = $self->_addel( $dispElem, 'Styles');
my $style = $self->_addel( $stylElem, 'Style', {
type => "text/css" });
my $styleText =
qq(Interval-widget { display : "1"; }\n) .
qq(Feature { display-auto : "1"; });
$style->appendChild( $xml->createTextNode($styleText) );
}
}
$bsmlElem ||= $xml->getElementsByTagName("Bsml")->item(0);
$defsElem ||= $xml->getElementsByTagName("Definitions")->item(0);
$seqsElem ||= $xml->getElementsByTagName("Sequences")->item(0);
my %mol = ('dna' => 'DNA', 'rna' => 'RNA', 'protein' => 'AA');
my @xmlSequences;
foreach my $bioSeq (@{$seqref}) {
my $xmlSeq = $xml->createElement("Sequence");
my $FTs = $xml->createElement("Feature-tables");
my $seqRefs = []; my $featRefs = [];
my $seqDesc = [];
push @{$seqDesc}, ["comment" , "This file generated to BSML 2.2 standards - joins will be collapsed to a single feature enclosing all members of the join"];
push @{$seqDesc}, ["description" , eval{$bioSeq->desc}];
foreach my $kwd ( eval{@{$bioSeq->keywords || []}} ) {
push @{$seqDesc}, ["keyword" , $kwd];
}
push @{$seqDesc}, ["version" , eval{$bioSeq->seq_version}];
push @{$seqDesc}, ["division" , eval{$bioSeq->division}];
push @{$seqDesc}, ["pid" , eval{$bioSeq->pid}];
my $pid = eval{$bioSeq->primary_id} || '';
if( $pid ne $bioSeq ) {
push @{$seqDesc}, ["primary_id" , eval{$bioSeq->primary_id}];
}
foreach my $dt (eval{$bioSeq->get_dates()} ) {
push @{$seqDesc}, ["date" , $dt];
}
foreach my $ac (eval{$bioSeq->get_secondary_accessions()} ) {
push @{$seqDesc}, ["secondary_accession" , $ac];
}
my $acc = $bioSeq->accession_number eq "unknown" ?
"" : $bioSeq->accession_number;
my $id;
my $pi = $bioSeq->primary_id;
if ($pi && $pi !~ /Bio::/) {
$id = "SEQ" . $bioSeq->primary_id;
} else {
$id = $acc || ("SEQ-io" . $idcounter->{Sequence}++);
}
$id =~ s/ /-/g;
my %attr = ( 'title' => $bioSeq->display_id,
'length' => $bioSeq->length,
'ic-acckey' => $acc,
'id' => $id,
'representation' => 'raw',
);
$attr{molecule} = $mol{ lc($bioSeq->molecule) } if $bioSeq->can('molecule');
foreach my $a (keys %attr) {
$xmlSeq->setAttribute($a, $attr{$a}) if (defined $attr{$a} &&
$attr{$a} ne "");
}
$xmlSeq->setAttribute('topology', 'circular')
if ($bioSeq->is_circular);
$self->_add_page($xml, $xmlSeq) if ($dispElem);
$self->_parse_annotation( -xml => $xml, -obj => $bioSeq,
-desc => $seqDesc, -refs => $seqRefs);
if (ref($bioSeq->species) eq 'Bio::Species') {
my @specs = ('common_name', 'genus', 'species', 'sub_species');
foreach my $sp (@specs) {
next unless (my $val = $bioSeq->species()->$sp());
push @{$seqDesc}, [$sp , $val];
}
push @{$seqDesc}, ['classification',
(join " ", $bioSeq->species->classification) ];
} elsif (my $val = $bioSeq->species) {
push @{$seqDesc}, ["species", $val];
}
foreach my $seqD (@{$seqDesc}) {
$self->_addel($xmlSeq, "Attribute", {
name => $seqD->[0], content => $seqD->[1]}) if ($seqD->[1]);
}
unless ($#{$seqRefs} < 0) {
my $seqFT = $self->_addel($FTs, "Feature-table", {
title => "Sequence References", });
foreach my $feat (@{$seqRefs}) {
$seqFT->appendChild($feat);
}
}
$xmlSeq->appendChild($FTs);
if (defined $args->{SKIPFEAT} &&
$args->{SKIPFEAT} eq 'all') {
$args->{SKIPFEAT} = { all => 1};
}
foreach my $class (keys %{$args->{SKIPFEAT}}) {
$args->{SKIPFEAT}{lc($class)} = $args->{SKIPFEAT}{$class};
}
my @features = $bioSeq->all_SeqFeatures();
if (@features && !$args->{SKIPFEAT}{all}) {
my $ft = $self->_addel($FTs, "Feature-table", {
title => "Features", });
foreach my $bioFeat (@features ) {
my $featDesc = [];
my $class = lc($bioFeat->primary_tag);
next if ($args->{SKIPFEAT}{$class});
my $id = "FEAT-io" . $idcounter->{Feature}++;
my $xmlFeat = $self->_addel( $ft, 'Feature', {
'id' => $id,
'class' => $class ,
'value-type' => $bioFeat->source_tag });
$self->_parse_annotation( -xml => $xml, -obj => $bioFeat,
-desc => $featDesc, -id => $id,
-refs =>$featRefs, );
foreach my $de (@{$featDesc}) {
$self->_addel($xmlFeat, "Attribute", {
name => $de->[0], content => $de->[1]}) if ($de->[1]);
}
$self->_parse_location($xml, $xmlFeat, $bioFeat);
next if (defined $args->{SKIPTAGS} &&
$args->{SKIPTAGS} =~ /all/i);
foreach my $tag ($bioFeat->all_tags()) {
next if (exists $args->{SKIPTAGS}{$tag});
foreach my $val ($bioFeat->each_tag_value($tag)) {
$self->_addel( $xmlFeat, 'Qualifier', {
'value-type' => $tag ,
'value' => $val });
}
}
}
}
if ( (my $data = $bioSeq->seq) && !$args->{NODATA} ) {
my $d = $self->_addel($xmlSeq, 'Seq-data');
$d->appendChild( $xml->createTextNode($data) );
}
unless ($#{$featRefs} < 0) {
my $seqFT = $self->_addel($FTs, "Feature-table", {
title => "Feature References", });
foreach my $feat (@{$featRefs}) {
$seqFT->appendChild($feat);
}
}
$seqsElem->appendChild($xmlSeq);
push @xmlSequences, $xmlSeq;
}
if ($args->{CLOSE}) {
my @problemChild = ('Sequences', 'Sequence', 'Feature-tables',
'Feature-table', 'Screen', 'View',);
foreach my $kid (@problemChild) {
foreach my $prob ($xml->getElementsByTagName($kid)) {
unless ($prob->hasChildNodes) {
$prob->appendChild(
$xml->createComment(" Must close <$kid> explicitly "));
}
}
}
}
if (defined $args->{RETURN} &&
$args->{RETURN} =~ /seq/i) {
return\@ xmlSequences;
} else {
return $xml;
}} | sub write_seq
{ my $self = shift;
my $args = $self->_parseparams( @_);
if ($#_ == 0 ) {
unshift @_, "-seq";
}
my $xml = $self->to_bsml( @_,
-return => undef );
my $out = $xml->toString;
$out =~ s/>/>\n/g;
$self->_print("Content-type: " . $args->{PRINTMIME} . "\n\n")
if ($args->{PRINTMIME});
$self->_print( $out );
$self->flush if $self->_flush_on_write && defined $self->_fh;
return $xml;} | General documentation
In addition to parts of the Bio:: hierarchy, this module uses:
XML::DOM
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://www.bioperl.org/MailList.shtml - About the mailing lists
Report bugs to the Bioperl bug tracking system to help us keep track
the bugs and their resolution.
Bug reports can be submitted via email or the web:
bioperl-bugs@bio.perl.org
http://bugzilla.bioperl.org/
* The module now uses the new Collection.pm system. However,
Annotations associated with a Feature object still seem to use the
old system, so parsing with the old methods are included..
* Generate Seq objects with no sequence data but an assigned
length. This appears to be an issue with Bio::Seq. It is possible
(and reasonable) to make a BSML document with features but no
sequence data.
* Support . Do not know how commonly this is used.
* Some features are awaiting implementation in later versions of
BSML. These include:
* Nested feature support
* Complex feature (ie joins)
* Unambiguity in strand (ie -1,0,1, not just 'complement' )
* More friendly dblink structures
* Location.pm (or RangeI::union?) appears to have a bug when 'expand'
is used.
* More intelligent hunting for sequence and feature titles? It is not
terribly clear where the most appropriate field is located, better
grepping (eg looking for a reasonable count for spaces and numbers)
may allow for titles better than "AE008041".
| AUTHOR - Charles Tilford | Top |
Bristol-Myers Squibb Bioinformatics
Email
tilfordc@bms.comI have developed the BSML specific code for this package, but have used
code from other SeqIO packages for much of the nuts-and-bolts. In particular
I have used code from the embl.pm module either directly or as a framework
for many of the subroutines that are common to SeqIO modules.
#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-
The following methods are used for internal processing, and should probably
not be accessed by the user.
The following script may be used to test the conversion process. You
will need a file of the format you wish to test. The script will
convert the file to BSML, store it in /tmp/bsmltemp, read that file
into a new SeqIO stream, and write it back as the original
format. Comparison of this second file to the original input file
will allow you to track where data may be lost or corrupted. Note
that you will need to specify $readfile and $readformat.
use Bio::SeqIO;
# Tests preservation of details during round-trip conversion:
# $readformat -> BSML -> $readformat
my $tempspot = "/tmp/bsmltemp"; # temp folder to hold generated files
my $readfile = "rps4y.embl"; # The name of the file you want to test
my $readformat = "embl"; # The format of the file being tested
system "mkdir $tempspot" unless (-d $tempspot);
# Make Seq object from the $readfile
my $biostream = Bio::SeqIO->new( -file => "$readfile" );
my $seq = $biostream->next_seq();
# Write BSML from SeqObject
my $bsmlout = Bio::SeqIO->new( -format => 'bsml',
-file => ">$tempspot/out.bsml");
warn "\nBSML written to $tempspot/out.bsml\n";
$bsmlout->write_seq($seq);
# Need to kill object for following code to work... Why is this so?
$bsmlout = "";
# Make Seq object from BSML
my $bsmlin = Bio::SeqIO->new( -file => "$tempspot/out.bsml",
-format => 'bsml');
my $seq2 = $bsmlin->next_seq();
# Write format back from Seq Object
my $genout = Bio::SeqIO->new( -format => $readformat,
-file => ">$tempspot/out.$readformat");
$genout->write_seq($seq2);
warn "$readformat written to $tempspot/out.$readformat\n";
# BEING LOST:
# Join information (not possible in BSML 2.2)
# Sequence type (??)