use Bio::OntologyIO;

  # do not use directly -- use via Bio::OntologyIO
  # e.g., the GO parser is a simple extension of this class
  my $parser = Bio::OntologyIO->new
	( -format       => "go",
          -defs_file    => "/home/czmasek/GO/GO.defs",
	  -files        => ["/home/czmasek/GO/component.ontology",
	                    "/home/czmasek/GO/function.ontology",
	                    "/home/czmasek/GO/process.ontology"] );

  my $go_ontology = $parser->next_ontology();

  my $IS_A    = Bio::Ontology::RelationshipType->get_instance( "IS_A" );
  my $PART_OF = Bio::Ontology::RelationshipType->get_instance( "PART_OF" );

    my $self = shift;
    $self->{'_ontologies'} = [] unless exists($self->{'_ontologies'});
    foreach my $ont (@_) {
	$self->throw(ref($ont)." does not implement Bio::Ontology::OntologyI")
	    unless ref($ont) && $ont->isa("Bio::Ontology::OntologyI");
	# the ontology name may have been auto-discovered while parsing
	# the file
	$ont->name($self->ontology_name) unless $ont->name();
	push(@{$self->{'_ontologies'}}, $ont);
    }
}

# This simply delegates. See SimpleGOEngine.

    my ( $self, $parent, $child, $type, $ont ) = @_;

    # note the triple terminology (subject,predicate,object) corresponds to
    # (child,type,parent)
    $self->_ont_engine()->add_relationship( $child, $type, $parent, $ont );


} # _add_relationship


# This simply delegates. See SimpleGOEngine

    my ( $self, $term, $ont ) = @_;

    $term->ontology($ont) if $ont && (! $term->ontology);
    $self->_ont_engine()->add_term( $term );
} # _add_term 



# This simply delegates. See SimpleGOEngine

    my ( $self, $line ) = @_;
     
    if ( $line =~ /^(\s+)/ ) {
         return length( $1 );
    }
    else {
         return 0;
    }
} # _count_spaces




# "next" method for parsing the defintions file

    my ( $self, $name, $termid, $def, $cmt, $dbxrefs, $obsolete ) = @_;

    if((!defined($obsolete)) && (index(lc($name),"obsolete") == 0)) {
	$obsolete = 1;
    }
    my $term = $self->term_factory->create_object(-name => $name,
						  -identifier => $termid,
						  -definition => $def,
						  -comment => $cmt,
						  -dblinks => $dbxrefs,
						  -is_obsolete => $obsolete);

    return $term;
} # _create_ont_entry



# Holds whether first record or not

    my $self = shift;

    return $self->{'_defs_io'} = shift if @_;
    return $self->{'_defs_io'};

    my ( $self, $value ) = @_;

    if ( defined $value ) {
        $self->{ "_done" } = $value;
    }
    
    return $self->{ "_done" };
} # _done


# Holds a term.  

    my $self = shift;

    $self->{_flat_files} = [] unless exists($self->{_flat_files});
    return $self->{_flat_files};
}


# INTERNAL METHODS
# ----------------

    my ( $self, $line ) = @_;
   
    my @refs = ();
   
    while ( $line =~ /;([^;^<^%^:]+:[^;^<^%^:]+)/g ) {
        my $ref = $1;
        if ( $ref =~ /synonym/ || $ref =~ /[A-Z]{1,8}:\d{3,}/ ) {
            next;
        }
        $ref =~ s/\s+$//;
        $ref =~ s/^\s+//;
        push( @refs, $ref );
    }
    return @refs;
    
} 


# Parses the secondary go ids out of a line

    my ( $self, $line ) = @_;
    
    if ( $line =~ /;\s*([A-Z]{1,8}:\d{3,})/ ) {
        return $1;
    }
    else {
        $self->throw( "format error: no term id in line\" $line\"" );
    }
    
} # _get_first_termid



# Parses the name out of line.

    my ( $self, $line ) = @_;
    
    my @ids = ();
    
    $line =~ s/[A-Z]{1,8}:\d{3,}//;
    
    while ( $line =~ /%[^<^,]*?([A-Z]{1,8}:\d{3,})/g ) {
        push( @ids, $1 );
    }
    return @ids; 
} # _get_isa_termids



