view release on metacpan or  search on metacpan

GOBO/Parsers/OBOParserDispatchHash.pm  view on Meta::CPAN

=head1 NAME

GOBO::Parsers::OBOParserDispatchHash


=head1 DESCRIPTION

An GOBO::Parsers::Parser that parses OBO Files.

Mostly identical to GOBO::Parsers::OBOParser but uses a dispatch table rather than an if/else cascade

=cut

package GOBO::Parsers::OBOParserDispatchHash;

use Moose;
#use base 
extends 'GOBO::Parsers::OBOParser';

has header_check_sub => (is=>'rw', isa=>'CodeRef', writer => 'set_header_check_sub', reader => 'get_header_check_sub', default=>sub{ return sub { return 1 }; });
has stanza_check_sub => (is=>'rw', isa=>'CodeRef', writer => 'set_stanza_check_sub', reader => 'get_stanza_check_sub', default=>sub{ return sub { return 1 }; });
has tag_check_sub    => (is=>'rw', isa=>'CodeRef', writer => 'set_tag_check_sub', reader => 'get_tag_check_sub', default=>sub{ return sub { return 1 }; });

use Data::Dumper;

my $body_subs = {
	"id" => sub {
		my ($self, $args) = @_;
#		print STDERR "node before: " . Dumper(${$args->{node}}) . "\n";
		if ($args->{stanzaclass} eq 'term') {
			${$args->{node}} = ${$args->{graph}}->add_term($args->{value});
		}
		elsif ($args->{stanzaclass} eq 'typedef') {
			${$args->{node}} = ${$args->{graph}}->add_relation($args->{value});
		}
		elsif ($args->{stanzaclass} eq 'instance') {
			${$args->{node}} = ${$args->{graph}}->instance_noderef($args->{value});
			${$args->{graph}}->add_instance(${$args->{node}});
		}
		elsif ($args->{stanzaclass} eq 'annotation') {
			# TODO
		}
		else {
			warn "Unknown stanza class " . $args->{stanzaclass};
		}

		if (!${$args->{node}}) {
			die "cannot parse: $_";
		}
		
		${$args->{node}}->namespace($self->default_namespace) if (!${$args->{node}}->namespace && $self->default_namespace);
#		print STDERR "node now: " . Dumper(${$args->{node}}) . "\n";
	},
	"name" => sub {
		my ($self, $args) = @_;
		$args->{node}->label($args->{value});
	},
	"namespace" => sub {
		my ($self, $args) = @_;
		$args->{node}->namespace($args->{value});
	},
	"alt_id" => sub {
		my ($self, $args) = @_;
		$args->{node}->add_alt_ids($args->{value});
	},

	"def" => sub {
		my ($self, $args) = @_;
		my $vals = [];
		_parse_vals($args->{value},$vals);