# $Id: obj_emitter.pm,v 1.3 2006/08/13 02:02:37 cmungall Exp $
#
#
# see also - http://www.geneontology.org
#          - http://www.godatabase.org/dev
#
# You may distribute this module under the same terms as perl itself

package GO::Parsers::obj_emitter;

=head1 NAME

GO::Parsers::obj_emitter     - 

=head1 SYNOPSIS

do not use this class directly; use GO::Parser

=head1 DESCRIPTION

This is not a file parser - it takes a L<GO::Model::Graph> object as
inputs and fires OBO XML events

=cut

use Exporter;
use base qw(GO::Parsers::base_parser);
use GO::Parsers::ParserEventNames;
use GO::Model::Graph;

use Carp;
use FileHandle;

use strict;

our @TAGS =
  qw(id
     name
     alt_id*
     namespace
     comment
     def
     subset*
     is_a*
     relationship*
     is_root
     is_obsolete
     is_transitive
     synonym*
     xref_analog*
     xref_unknown*
    );

sub dtd {
    'obo-parser-events.dtd';
}

sub emit_graph {
    my ($self, $g) = @_;

    $self->start_event(OBO);
    $self->fire_source_event($self->file || "object");
    $self->start_event(HEADER);
    $self->end_event(HEADER);

    $g->iterate(sub {
                    my $ni = shift;
                    $self->emit_term($ni->term, $g);
                    return;
                });
    $self->end_event(OBO);
}

sub emit_term {
    my ($self, $t, $g) = @_;
    my $stanza = TERM;
    if ($t->is_relationship_type) {
        $stanza = TYPEDEF;
    }
    $self->start_event($stanza);

    my $parent_rels = $g->get_parent_relationships($t->acc);
    foreach my $xtag (@TAGS) {
        my $multiple = 0;
        my $tag = $xtag;
        if ($xtag =~ /(.*)\*$/) {
            $tag = $1;
            $multiple = 1;
        }

        if ($tag eq ID) {
            $self->event(ID, $t->acc);
        }
        elsif ($tag eq IS_ROOT) {
            $self->event(IS_ROOT, 1)
              unless @$parent_rels;
        }
        elsif ($tag eq IS_OBSOLETE) {
            $self->event(IS_OBSOLETE, 1)
              if $t->is_obsolete;
        }
        elsif ($tag eq IS_TRANSITIVE ||
               $tag eq IS_SYMMETRIC  ||
               $tag eq IS_ANTI_SYMMETRIC  ||
               $tag eq IS_REFLEXIVE  ||
               $tag eq INVERSE_OF) {
            # obo extensions - not dealt with yet
        }
        elsif ($tag eq XREF_ANALOG || $tag eq XREF_UNKNOWN) {
            $self->event($tag=>dbxref($_))
              foreach @{$t->dbxref_list || []};
        }
        elsif ($tag eq DEF) {
            my $xrefs = $t->definition_dbxref_list || [];
            $self->event(DEF, 
                         [[DEFSTR, $t->definition],
                          map {
                              [DBXREF,dbxref($_)]
                          } @$xrefs
                         ]);
        }
        elsif ($tag eq SYNONYM) {
            my $sh = $t->synonyms_by_type_idx || {};
            foreach my $type (keys %$sh) {
                foreach my $val (@{$sh->{$type} || []}) {
                    $self->event(SYNONYM,
                                 [['@'=>[[scope=>$type]]],
                                  [SYNONYM_TEXT,$val]]);
                }
            }
        }
        elsif ($tag eq IS_A) {
            foreach (grep {$_->type eq 'is_a'} @$parent_rels) {
                $self->event(IS_A, $_->parent_acc)
            }
        }
        elsif ($tag eq RELATIONSHIP) {
            foreach (grep {$_->type ne 'is_a'} @$parent_rels) {
                $self->event(RELATIONSHIP,
                             [[TYPE,$_->type],
                              [TO,$_->parent_acc]
                             ]);
            }
                
        }
        else {
            if ($multiple) {
                my $method = $tag.'_list';
                my $vals = $t->$method();
                $self->event($tag, $_)
                  foreach @$vals;
            }
            else {
                if ($t->can($tag)) {
                    my $v = $t->$tag();
                    $self->event($tag, $v) if defined $v;
                }
                else {
                    warn("no method for: $tag");
                }
            }
        }
    }

    $self->end_event($stanza);
}

sub dbxref {
    my $xref = shift || confess;
    my $name = $xref->name;
    return 
      [[acc=>$xref->acc],
       [dbname=>$xref->dbname],
       $name ? [name=>$xref->name] : ()
      ];
}

1;