# Parses the part of ids out of a line

    my ( $self, $line, $termid ) = @_;
    
    if ( $line =~ /([^;<%]+);\s*$termid/ ) {
        my $name = $1;
	# remove trailing and leading whitespace
        $name =~ s/\s+$//;
        $name =~ s/^\s+//;
	# remove leading dollar character; also we default the name of the
	# ontology to this name if preset to something else
	if(index($name,'$') == 0) {
	    $name = substr($name,1);
	    # replace underscores by spaces for setting the ontology name
	    $self->ontology_name(join(" ",split(/_/,$name))) 
		unless $self->ontology_name();
	}
        return $name;
    }
    else {
        return undef;
    }
} # _get_name   


# Parses the synonyms out of line.

    my ( $self, $line ) = @_;
    
    my @ids = ();
    
    $line =~ s/[A-Z]{1,8}:\d{3,}//;
    
    while ( $line =~ /<[^%^,]*?([A-Z]{1,8}:\d{3,})/g ) {
        push( @ids, $1 );
    }
    return @ids; 
    
    
} # _get_partof_termids




# Counts the spaces at the beginning of a line in the relationships files

    my ( $self, $line ) = @_;
    my @secs = ();
   
    while ( $line =~ /,\s*([A-Z]{1,8}:\d{3,})/g ) {
        my $sec = $1;
        push( @secs, $sec );
    }
    return @secs;
    
} # _get_secondary_termids 



# Parses the is a ids out of a line

    my ( $self, $line ) = @_;
   
    my @synonyms = ();
   
    while ( $line =~ /synonym\s*:\s*([^;^<^%]+)/g ) {
        my $syn = $1;
        $syn =~ s/\s+$//;
        $syn =~ s/^\s+//;
        push( @synonyms, $syn );
    }
    return @synonyms;
    
} # _get_synonyms



# Parses the db cross refs out of line.

    my $self = shift;

    return $self->_ont_engine()->has_term( @_ );
} # _add_term



# This parses the relationships files

    my ($self, @args) = @_;
    
    $self->SUPER::_initialize( @args );

    my ( $defs_file_name,$files,$name,$eng ) =
	$self->_rearrange([qw( DEFS_FILE
			       FILES
			       ONTOLOGY_NAME
			       ENGINE)
			   ],
			  @args );
    
    $self->_done( FALSE );
    $self->_not_first_record( FALSE );
    $self->_term( "" );
    delete $self->{'_ontologies'};

    # ontology engine (and possibly name if it's an OntologyI)
    $eng = Bio::Ontology::SimpleGOEngine->new() unless $eng;
    if($eng->isa("Bio::Ontology::OntologyI")) {
	$self->ontology_name($eng->name());
	$eng = $eng->engine() if $eng->can('engine');
    }
    $self->_ont_engine($eng);
    
    # flat files to parse
    $self->defs_file( $defs_file_name );
    $self->{_flat_files} = $files ? ref($files) ? $files : [$files] : [];

    # ontology name (overrides implicit one through OntologyI engine)
    $self->ontology_name($name) if $name;

} # _initialize

    my $self = shift;

    return $self->_ont_engine()->is_a_relationship(@_);
} # _is_a_relationship 



# This simply delegates. See SimpleGOEngine

    my ( $self ) = @_;

    if ( ($self->_done() == TRUE) || (! $self->_defs_io())) {
        return undef;
    }
    
    my $line      = "";
    my $termid    = "";
    my $next_term = $self->_term();
    my $def       = "";
    my $comment   = "";
    my @def_refs  = ();
    my $isobsolete;
    
    while( $line = ( $self->_defs_io->_readline() ) ) {
    
        if ( $line !~ /\S/ 
        ||   $line =~ /^\s*!/ ) {
            next;
        }
        elsif ( $line =~ /^\s*term:\s*(.+)/ ) {
	    $self->_term( $1 );
            last if $self->_not_first_record();
            $next_term = $1;
	    $self->_not_first_record( TRUE );
        }
        elsif ( $line =~ /^\s*[a-z]{1,8}id:\s*(.+)/ ) {
            $termid = $1;
        }
        elsif ( $line =~ /^\s*definition:\s*(.+)/ ) {
            $def = $1;   
	    $isobsolete = 1 if index($def,"OBSOLETE") == 0;
        }
        elsif ( $line =~ /^\s*definition_reference:\s*(.+)/ ) {
            push( @def_refs, $1 );  
        }
        elsif ( $line =~ /^\s*comment:\s*(.+)/ ) {
            $comment = $1;  
        }
    }
    $self->_done( TRUE ) unless $line; # we'll come back until done
    
    return $self->_create_ont_entry( $next_term, $termid, $def,
				     $comment,\@ def_refs, $isobsolete);
} # _next_term





