view release on metacpan or  search on metacpan

lib/Bio/Phylo/Parsers/Cdao.pm  view on Meta::CPAN

WHERE {
    ?subject cdao:belongs_to_TU <%s> .
    ?subject cdao:belongs_to_Character <%s> .
    ?subject cdao:has_%sState ?state .
    ?state rdfs:label ?label .
    ?state rdf:type ?stateset
}
STATES

sub _parse {
    warn "***Please note: implementation is incomplete, character data are not yet read correctly.***\n";
    my $self = shift;
    %objects = ();
    $self->_args->{'-opts'} = {
        'lang'      => 'sparql',
        'base'      => $self->_args->{'-base'},
        'update'    => 0,
        'load_data' => 0,
    };
    $self->_project->set_base_uri($self->_args->{'-base'});
    $self->_process_tus;
    $self->_process_trees;
    $self->_process_nodes;
    $self->_process_edges;
    $self->_process_matrices;
    
    my $proj = $self->_project;
    my @objects = ( @{ $proj->get_taxa }, @{ $proj->get_forests }, @{ $proj->get_matrices } );
    $proj->clear;
    return @objects;
}

sub _object_from_resource {
    my ( $self, $resource, $creator ) = @_;
    my $fac = $self->_factory;
    my $base = $self->_args->{'-base'};
    my $uri = $resource->value;
    my $id = $uri;
    $id  =~ s/^\Q$base\E#?//;
    my $object = $fac->$creator( '-guid' => $id, '-xml_id' => $id );
    my $iterator = $self->_args->{'-model'}->get_statements($resource,undef,undef);
    while ( my $inner = $iterator->next ) {
        my ( $predicate, $value ) = ( $inner->predicate, $inner->object );
        $self->_process_annotation( $predicate->value, $value->value, $object );

    }
    $objects{$uri} = $object;    
}

sub _parse_predicate {
    my ( $self, $predicate ) = @_;
    # attempt to split URI in namespace and term
    my ( $ns, $term );
    
    # this is for cases where the term is referenced as somewhere inside
    # an ontology using an anchor '#', e.g. in CDAO
    if ( $predicate =~ m/^(.+#)(.+?)$/ ) {
        ( $ns, $term ) = ( $1, $2 );
    }
    
    # this is for cases where the term is a path fragment inside a namespace,
    # i.e. preceded by a '/', as in dublin core
    elsif ( $predicate =~ m/^(.+\/)([^\/]+?)$/ ) {
        ( $ns, $term ) = ( $1, $2 );
    }
    
    # this is for cases where the term is relative to a urn:, i.e. preceded
    # by a ':', as in the uBio predicates
    elsif ( $predicate =~ m/^(.+:)([^:]+?)$/ ) {
        ( $ns, $term ) = ( $1, $2 );
    }
    
    else {
        $self->_logger->warn("Can't parse URI $predicate");
    }
    return $ns, $term;
}

sub _process_annotation {
    my ( $self, $predicate, $value, $object ) = @_;
    my $fac = $self->_factory;
    $predicate =~ s/^<(.+)>$/$1/;
    return if $predicate eq _NS_RDF_ . 'type';
    
    # attempt to split URI in namespace and term
    my ( $ns, $term ) = $self->_parse_predicate( $predicate );
    
    # check to see if we have a prefix for that namespace, or make one
    my $prefix = $prefix_for_ns{$ns} || 'ns' . scalar(keys %prefix_for_ns);
    $prefix_for_ns{$prefix} = $ns;
    
    # maybe we know how to deal with this in the API
    if ( "${prefix}:${term}" eq 'rdfs:label' ) {
        $object->set_name( $value );
        return;
    }
    if ( "${prefix}:${term}" eq 'cdao:represents_TU' ) {
        $object->set_taxon( $objects{$value} );
        return;
    }
    if ( "${prefix}:${term}" eq 'cdao:has_Ancestor' ) {
        return; # don't need this, will reconstruct from edge links
    }
    if ( "${prefix}:${term}" eq 'cdao:has_Root' ) {
        return; # don't need this, will be obvious from whether tree is rooted
    }
    
    # attach annotation
    $object->set_namespaces( $prefix => $ns );
    $object->add_meta(
        $fac->create_meta(
            '-triple' => { "${prefix}:${term}" => $value }
        )
    );    
}

sub _do_query {
    my ( $self, $type, $type_query ) = @_;
    $type_query = $query unless $type_query;
    my $sth = RDF::Query->new( sprintf($type_query, $type), $self->_args->{'-opts'} );
    return $sth->execute( $self->_args->{'-model'} );