File Coverage

blib/lib/RDF/Laces.pm
Criterion Covered Total %
statement 17 73 23.2
branch 1 18 5.5
condition 1 20 5.0
subroutine 5 17 29.4
pod 0 1 0.0
total 24 129 18.6


line stmt bran cond sub pod time code
1             package RDF::Laces;
2 1     1   15165 use strict;
  1         3  
  1         54  
3 1     1   4138 use URI::Escape ();
  1         3241  
  1         206  
4             use overload
5 1         14 '/' => \&RDF::Laces::Impl::catdir,
6             '.' => \&RDF::Laces::Impl::cat,
7             '""' => \&RDF::Laces::Impl::uri,
8             '%{}' => \&RDF::Laces::Impl::get,
9 1     1   1985 '&{}' => \&RDF::Laces::Impl::resource;
  1         1455  
10              
11             our $VERSION = 0.02;
12              
13             our $rdf = __PACKAGE__->new('http://www.w3.org/1999/02/22-rdf-syntax-ns#');
14             our $rdfs = __PACKAGE__->new('http://www.w3.org/2000/01/rdf-schema#');
15             our $owl = __PACKAGE__->new('http://www.w3.org/2002/07/owl#');
16             our $dc = __PACKAGE__->new('http://purl.org/dc/elements/1.1/');
17              
18             sub new {
19 4     4 0 5 my $class = shift;
20 4 50       14 unshift @_, "path" if @_ % 2; # DWIM
21 4         15 my %opts = (
22             path => '',
23             prefix => '',
24             prefixes => {},
25             @_
26             );
27 4   33     21 my $self = bless \%opts, ref $class || $class;
28 4         13 return $self;
29             }
30              
31             sub AUTOLOAD {
32 0     0     my $self = shift;
33 0           my $meth = our $AUTOLOAD;
34 0           $meth =~ s/.*:://;
35 0 0         return if $meth eq 'DESTROY';
36 0 0         if(@_) {
37             # it's a statement!
38 0           printf "<%s> <%s>", $self, $self->{prefix} . $meth;
39 0           my $i = 0;
40 0           for my $obj (@_) {
41 0 0         printf "," if $i++;
42 0 0 0       if(ref $obj and $obj->isa(__PACKAGE__)) {
43 0           printf " <%s>", $obj;
44             } else {
45 0           printf ' "%s"', $obj;
46             }
47             }
48 0           printf " .\n";
49 0           return $self; # allow more statements!
50             }
51              
52              
53             # if in list context, it's a query!
54              
55             # if in void context, SET the prefix inplace
56 0 0         unless(defined wantarray) {
57 0   0       $self->{prefix} = $self->{prefixes}{$meth} || '';
58 0           return;
59             }
60            
61 0 0         unless(wantarray) {
62             # scalar context!
63 0           return $self->new(
64             %$self,
65             prefix => $self->{prefixes}{$meth},
66             root => $self->{prefixes}{$meth}
67             );
68             }
69              
70 0           return;
71             }
72              
73             package RDF::Laces::Impl;
74              
75             sub cat {
76 0     0     my($self, $path, $reverse) = @_;
77 0           $path = URI::Escape::uri_escape($path);
78 0 0         return $self->new(
79             %$self,
80             path => $reverse ? "$path" . "$self" : "$self" . "$path"
81             );
82             }
83              
84             sub catdir {
85 0     0     my($self, $path, $reverse) = @_;
86 0           my $newpath = $self->{path};
87             # I wanna support reverse?
88 0           $newpath =~ s#/*$#'/' . URI::Escape::uri_escape($path)#e;
  0            
89 0           return $self->new(
90             %$self,
91             path => $newpath
92             );
93             }
94              
95             sub get {
96 0     0     my $self = shift;
97 0           my $caller = (caller)[0];
98 0 0 0       return $self if $caller->isa(__PACKAGE__) || $caller->isa('RDF::Laces');
99              
100             # return a tied hash which does.... things
101 0           my %hash;
102 0           tie %hash, 'RDF::Laces::Tie', $self;
103 0           return \%hash;
104             }
105              
106             my $anonidx = 0;
107             sub resource {
108 0     0     my $self = shift;
109             return sub {
110 0   0 0     my $path = shift || ("_:anon" . ++$anonidx);
111 0           return $self->new(%$self, path => $path);
112             }
113 0           }
114              
115             sub uri {
116 0     0     return shift->{path};
117             }
118              
119             sub addprefix {
120 0     0     my($self, $prefix, $uri) = @_;
121 0           $self->{prefixes}{$prefix} = $uri;
122             }
123              
124             sub withfragment {
125 0     0     my $self = shift;
126 0           my $frag = shift;
127 0   0       my $base = $self->{root} || $self->{path};
128              
129 0           return $self->new(
130             %$self,
131             root => $base,
132             path => $base . $frag
133             );
134             }
135              
136             package RDF::Laces::Tie;
137 1     1   1310 use base qw(Tie::Hash);
  1         2  
  1         927  
