view release on metacpan or  search on metacpan

lib/RDF/Service/Interface/Base/V01.pm  view on Meta::CPAN

#
# COPYRIGHT
#   Copyright (C) 2000 Jonas Liljegren.  All Rights Reserved.
#
#   This module is free software; you can redistribute it and/or
#   modify it under the same terms as Perl itself.
#
#=====================================================================

use strict;
use RDF::Service::Constants qw( :all );
use RDF::Service::Cache qw( save_ids uri2id debug time_string
			    $DEBUG debug_start debug_end id2uri
			    validate_context );
use URI;
use Data::Dumper;
use Carp qw( confess carp cluck croak );

sub register
{
    my( $interface ) = @_;

    return
    {
	'' =>
	{
	    NS_LS.'#Service' =>
	    {
		'connect' => [\&connect],
		'find_node' => [\&find_node],
	    },
	    NS_LS.'#Model' =>
	    {
		'create_model'    => [\&create_model],
		'is_empty'  => [\&not_implemented],
		'size'      => [\&not_implemented],
		'validate'  => [\&not_implemented],

		# The NS. The base for added things...
		'source_uri'=> [\&not_implemented],

		# is the model open or closed?
		'is_mutable'=> [\&not_implemented],

	    },
	    NS_RDFS.'Literal' =>
	    {
		'desig' => [\&desig_literal],
		'value' => [\&value],
	    },
	    NS_RDF.'Statement' =>
	    {
		'pred'  => [\&pred],
		'subj'  => [\&subj],
		'obj'   => [\&obj],
	        'desig' => [\&desig_statement],
	    },
	    NS_RDFS.'Resource' =>
	    {
		'desig' => [\&desig_resource],
		'delete_node_cascade' => [\&delete_node_cascade],
		'delete_node'         => [\&delete_node],
	        'init_types'          => [\&noop],
		'init_rev_subjs'      => [\&noop],
	        'store_types'         => [\&noop],
	        'remove_types'        => [\&noop],
	        'store_node'          => [\&noop],
	        'store_props'         => [\&noop],
	    },
	    NS_RDFS.'Class' =>
	    {
		'level' => [\&level],
		'init_rev_subjs' => [\&init_rev_subjs_class],
	    },
	},
	NS_LD."/service/" =>
	{
	    NS_RDFS.'Resource' =>
	    {
		'init_types' => [\&init_types_service],
		'init_rev_subjs' => [\&init_rev_subjs],
	    },
	},
	&NS_LD."/literal/" =>
	{
	    NS_RDFS.'Resource' =>
	    {
		'init_types' => [\&init_types_literal],
		'init_rev_subjs' => [\&init_rev_subjs],
	    },
	},
	&NS_LS =>
	{
	    NS_RDFS.'Resource' =>
	    {
		'init_types' => [\&init_types],
		'init_rev_subjs' => [\&init_rev_subjs],
		'level'      => [\&base_level],
	    },
	},
	&NS_RDF =>
	{
	    NS_RDFS.'Resource' =>
	    {
		'init_types' => [\&init_types],
		'init_rev_subjs' => [\&init_rev_subjs],
		'level'      => [\&base_level],
	    },
	},
	&NS_RDFS =>
	{
	    NS_RDFS.'Resource' =>
	    {
		'init_types' => [\&init_types],
		'init_rev_subjs' => [\&init_rev_subjs],
		'level'      => [\&base_level],
	    },
	},
    };
}