# Holds the GO engine to be parsed into

    my ( $self, $value ) = @_;

    if ( defined $value ) {
        $self->{ "_not_first_record" } = $value;
    }
    
    return $self->{ "_not_first_record" };
} # _not_first_record



# Holds whether done or not

    my ( $self, $value ) = @_;

    if ( defined $value ) {
        $self->{ "_ont_engine" } = $value;
    }
    
    return $self->{ "_ont_engine" };
} # _ont_engine




# Used to create ontology terms.
# Arguments: name, id

    my $self = shift;
    my $ont  = shift;
    
    my @stack       = ();
    my $prev_spaces = -1;
    my $prev_term   = "";
    
    while( my $line = $self->_readline() ) {
        
        if ( $line =~ /^!/ ) {
            next;
        }
        
        my $current_term   = $self->_get_first_termid( $line );
        my @isa_parents    = $self->_get_isa_termids( $line );
        my @partof_parents = $self->_get_partof_termids( $line );
        my @syns           = $self->_get_synonyms( $line );
        my @sec_go_ids     = $self->_get_secondary_termids( $line );
        my @cross_refs     = $self->_get_db_cross_refs( $line );
        
        
        if ( ! $self->_has_term( $current_term ) ) {
            my $term =$self->_create_ont_entry($self->_get_name($line,
								$current_term),
					       $current_term );
            $self->_add_term( $term, $ont );
        }
        
        my $current_term_object = $self->_ont_engine()->get_terms( $current_term );
        
        $current_term_object->add_dblink( @cross_refs );
        $current_term_object->add_secondary_id( @sec_go_ids );
        $current_term_object->add_synonym( @syns );
        unless ( $line =~ /^\$/ ) {
            $current_term_object->ontology( $ont );
        }
        foreach my $parent ( @isa_parents ) {
            if ( ! $self->_has_term( $parent ) ) {
                my $term = $self->_create_ont_entry($self->_get_name($line,
								     $parent),
						    $parent );
                $self->_add_term( $term, $ont );
            }
            
            $self->_add_relationship( $parent,
                                      $current_term,
                                      $self->_is_a_relationship(),
				      $ont);
             
        }
        foreach my $parent ( @partof_parents ) {
            if ( ! $self->_has_term( $parent ) ) {
                my $term = $self->_create_ont_entry($self->_get_name($line,
								     $parent),
						    $parent );
                $self->_add_term( $term, $ont );
            }
           
            $self->_add_relationship( $parent,
                                      $current_term,
                                      $self->_part_of_relationship(),
				      $ont);
        }
        
        my $current_spaces = $self->_count_spaces( $line );
        
        if ( $current_spaces != $prev_spaces  ) {
       
            if ( $current_spaces == $prev_spaces + 1 ) {
                push( @stack, $prev_term ); 
            }
            elsif ( $current_spaces < $prev_spaces ) {
                my $n = $prev_spaces -  $current_spaces;
                for ( my $i = 0; $i < $n; ++$i ) {
                    pop( @stack );
                }
            }
            else {
		$self->throw( "format error (file ".$self->file.")" );
            } 
        }
        
        my $parent = $stack[ @stack - 1 ];
        
        # add a relationship if the line isn't the one with the root term
	# of the ontology (which is also the name of the ontology)
        if ( index($line,'$') != 0 ) {
	    if ( $line !~ /^\s*[<%]/ ) {
		$self->throw( "format error (file ".$self->file.")" );
	    }
	    my $reltype = ($line =~ /^\s*</) ?
		$self->_part_of_relationship() :
		$self->_is_a_relationship();
            $self->_add_relationship( $parent, $current_term, $reltype,
				      $ont);
        }
        
        $prev_spaces = $current_spaces;
        
        $prev_term = $current_term;
        
    } 
    return $ont;
} # _parse_relationships_file



