Commits

Konstantin Baierer committed 412d116

BAD STATE: furrther work on named graphs (some stupid cls/self error in there)

Comments (0)

Files changed (5)

lib/MooseX/Semantic/Role/Graph.pm

 package MooseX::Semantic::Role::Graph;
 use Moose::Role;
-use MooseX::Semantic::Types qw(TrineModel TrineBlankOrUndef TrineNode TrineResource );
+use MooseX::Semantic::Types qw(TrineModel TrineLiteral TrineNode TrineResource );
+use RDF::Trine qw(iri literal statement);
+use Data::Dumper;
 
 with qw(
     MooseX::Semantic::Role::Resource
 
 =cut
 
+=head2 
+
+=head2 SYNOPSIS
+
+    package GraphPackage;
+    use Moose;
+    with qw( MooseX::Semantic::Role::Graph MooseX::Semantic::Role::RdfExport );
+    has 'timestamp' => (
+        traits => ['Semantic'],
+        is => 'rw',
+        default => '1234',
+        uri => 'dc:date',
+    );
+    package main;
+    my $g = GraphPackage->new;
+    $g->rdf_graph->add_statement(statement iri('A'), iri('B'), iri('C') );
+
+=cut
+
+=head2 ATTRIBUTES
+
+=head3 rdf_graph
+
+The model this graph represents
+
+=cut
+
 has rdf_graph => (
     traits => ['Semantic'],
     is => 'rw',
     isa => TrineModel,
     coerce => 1,
     default => sub { TrineModel->coerce },
+    uri => 'http://moosex-semantic.org/onto#rdf_graph',
     # lazy => 1,
+    handles => [qw(
+        add_statement
+        get_statements
+    )],
 );
 
-# around 'export_to_model' => sub {
-#     my $orig = shift;
-#     my $self = shift;
-#     my %args = @_;
+=head2 METHODS
 
-#     unless ($args{context}) {
-#     }
-# };
+=head3 From RDF::Trine::Model
+
+=over 4
+
+=item add_statement
+
+=back
+
+=head3 add_statement_smartly
+
+More DWIMmy version of RDF::Trine::Model->add_statmeent
+
+=cut
+
+sub add_statement_smartly {
+    my $self = shift;
+    # warn Dumper [$_[1]];
+    my @args = @_;
+    # $args[1] = $ns->uri($args[1]) unless blessed $args[1];
+    # $args[0] = iri $args[0] unless blessed $args[0];
+    # $args[1] = iri $args[1] unless blessed $args[1];
+    # $args[2] = literal($args[2]) unless blessed $args[2];
+    $args[0] = TrineResource->coerce($args[0]);
+    $args[1] = TrineResource->coerce($args[1]);
+    $args[2] = TrineLiteral->coerce($args[2]);
+    return $self->rdf_graph->add_statement(statement(@args));
+}
+
 
 1;

lib/MooseX/Semantic/Role/RdfExport.pm

                 my ($attr, $stash) = @_;
                 my $iter = $stash->{attr_val}->as_stream;
                 while (my $stmt = $iter->next) {
+                    # warn Dumper $stmt;
                     if ($self->does('MooseX::Semantic::Role::Graph')) {
                         $stmt->[3] = $self->rdf_about;
                     }
                 my ($attr, $stash) = @_;
                 $self->_export_one_object($model, $stash->{attr_val}, $_, $opts{context})
                     for (@{ $stash->{uris} });
+                warn "I LIVE";
             },
             literal_in_array => sub {
                 my ($attr, $stash) = @_;

lib/MooseX/Semantic/Role/RdfImport.pm

 package MooseX::Semantic::Role::RdfImport;
 use Moose::Role;
-use RDF::Trine;
+use RDF::Trine qw(statement);
 use Data::Dumper;
-use MooseX::Semantic::Types qw(TrineResource);
+use MooseX::Semantic::Types qw(TrineResource TrineModel);
 use Set::Object;
 use namespace::autoclean;
 use Log::Log4perl;
 sub _build_instance_hash {
     my $cls = shift;
     my ($resource, $model, $unfinished_resources) = @_;
+    $resource = TrineResource->coerce( $resource );
 
     # callback for the type hierarchy walking to find
     # the first thing that's a class and a Resource
             # skip attribute we can't import to (lack of uri)
             return 1 unless scalar $stash->{uris};
 
-            # retrieve nodes from model
-            my @nodes = $model->objects_for_predicate_list($resource, @{ $stash->{uris} });
 
-            # skip attribute if no values are to be set
-            return 1 unless scalar @nodes;
+            # warn Dumper $stash->{uris};
+            if ($stash->{uris}->[0]->as_string eq '<http://moosex-semantic.org/onto#rdf_graph>') {
+                $stash->{statement_iterator} = $model->get_statements(undef,undef,undef,$resource);
+            }
+            else {
+                # retrieve nodes from model
+                my @nodes = $model->objects_for_predicate_list($resource, @{ $stash->{uris} });
 
-            # stash nodes away for other callbacks
-            $stash->{nodes} = \@nodes;
-            $stash->{literal_nodes} = [ map {$_->literal_value} grep { $_->is_literal } @nodes ];
+                # skip attribute if no values are to be set
+                return 1 unless scalar @nodes;
+
+                # stash nodes away for other callbacks
+                $stash->{nodes} = \@nodes;
+                $stash->{literal_nodes} = [ map {$_->literal_value} grep { $_->is_literal } @nodes ];
+            }
 
             # *Don't* skip this attribute
             return undef;
             return unless $stash->{literal_nodes}->[0];
             $inst_hash->{$attr->name} = $stash->{literal_nodes};
         },
+        model => sub {
+            my ($attr, $stash) = @_;
+
+            # support for MooseX::Semantic::Role::Graph
+            # push (@{$stash->{rdf_graph} = $) if $attr->name eq 'rdf_graph';
+            # warn Dumper $resource;
+            # warn Dumper "I LIVE";
+            my $graph_model = TrineModel->coerce;
+            # while (my $stmt = $model->get_statements(undef,undef,undef)) {
+            warn Dumper $stash;
+            while (my $stmt = $stash->{statement_iterator}->next){
+                # warn Dumper $stmt;
+                # $graph_model->add_statement(statement( $stmt->[0], $stmt->[1], $stmt->[2] ));
+            }
+            warn Dumper $inst_hash;
+            $inst_hash->{$attr->name} = $graph_model;
+        },
         resource => sub {
             my ($attr, $stash) = @_;
             my $attr_type_cls = $cls->_find_parent_type( $attr, $does_resource );

lib/MooseX/Semantic/Util/TypeConstraintWalker.pm

     elsif ($type_ref =~ m'^Moose::Meta::(?:Attribute|Class)') {
         $type_constraint = $attr_or_type_constraint->type_constraint;
     }
+    # elsif ($type_ref =~ m'^(?:Moose::Meta::TypeConstraint::Class)') {
+    #     $type_constraint = $attr_or_type_constraint;
+    # }
     elsif ($type_ref =~ m'^(?:Moose::Meta::TypeConstraint|MooseX::Types::TypeDecorator)') {
         $type_constraint = $attr_or_type_constraint;
     }
     $opts{max_width} = 9999 unless defined $opts{max_width};
     $opts{current_depth} = 0 unless $opts{current_depth};
     $opts{current_width} = 0 unless $opts{current_width};
+    # warn Dumper [keys(%$type_constraint)];
     # warn Dumper $type_constraint->name;
     # warn Dumper \%opts;
     # warn Dumper $opts{current_depth};
     elsif ($type_constraint->name eq $needle) {
         return $needle;
     }
+    if ( $type_constraint->can('class') && ! blessed $type_constraint->class && $type_constraint->class eq $needle ) {
+        return $type_constraint->class;
+    }
+    if ( $type_constraint->{'__type_constraint'} 
+    ) {
+        # warn Dumper $type_constraint->{'__type_constraint'};
+        # if( $type_constraint->{'__type_constraint'}->can('class')
+        #     && $type_constraint->{'__type_constraint'}->class eq $needle 
+        # ) {
+            # return $needle;
+            return $self->_find_parent_type_for_type_constraint($type_constraint->{'__type_constraint'}, $needle, %opts);
+        # }
+        # else {
+        #     return
+        # }
+    }
     if ($type_constraint->has_parent) {
         return $self->_find_parent_type_for_type_constraint($type_constraint->parent, $needle, %opts );
     }
             )
         {
             $callback_name = 'resource';
-            # die Dumper $self->$attr_name;
-            if ($self->$attr_name->isa('RDF::Trine::Model')) {
-                # die "It's amodel";
+            # warn Dumper keys(%{ $attr->type_constraint->{__type_constraint} });
+            if ( $self->$attr_name->isa('RDF::Trine::Model')
+                || $self->_find_parent_type( $attr, 'RDF::Trine::Model' 
+                # || $attr->uri->as_string eq '<http://moosex-semantic.org/onto#rdf_graph>'
+                )
+                # || $self->uri eq 'http:
+            ) {
+                warn "It's amodel";
                 $callback_name = 'model';
             }
         }
             warn "Can't handle this attribute: $attr_name";
             next;
         }
+        # warn Dumper $attr->uri;
+        # warn Dumper $callback_name;
         $cb->{$callback_name}->($attr, $stash, @_);
     }
 }