lib/RDF/Service/Interface/Base/V01.pm  view on Meta::CPAN

    {
	for(my $j=0; $j<= $#{$node->[REV_SUBJ]{$subj_id}}; $j++ )
	{
	    # This model does not longer define the arc.  Remove the
	    # property unless another model also defines the arc.

	    my $arc_node = $node->[REV_SUBJ]{$subj_id}[$j];
	    splice @{$node->[REV_SUBJ]{$subj_id}}, $j--, 1
	      if $self->new($arc_node)->delete_node;
	}
	delete $node->[REV_SUBJ]{$subj_id}
	  unless @{$node->[REV_SUBJ]{$subj_id}};
    }

    foreach my $obj_id ( keys %{$node->[REV_OBJ]} )
    {
	for(my $j=0; $j<= $#{$node->[REV_OBJ]{$obj_id}}; $j++ )
	{
	    # This model does not longer define the arc.  Remove the
	    # property unless another model also defines the arc.

	    my $arc_node = $node->[REV_OBJ]{$obj_id}[$j];
	    splice @{$node->[REV_OBJ]{$obj_id}}, $j--, 1
	      if $self->new($arc_node)->delete_node;
	}
	delete $node->[REV_OBJ]{$obj_id}
	  unless @{$node->[REV_OBJ]{$obj_id}};
    }

    # Should we delete the whole node?
    #
    if( $node->[MULTI] ) # Has another model defined this node?
    {
	# TODO: Something to do here?
	debug "*** Did NOT remove $node->[URISTR]\n";
	debug "***   because of existing model\n";
	die "Not implemented";
    }
    else
    {
	$self->remove;

	# Is this a statement?
	if( $node->[PRED] )
	{
	    # Expire all dependent lists
	    $node->[PRED][REV_PRED] = undef;
	    $node->[PRED][REV_PRED_ALL] = undef;
	    $node->[SUBJ][REV_SUBJ] = undef;
	    $node->[SUBJ][REV_SUBJ_ALL] = undef;
	    $node->[OBJ][REV_OBJ] = undef;
	    $node->[OBJ][REV_OBJ_ALL] = undef;
	}

	$node->[MODEL] = undef;
	$self = undef;
    }
    return( 1, 1 );
}

sub delete_node_cascade
{
    my( $self, $i ) = @_;
    #
    # TODO:
    #  1. The agent must be authenticated
    #  2. Is the target model open?
    #  3. Does the agent owns the target model?
    #
    #  Special handling of implicit nodes
    #
    # Delete the node and all statements refering to the node.  How
    # will we handle dangling nodes, like the properties of the node
    # mainly in the form of literals?  We will not delete them if they
    # belong to another model or if they are referenced in another
    # statement (that itself is not among the statements to be
    # deleted).  But there could be references to the node from other
    # interfaces that arn't even connected in this session.
    #
    # We could collect the dangling nodes and return them to the
    # caller for decision.  This could be made to an option.

    # This version will delete from left to right.  A deleted subject
    # will delete all prperty statements and all objects. This will
    # obviously have to change!

    # Procedure:
    #  Foreach statement
    #    - call obj->delete
    #  Remove self

    foreach my $arc ( @{ $self->arc->list} )
    {
	my $obj = $arc->obj;
	$obj->delete_node_cascade();
    }

    return( $self->delete_node, 1 );
}


sub find_node
{
    my( $self, $i, $uri ) = @_;

    my $obj = $RDF::Service::Cache::node->{$self->[NODE][IDS]}{ uri2id($uri) };
    return( RDF::Service::Context->new($obj,
				       $self->[CONTEXT],
				       $self->[WMODEL]),
	    1) if $obj;
    return( undef, 0 );
}

sub init_types_service
{
    my( $self, $i ) = @_;
    #
    # We currently doesn't store the service objects in any
    # interface. The Base interface states that all URIs matching a
    # specific pattern are Service objects.

    debug "Initiating types for $self->[NODE][URISTR]\n", 1;

    my $pattern = "^".NS_LD."/service/[^/#]+\$";
    if( $self->[NODE][URISTR] =~ m/$pattern/o )
    {
	# Declare the types for the service
	#
	$self->declare_add_types([NS_LS.'#Service'], NS_LD.'#The_Base_Model', 1);

	return( 0, 3 );
    }

    return 0;
}

sub init_types_literal
{
    my( $self, $i ) = @_;

    debug "Initiating types for $self->[NODE][URISTR]\n", 1;

    my $pattern = "^".NS_LD."/literal/[^/#]+\$";
    if( $self->[NODE][URISTR] =~ m/$pattern/o )
    {
	# Declare the types for the literal
	#
	$self->declare_add_types([
	      NS_RDFS.'Literal',
	      ], $self->get_node(NS_LD.'#The_Base_Model'), 1);
	return( 0, 3 );
    }
    return 0;
}