# Parses the 1st term id number out of line.

    my $self = shift;

    return $self->_ont_engine()->part_of_relationship(@_);
} # _part_of_relationship 



# This simply delegates. See SimpleGOEngine

    my ( $self, $value ) = @_;

    if ( defined $value ) {
        $self->{ "_term" } = $value;
    }
    
    return $self->{ "_term" };
} # _term  

    my $self = shift;

    if ( @_ ) {
	my $f = shift;
        $self->{ "_defs_file_name" } = $f;
	$self->_defs_io->close() if $self->_defs_io();
	if(defined($f)) {
            $self->_defs_io( Bio::Root::IO->new( -input => $f ) );
        }
    }
    return $self->{ "_defs_file_name" };
} # defs_file

    my $self = shift;

    # parse if not done already
    $self->parse() unless exists($self->{'_ontologies'});
    # return next available ontology
    return shift(@{$self->{'_ontologies'}}) if exists($self->{'_ontologies'});
    return undef;

    my $self = shift;

    return $self->{'ontology_name'} = shift if @_;
    return $self->{'ontology_name'};

    my $self = shift;
    
    # setup the default term factory if not done by anyone yet
    $self->term_factory(Bio::Ontology::TermFactory->new(
					     -type => "Bio::Ontology::Term"))
	unless $self->term_factory();

    # create the ontology object itself
    my $ont = Bio::Ontology::Ontology->new(-name => $self->ontology_name(),
					   -engine => $self->_ont_engine());

    # parse definitions
    while( my $term = $self->_next_term() ) {
        $self->_add_term( $term, $ont );
    }

    # set up the ontology of the relationship types
    foreach ($self->_part_of_relationship(), $self->_is_a_relationship()) {
	$_->ontology($ont);
    }

    # pre-seed the IO system with the first flat file if -file wasn't provided
    if(! $self->_fh) {
	$self->_initialize_io(-file => shift(@{$self->_flat_files()}));
    }

    while($self->_fh) {
	$self->_parse_flat_file($ont);
	# advance to next flat file if more are available
	if(@{$self->_flat_files()}) {
	    $self->close();
	    $self->_initialize_io(-file => shift(@{$self->_flat_files()}));
	} else {
	    last; # nothing else to parse so terminate the loop
	}
    }
    $self->_add_ontology($ont);
    
    # not needed anywhere, only because of backward compatibility
    return $self->_ont_engine();
    
} # parse

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

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

  Genomics Institute of the Novartis Research Foundation
  10675 John Jay Hopkins Drive
  San Diego, CA 92121

 Hilmar Lapp, hlapp at gmx.net

 Title   : new
 Usage   : $parser = Bio::OntologyIO->new(
                             -format => "go",
                             -defs_file => "/path/to/GO.defs",
                             -files => ["/path/to/component.ontology",
                                        "/path/to/function.ontology",
                                        "/path/to/process.ontology"] );
 Function: Creates a new dagflat parser.
 Returns : A new dagflat parser object, implementing Bio::OntologyIO.
 Args    : -defs_file  => the name of the file holding the term
                          definitions
           -files      => a single ontology flat file holding the
                          term relationships, or an array ref holding
                          the file names (for GO, there will usually be
                          3 files: component.ontology, function.ontology,
                          process.ontology)
           -file       => if there is only a single flat file, it may
                          also be specified via the -file parameter
           -ontology_name => the name of the ontology; if not specified the
                          parser will auto-discover it by using the term
                          that starts with a '$', and converting underscores
                          to spaces
           -engine     => the Bio::Ontology::OntologyEngineI object
                          to be reused (will be created otherwise); note
                          that every Bio::Ontology::OntologyI will
                          qualify as well since that one inherits from the
                          former.