t/rdf_export/graph.t

 # graph.t
 #=======================================================================
 use common::sense;
-use Test::Most tests => 1;
+use Test::Most tests => 3;
 use RDF::Trine qw(iri statement);
 use Data::Dumper;
 
 {
     package GraphPackage;
     use Moose;
-    with qw( MooseX::Semantic::Role::Graph MooseX::Semantic::Role::RdfExport );
+    with qw( MooseX::Semantic::Role::Graph MooseX::Semantic::Role::RdfExport MooseX::Semantic::Role::RdfImport );
     has 'timestamp' => (
         traits => ['Semantic'],
         is => 'rw',
     );
 }
 
-my $g = GraphPackage->new;
+my $g = GraphPackage->new(rdf_about => 'graph_1');
 # warn Dumper $g->rdf_graph;
-$g->rdf_graph->add_statement(statement iri('A'), iri('B'), iri('C') );
+$g->add_statement(statement iri('A'), iri('B'), iri('C') );
+$g->add_statement_smartly('D', 'E', 'F');
 # warn Dumper $g->rdf_graph;
 # warn Dumper ref $g->rdf_graph;
 # warn Dumper $g->export_to_hash;
-warn Dumper $g->export_to_string(format=>'nquads');
+# warn Dumper $g->export_to_string(format=>'nquads');
+is($g->rdf_about->as_string, '<graph_1>');
+ok($g->get_statements(iri 'A', iri 'B', iri 'C')->next);
 
+diag "round trip";
+# warn Dumper $g->rdf_graph->get_statements->next;
+# warn Dumper $g->export_to_model;
+my $g_model = $g->export_to_model;
+my $g2 = GraphPackage->new_from_model($g_model, $g->rdf_about);
+# warn Dumper $g2->rdf_graph->get_statements->next;
+# ok($g2->get_statements->next);