view release on metacpan or  search on metacpan

scripts/biosql/load_ontology.pl  view on Meta::CPAN

                    '-updobsolete' => $upd_obsolete,
                    '-testonly'    => $testonly_flag,
                    );


# The input parser may in fact be a SAX event handler, not a truly
# OntologyIO-compliant parser. A SAX handler needs to be treated
# fundamentally different from this point on than an OntologyIO
# compliant parser. While the former is to be handed off to a XML SAX
# parser, the latter needs to be looped over the ontologies it
# returns.

if ($ontin->isa("Bio::OntologyIO::Handlers::BaseSAXHandler")) {
    # this is a SAX event handler, not a true OntologyIO parser

    # pull in the XML SAX parser
    eval {
        require XML::Parser::PerlSAX;
    };
    croak "failed to load required XML SAX parser:\n$@" if $@;
    
    # complete setup of the SAX event handler: pass in our persistence handlers
    $ontin->persist_term_handler(\&persist_term, @persist_args);
    $ontin->persist_relationship_handler(\&persist_relationship,@persist_args);
    $ontin->db($db);

    # make sure the (default) ontology has a name
    my $ont = $ontin->_ontology();
    $ont->name($namespace) unless $ont->name;

    # instantiate the XML SAX parser and pass it the event handler
    my $parser = XML::Parser::PerlSAX->new(Handler => $ontin);

    # parsing the file will persist all terms and relationships, so we need
    # to delete the relationships first to avoid having stale ones around
    print STDERR "\t...deleting all relationships for ",$ont->name,"\n";
    remove_all_relationships('-ontology' => $ont, @persist_args);

    # now go ahead and parse the file
    print STDERR "\t...parsing and loading ",$ont->name,"\n";
    $parser->parse(Source => {SystemId => $files[0]});

    # Generate the transitive closure if requested
    if($compute_tc) {
        print STDERR "\t... transitive closure\n";
        compute_tc($db, $ont, $ontin->term_factory(), $compute_tc);
    }
    
    print STDERR "\tDone with ",$ont->name,"\n";

} else {
    # this is a truly OntologyIO compliant parser, or so I hope

    # loop over the input stream(s)
    while( my $ont = $ontin->$nextobj ) {
        # don't forget to add namespace if the parser doesn't supply one
        $ont->name($namespace) unless $ont->name();
        
        print STDERR "Loading ontology ",$ont->name(),":\n\t... terms\n";

        # in order to allow callbacks to the user and generally a
        # better ability to interfere with and customize the upload
        # process, we load all terms first here instead of simply
        # going for the relationships

        foreach my $term ($ont->get_all_terms()) {
            # call the persistence handler - there is only one right now
            persist_term('-term' => $term, @persist_args);
        }

        # after all terms have been processed, we run through the relationships
        # more or less non-interactively (i.e., without invoking a callback)
        
        print STDERR "\t... relationships\n";

        # first off, we need to delete the existing relationships in order
        # to avoid having stale ones around
        remove_all_relationships('-ontology' => $ont, @persist_args);

        # now go and insert all of them
        foreach my $rel ($ont->get_relationships()) {
            # pass on to persistence function - there's only one right now
            persist_relationship('-rel' => $rel, @persist_args);
        }
        
        # Generate the transitive closure if requested
        if($compute_tc) {
            print STDERR "\t... transitive closure\n";
            compute_tc($db, $ont, $ontin->term_factory(), $compute_tc);
        }

        print STDERR "\tDone with ".$ont->name.".\n";
    }

    # close the parser explicitly in case it needs this to be called
    $ontin->close();
}

print STDERR "Done, cleaning up.\n";

if ($db && $testonly_flag) {
    $db->get_object_adaptor("Bio::Ontology::TermI")->rollback();
}
# done!

#################################################################
# Implementation of functions                                   #
#################################################################

sub parse_code{
    my $src = shift;
    my $code;

    # file or subroutine?
    if(-r $src) {
	if(! (($code = do $src) && (ref($code) eq "CODE"))) {
	    die "error in parsing code block $src: $@" if $@;
	    die "unable to read file $src: $!" if $!;
	    die "failed to run $src, or it failed to return a closure";
	}
    } else {