138              
139             sub TIEHASH {
140 0     0     my $class = shift;
141 0           my $inst = shift;
142 0   0       my $self = bless { inst => $inst }, ref $class || $class;
143 0           return $self;
144             }
145              
146             sub FETCH {
147 0     0     my $self = shift;
148 0           my $key = shift;
149 0           RDF::Laces::Impl::withfragment($self->{inst}, $key);
150             }
151              
152             sub STORE {
153 0     0     my $self = shift;
154 0           my $key = shift;
155 0           my $value = shift;
156 0           RDF::Laces::Impl::addprefix($self->{inst}, $key, $value);
157             }
158              
159             =pod
160             =head1 NAME
161              
162             RDF::Laces - A module to string together RDF statements from Perl syntax
163              
164             =head1 SYNOPSIS
165              
166             $doc = new RDF::Laces('http://example.com/document/');
167             $doc->foo("bar"); # make statement
168             $doc->foo($doc->{bar}); # reference nodes within $doc
169             $doc->()->foo("bar"); # use blank node in $doc
170             $doc->{example} = $doc; # create prefix
171             $doc->example; # set default prefix
172              
173             =head1 DESCRIPTION
174              
175             This module provides a healthy dose of syntactic sugar to the expression
176             of RDF statements in Perl. Instead of forcing the mechanics of storage
177             and representation inline with the statements made within a program,
178             you can use a standard syntax for making RDF statements
179             in Perl using regular Perl expressions and variables without regard to
180             the model being used in the background, or the means to output it.
181              
182             In order to create an RDF model, a series of RDF triples consisting of
183             (subject, predicate, object) need to be constructed. The model is based
184             on making a series of statements about a subject. In Perl, there needs
185             to be an easy way to assert these statements inline with code.
186              
187             =head2 Making Statements in Perl
188              
189             The following examples assume the reader is familiar with the ntriple
190             representation of RDF as recommended by the W3 Consortium.
191              
192             In fact, we can demonstrate the examples from the W3's n3 primer.
193              
194             # <#pat> <#knows> <#jo> .
195             $doc->{pat}->knows($doc->{jo});
196              
197             This was a simple statement that C I> C. The C
198             method called on $doc->{pat} acted as the predicate for the statement,
199             and is assumed to be a URI relative to the current C<$doc> prefix.
200             More on that below.
201              
202             It's possible to make further statements about C.
203              
204             $doc->{pat}
205             ->knows($doc->{jo})
206             ->age(24)
207             ;
208              
209             We've now made two statements about C: C C C, and C C C<24>. This example shows how statements against the same subject can
210             be chained into a single Perl expression.
211              
212             Also, it's possible for a single predicate to have multiple objects.
213              
214             $doc->{pat}
215             ->child($doc->{al}, $doc->{chaz}, $doc->{mo})
216             ->age(24)
217             ->eyecolor("blue")
218             ;
219              
220             In this way, it's possible to chain together an entire description of C
221             into a single Perl expression.
222              
223             However, there are times when you want to reference data without an identifier.
224             These I RDF nodes are important containers for aggregate data and
225             are available from the document.
226              
227             $doc->{pat}
228             ->child(
229             $doc->()
230             ->age(4),
231             $doc->(),
232             ->age(3))
233             ;
234              
235             In that example, the $doc->() expression was creating I nodes which
236             had C statements made with them as the subject. Those nodes were returned
237             to be listed as a C of C.
238              
239             =head2 Using Prefixes
240              
241             Any document can use resources and attributes defined in another
242             RDF document. To ease the use of these documents, they are often referenced
243             using prefixes within the document; by C in XML, and C<@prefix> in n3.
244              
245             In Perl, these prefixes can be created and used as well.
246              
247             $doc->{dc} = 'http://purl.org/dc/elements/1.1/';
248             $doc
249             ->dc
250             ->title("POD - Learning to use RDF::Laces")
251             ;
252              
253             The prefix was created by assigning a URI (or an RDF::Laces object) to
254             the name of the desired prefix, C. By assigning to $doc->{dc},
255             it caused the C to be interpreted as the name of a prefix that should
256             be created.
257              
258             Once a prefix is created, it's possible to use that prefix by calling it
259             in the method chain without arguments. It's possible to set $doc's
260             prefix permanently by calling $doc->dc or whatever the prefix's name you want
261             is. Also, it is possible to use multiple prefixes per statement.
262              
263             $doc->()
264             ->name("jo")
265             ->rdf
266             ->type($doc->{Person})
267             ->rdfs
268             ->range($doc->rdfs->{Resource})
269             ->domain($doc->rdfs->{Resource})
270             ;
271              
272             =head1 TODO
273              
274             Currently, this module only prints out the N3 statements created by a Perl
275             expression. There will be a back-end interface for plugging in various RDF
276             modules, such as RDF::Redland and RDF::Core. When it exists, it should be
277             documented.
278              
279             Also, this module may be doing stuff which needs to be documented. I dunno.
280              
281             =head1 SEE ALSO
282              
283             Check out RDF::Redland. And, of course, visit http://www.w3.org/ for a full
284             description of RDF, n3, and all the other topics and terms discussed in this
285             document.
286              
287             =head1 AUTHOR
288              
289             Ashley Winters
290              
291             =head1 COPYRIGHT AND LICENSE
292              
293             Copyright 2003 by Ashley Winters
294              
295             This library is free software; you can redistribute it and/or modify
296             it under the same terms as Perl itself.
297              
298             =cut
299              
300             1;
301             # vim:set shiftwidth=4 softtabstop=4: