File Coverage

blib/lib/RDF/Trine/Statement/Quad.pm
Criterion Covered Total %
statement 41 67 61.1
branch 5 14 35.7
condition n/a
subroutine 13 16 81.2
pod 8 8 100.0
total 67 105 63.8


line stmt bran cond sub pod time code
1             # RDF::Trine::Statement::Quad
2             # -----------------------------------------------------------------------------
3              
4             =head1 NAME
5              
6             RDF::Trine::Statement::Quad - Class for quads and quad patterns
7              
8             =head1 VERSION
9              
10             This document describes RDF::Trine::Statement::Quad version 1.018
11              
12             =cut
13              
14             package RDF::Trine::Statement::Quad;
15              
16 68     68   434 use strict;
  68         155  
  68         1683  
17 68     68   319 use warnings;
  68         138  
  68         1519  
18 68     68   312 no warnings 'redefine';
  68         140  
  68         2112  
19 68     68   350 use base qw(RDF::Trine::Statement);
  68         159  
  68         22019  
20              
21 68     68   484 use Scalar::Util qw(blessed);
  68         162  
  68         2847  
22 68     68   399 use Carp qw(croak);
  68         139  
  68         3512  
23              
24             ######################################################################
25              
26             our ($VERSION);
27             BEGIN {
28 68     68   30400 $VERSION = '1.018';
29             }
30              
31             ######################################################################
32              
33             =head1 METHODS
34              
35             Beyond the methods documented below, this class inherits methods from the
36             L<RDF::Trine::Statement> class.
37              
38             =over 4
39              
40             =cut
41              
42             =item C<new ( $s, $p, $o, $c )>
43              
44             Returns a new Quad structure.
45              
46             =cut
47              
48             sub new {
49 7800     7800 1 14112 my $class = shift;
50 7800         17473 my @nodes = @_;
51 7800 100       20017 unless (scalar(@nodes) == 4) {
52 1         8 throw RDF::Trine::Error::MethodInvocationError -text => "Quad constructor must have four node arguments";
53             }
54 7799         18682 my @names = qw(subject predicate object context);
55 7799         16137 foreach my $i (0 .. 3) {
56 31196 50       66723 unless (defined($nodes[ $i ])) {
57 0         0 $nodes[ $i ] = RDF::Trine::Node::Variable->new($names[ $i ]);
58             }
59             }
60            
61 7799         28891 return bless( [ @nodes ], $class );
62             }
63              
64             =item C<< nodes >>
65              
66             Returns the subject, predicate and object of the triple pattern.
67              
68             =cut
69              
70             sub nodes {
71 8672     8672 1 14086 my $self = shift;
72 8672         21962 return @$self;
73             }
74              
75             =item C<< node_names >>
76              
77             Returns the method names for accessing the nodes of this statement.
78              
79             =cut
80              
81             sub node_names {
82 1     1 1 11 return qw(subject predicate object context);
83             }
84              
85             =item C<< graph >>
86              
87             =item C<< context >>
88              
89             Returns the graph node of the quad pattern.
90              
91             =cut
92              
93             sub context {
94 10489     10489 1 19296 my $self = shift;
95 10489 100       23906 if (@_) {
96 1         4 $self->[3] = shift;
97             }
98 10489         23839 return $self->[3];
99             }
100             *graph = \&context;
101              
102             =item C<< sse >>
103              
104             Returns the SSE string for this algebra expression.
105              
106             =cut
107              
108             sub sse {
109 4397     4397 1 6939 my $self = shift;
110 4397         6745 my $context = shift;
111            
112 4397         9623 my @nodes = $self->nodes;
113 4397         9380 my @sse = map { $_->sse( $context ) } (@nodes);
  17588         50403  
114 4397         33106 return sprintf( '(quad %s %s %s %s)', @sse );
115             }
116              
117             =item C<< type >>
118              
119             Returns the type of this algebra expression.
120              
121             =cut
122              
123             sub type {
124 221     221 1 616 return 'QUAD';
125             }
126              
127             =item C<< clone >>
128              
129             =cut
130              
131             sub clone {
132 0     0 1   my $self = shift;
133 0           my $class = ref($self);
134 0           return $class->new( $self->nodes );
135             }
136              
137             =item C<< from_redland ( $statement, $name ) >>
138              
139             Given a RDF::Redland::Statement object and a graph name, returns a perl-native
140             RDF::Trine::Statement::Quad object.
141              
142             =cut
143              
144             sub from_redland {
145 0     0 1   my $self = shift;
146 0           my $rstmt = shift;
147 0           my $graph = shift;
148            
149 0           my $rs = $rstmt->subject;
150 0           my $rp = $rstmt->predicate;
151 0           my $ro = $rstmt->object;
152            
153             my $cast = sub {
154 0     0     my $node = shift;
155 0           my $type = $node->type;
156 0 0         if ($type == $RDF::Redland::Node::Type_Resource) {
    0          
    0          
157 0           return RDF::Trine::Node::Resource->new( $node->uri->as_string );
158             } elsif ($type == $RDF::Redland::Node::Type_Blank) {
159 0           return RDF::Trine::Node::Blank->new( $node->blank_identifier );
160             } elsif ($type == $RDF::Redland::Node::Type_Literal) {
161 0           my $lang = $node->literal_value_language;
162 0           my $dturi = $node->literal_datatype;
163 0 0         my $dt = ($dturi)
164             ? $dturi->as_string
165             : undef;
166 0           return RDF::Trine::Node::Literal->new( $node->literal_value, $lang, $dt );
167             } else {
168 0           croak 'Unknown node type in statement conversion';
169             }
170 0           };
171            
172 0           my @nodes;
173 0           foreach my $n ($rs, $rp, $ro) {
174 0           push(@nodes, $cast->( $n ));
175             }
176 0           my $st = $self->new( @nodes, $graph );
177 0           return $st;
178             }
179              
180              
181              
182              
183             1;
184              
185             __END__
186              
187             =back
188              
189             =head1 BUGS
190              
191             Please report any bugs or feature requests to through the GitHub web interface
192             at L<https://github.com/kasei/perlrdf/issues>.
193              
194             =head1 AUTHOR
195              
196             Gregory Todd Williams C<< <gwilliams@cpan.org> >>
197              
198             =head1 COPYRIGHT
199              
200             Copyright (c) 2006-2012 Gregory Todd Williams. This
201             program is free software; you can redistribute it and/or modify it under
202             the same terms as Perl itself.
203              
204             =cut