Bio::SeqIO::game
gameSubs
Summary
Bio::SeqIO::game::gameSubs -- a base class for game-XML parsing
Package variables
No package variables defined.
Included modules
UNIVERSAL
XML::Parser::PerlSAX
strict
Inherit
Synopsis
Not used directly
Description
A bag of tricks for game-XML parsing. The PerlSAX handler methods were
stolen from Chris Mungall's XML base class, which he stole from Ken MacLeod's
XML::Handler::Subs
Methods
Methods description
Title : new
Usage : not used directly
Returns : a gameHandler object
Args : an XML filename |
Title : go
Usage : not used directly
Function: starts PerlSAX XML parsing |
Title : start_document
Usage : not used directly |
Title : end_document
Usage : not used directly |
Title : start_element
Usage : not used directly |
Title : end_element
Usage : not used directly |
Title : characters
Usage : not used directly |
Title : strip_characters
Usage : not used directly
Function: cleans up XML element contents |
Title : curr_element
Usage : not used directly
Function: returns the currently open element |
Title : flush
Usage : $self->flush($element) # or $element->flush
Function: prune a branch from the XML tree
Returns : true if successful
Args : an element object (optional) |
Title : complain
Usage : $self->complain("This is terrible; I am not happy")
Function: throw a non-fatal warning, formats message for pretty-printing
Returns : nothing
Args : a list of strings |
Title : dbxref
Usage : $self->db_xref($el, $tags)
Function: an internal method to flatten dbxref elements
Returns : the db_xref (eg wormbase:C02D5.1)
Args : an element object (reqd) and a hash ref of tag/values (optional) |
Title : comment
Usage : $self->comment($comment_element)
Function: a method to flatten comment elements
Returns : a string
Args : an comment element (reqd) and a hash ref of tag/values (optional)
Note : The hope here is that we can unflatten structured comments
in game-derived annotations happen to make a return trip |
Title : property
Usage : $self->property($property_element)
Function: an internal method to flatten property elements
Returns : a hash reference
Args : an property/output element (reqd) and a hash ref of tag/values (optional)
Note: This method is aliased to 'output' to handle structurally identical output elements |
Title : evidence
Usage : $self->evidence($evidence_element)
Function: a method to flatten evidence elements
Returns : a string
Args : an evidence element |
Title : date
Usage : $self->date($date_element)
Function: a method to flatten date elements
Returns : true if successful
Args : a date element |
Title : protein_id
Usage : $pid = $self->protein_id($cds, $standard_name)
Function: a method to search for a protein name
Returns : a string
Args : the CDS object plus the transcript\'s 'standard_name' |
Methods code
sub new
{ my $type = shift;
my $file = shift || "";
my $self = (@_ == 1) ? { %{ (shift) } } : { @_ };
if ($file) {
$self->{file} = $file;
}
return bless $self, $type;} | sub go
{ my $self = shift;
XML::Parser::PerlSAX->new->parse(Source => { SystemId => "$self->{file}" },
Handler => $self);} | sub start_document
{ my ($self, $document) = @_;
$self->{Names} = [];
$self->{Nodes} = [];} | sub end_document
{ my ($self, $document) = @_;
delete $self->{Names};
delete $self->{Nodes};
return();} | sub start_element
{ my ($self, $element) = @_;
$element->{Children} = [];
$element->{Name} =~ tr/A-Z/a-z/;
push @{$self->{Names}}, $element->{Name};
push @{$self->{Nodes}}, $element;
my $el_name = "s_" . $element->{Name};
$el_name =~ s/[^a-zA-Z0-9_]/_/g;
if ($ENV{DEBUG_XML_SUBS}) {
print STDERR "xml_subs:$el_name\n";
}
if ($self->can($el_name)) {
$self->$el_name($element);
return 1;
}
return 0;} | sub end_element
{ my ($self, $element) = @_;
my $called_sub = 0;
$element->{Name} =~ tr/A-Z/a-z/;
my $el_name = "e_" . $element->{Name};
$el_name =~ s/[^a-zA-Z0-9_]/_/g;
my $rval = 0;
if ($ENV{DEBUG_XML_SUBS}) {
print STDERR "xml_subs:$el_name\n";
}
if ($self->can($ {el_name})) {
$rval = $self->$el_name($element) || 0;
$called_sub = 1;
}
my $curr_element = $self->{Nodes}->[$#{$self->{Nodes}}];
pop @{$self->{Names}};
pop @{$self->{Nodes}};
if ($rval eq -1 || !$called_sub) {
if (@{$self->{Nodes}}) {
my $parent = $self->{Nodes}->[$#{$self->{Nodes}}];
push(@{$parent->{Children}}, $curr_element);
$parent->{"_".$curr_element->{Name}} = $curr_element;
}
}
return $called_sub;} | sub characters
{ my ($self, $characters) = @_;
my $str = $self->strip_characters($characters->{Data});
my $curr_element = $self->curr_element();
$curr_element->{Characters} .= $str;
0;} | sub strip_characters
{ my ($self, $str) = @_;
$str =~ s/^[ \n\t]* *//g;
$str =~ s/ *[\n\t]*$//g;
$str;} | sub curr_element
{ my $self = shift;
return $self->{Nodes}->[-1];} | sub flush
{ my $self = shift;
my $victim = shift || $self->curr_element;
$victim = {};
return 1;} | sub complain
{ my $self = shift;
return 0 unless $self->{verbose};
my $msg = join '', @_;
$msg =~ s/\n/ /g;
my @msg = split /\s+/, $msg;
my $new_msg = '';
for ( @msg ) {
my ($last_chunk) = $new_msg =~ /\n?(.+)$/;
my $l = $last_chunk ? length $last_chunk : 0;
if ( (length $_) + $l > 45 ) {
$new_msg .= "\n$_ ";
}
else {
$new_msg .= $_ . ' ';
}
}
$self->warn($new_msg);} | sub dbxref
{ my ($self, $el, $tags) = @_;
$tags ||= $self->{curr_tags};
my $db = $el->{_xref_db}->{Characters};
my $acc = $el->{_unique_id} ||
$el->{_db_xref_id} ||
$el->{_xref_db_id};
my $id = $acc->{Characters} or return 0;
$self->flush( $el );
$id= $id =~ /^\w+$/ ? "$db:$id" : $id;
$tags->{dbxref} ||= [];
push @{$tags->{dbxref}}, $id;
$id;} | sub comment
{ my ($self, $el, $tags) = @_;
$tags ||= $self->{curr_tags};
my $text = $el->{_text}->{Characters};
my $pers = $el->{_person}->{Characters};
my $date = $el->{_date}->{Characters};
my $int = $el->{_internal}->{Characters};
$self->flush( $el );
my $comment = "person=$pers; " if $pers;
$comment .= "date=$date; " if $date;
$comment .= "internal=$int; " if $int;
$comment .= "text=$text" if $text;
$tags->{comment} ||= [];
push @{$tags->{comment}}, $comment;
$comment;} | sub property
{ my ($self, $el, $tags) = @_;
$tags ||= $self->{curr_tags};
my $key = $el->{_type}->{Characters};
my $value = $el->{_value}->{Characters};
$self->flush( $el );
$tags->{$key} ||= [];
push @{$tags->{$key}}, $value;
$tags;} | sub evidence
{ my ($self, $el) = @_;
my $tags = $self->{curr_tags};
my $text = $el->{Characters} or return 0;
my $type = $el->{Attributes}->{type};
my $res = $el->{Attributes}->{result};
$self->flush( $el );
my $evidence = "type=$type; " if $type;
$evidence .= "result=$res; " if $res;
$evidence .= "evidence=$text";
$tags->{evidence}||= [];
push @{$tags->{evidence}}, $evidence;
$evidence;} | sub date
{ my ($self, $el) = @_;
my $tags = $self->{curr_tags};
my $date = $el->{Characters} or return 0;
my $stamp = $el->{Attributes}->{timestamp};
$self->flush( $el );
$tags->{date} ||= [];
push @{$tags->{date}}, $date;
$tags->{timestamp} ||= [];
push @{$tags->{timestamp}}, $stamp;
1;} | sub protein_id
{ my ($self, $cds, $sn) = @_;
my $psn;
if ( $cds->has_tag('protein_id') ) {
($psn) = $cds->get_tag_values('protein_id');
}
elsif ( $cds->has_tag('product') ) {
($psn) = $cds->get_tag_values('product');
$psn =~ s/.+?(\S+)$/$1/;
}
elsif ( $cds->has_tag('gene') ) {
($psn) = $cds->get_tag_values('gene');
}
elsif ( $sn ) {
$psn = $sn;
}
else {
$self->complain("Could not find an ID for the protein");
return '';
}
$psn =~ s/-R/-P/;
return $psn;} | General documentation
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/wiki/Mailing_lists - About the mailing lists
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 the
web:
http://bugzilla.open-bio.org/
| AUTHOR - Sheldon McKay | Top |
The rest of the documentation details each of the object
methods. Internal methods are usually preceded with a _