/[suikacvs]/messaging/manakai/bin/cdis2rdf.pl
Suika

Contents of /messaging/manakai/bin/cdis2rdf.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (show annotations) (download)
Sun Feb 26 14:32:38 2006 UTC (18 years, 9 months ago) by wakaba
Branch: MAIN
CVS Tags: HEAD
Changes since 1.3: +0 -0 lines
File MIME type: text/plain
FILE REMOVED
++ manakai/t/ChangeLog	26 Feb 2006 14:32:29 -0000
	* Makefile (distclean): New rule.

2006-02-26  Wakaba  <wakaba@suika.fam.cx>

++ manakai/bin/ChangeLog	26 Feb 2006 14:18:44 -0000
	* daf.pl: Request for |fe:GenericLS| feature was missing.
	Sets the |pc:preserve-line-break| parameter for test
	code as |dac2test.pl| had been.

	* dac.pl, dac2pm.pl, dac2test.pl: Removed.

	* disc.pl, cdis2pm.pl, cdis2rdf.pl: Removed.

2006-02-26  Wakaba  <wakaba@suika.fam.cx>

++ manakai/lib/Message/ChangeLog	26 Feb 2006 14:19:17 -0000
2006-02-26  Wakaba  <wakaba@suika.fam.cx>

	* Makefile (distclean): New rule.

++ manakai/lib/Message/Body/ChangeLog	26 Feb 2006 14:19:35 -0000
2006-02-26  Wakaba  <wakaba@suika.fam.cx>

	* Makefile (distclean): New rule.

++ manakai/lib/Message/Field/ChangeLog	26 Feb 2006 14:24:08 -0000
2006-02-26  Wakaba  <wakaba@suika.fam.cx>

	* Makefile (distclean): New rule.

++ manakai/lib/Message/MIME/ChangeLog	26 Feb 2006 14:24:31 -0000
2006-02-26  Wakaba  <wakaba@suika.fam.cx>

	* Makefile (distclean): New rule.

++ manakai/lib/Message/Markup/ChangeLog	26 Feb 2006 14:24:49 -0000
	* Makefile (distclean): New rule.

2006-02-26  Wakaba  <wakaba@suika.fam.cx>

++ manakai/lib/Message/Util/ChangeLog	26 Feb 2006 14:27:24 -0000
	* PerlCode.dis (PerlStringLiteral.stringify): If some character
	are escaped, the string should have been quoted by |QUOTATION MARK|.

	* Makefile (.discore-all.pm): The parameter for |DIS/DPG.dis|
	module was misplaced.
	(distclean): New rule.
	(clean): Cleans subdirectories, too.

2006-02-26  Wakaba  <wakaba@suika.fam.cx>

++ manakai/lib/Message/Util/DIS/ChangeLog	26 Feb 2006 14:31:14 -0000
	* Perl.dis (plUpdate): Reads |dis:DefaultFor| property
	from the source if it is not available from the module
	in the database, i.e. the |readProperties| method
	is not performed for the module.
	(getPerlInterfaceMemberCode): Renamed
	from |getPerlErrorInterfaceMemberCode|.
	(DISLang:Const.getPerlInterfaceMemberCode): New
	method implementation.  Constants defined in interfaces
	were not reflected to the generated Perl module code
	since the split of |plGeneratePerlModule| method.

	* DPG.dis (Require): Reference to |DIS:Perl| module was missing.

2006-02-26  Wakaba  <wakaba@suika.fam.cx>

++ manakai/lib/Message/DOM/ChangeLog	26 Feb 2006 14:21:51 -0000
	* SimpleLS.dis (Require): Reference to the |MDOM:Tree|
	module was missing.

	* ManakaiDOMLS2003.dis: Some property names was incorrect.

	* Makefile (distclean): New rule.

2006-02-26  Wakaba  <wakaba@suika.fam.cx>

	* DOMLS.dis: Removed from the CVS repository, since
	it has been no longer required to make the |daf| system
	itself.

2006-02-26  Wakaba  <wakaba@suika.fam.cx>

++ manakai/lib/manakai/ChangeLog	26 Feb 2006 14:32:09 -0000
	* Makefile (distclean): New rule.

2006-02-26  Wakaba  <wakaba@suika.fam.cx>

++ manakai/lib/ChangeLog	26 Feb 2006 14:19:00 -0000
2006-02-26  Wakaba  <wakaba@suika.fam.cx>

	* Makefile (distclean): New rule.

1 #!/usr/bin/perl -w
2 use strict;
3 use Message::Util::QName::Filter {
4 d => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis-->,
5 dis2pm => q<http://suika.fam.cx/~wakaba/archive/2004/11/8/dis2pm#>,
6 DOMCore => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#>,
7 DOMMain => q<http://suika.fam.cx/~wakaba/archive/2004/dom/main#>,
8 lang => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#>,
9 Perl => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#Perl-->,
10 license => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/license#>,
11 ManakaiDOM => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#>,
12 owl => q<http://www.w3.org/2002/07/owl#>,
13 rdf => q<http://www.w3.org/1999/02/22-rdf-syntax-ns#>,
14 rdfs => q<http://www.w3.org/2000/01/rdf-schema#>,
15 };
16
17 use Getopt::Long;
18 use Pod::Usage;
19 use Storable;
20 my %Opt;
21 GetOptions (
22 'help' => \$Opt{help},
23 'output-anon-resource!' => \$Opt{output_anon_resource},
24 'output-as-n3' => \$Opt{output_as_n3},
25 'output-as-xml' => \$Opt{output_as_xml},
26 'output-for!' => \$Opt{output_for},
27 'output-local-resource!' => \$Opt{output_local_resource},
28 'output-module!' => \$Opt{output_module},
29 'output-only-in-module=s' => \$Opt{output_resource_pattern},
30 'output-perl!' => \$Opt{output_prop_perl},
31 'output-perl-member-pattern=s' => \$Opt{output_perl_member_pattern},
32 'output-resource!' => \$Opt{output_resource},
33 'output-resource-uri-pattern=s' => \$Opt{output_resource_uri_pattern},
34 'output-root-anon-resource!' => $Opt{output_root_anon_resource},
35 ) or pod2usage (2);
36 pod2usage ({-exitval => 0, -verbose => 1}) if $Opt{help};
37 pod2usage ({-exitval => 2, -verbose => 1})
38 if $Opt{output_as_n3} and $Opt{output_as_xml};
39 $Opt{file_name} = shift;
40 pod2usage ({-exitval => 2, -verbose => 0}) unless $Opt{file_name};
41 $Opt{output_resource_pattern} ||= qr/./;
42 $Opt{output_resource_uri_pattern} ||= qr/./;
43 $Opt{output_root_anon_resource} = $Opt{output_anon_resource}
44 unless defined $Opt{output_anon_resource};
45 $Opt{output_as_xml} = 1 unless $Opt{output_as_n3};
46 $Opt{output_anon_resource} = 1 unless defined $Opt{output_anon_resource};
47 $Opt{output_local_resource} = 1 unless defined $Opt{output_local_resource};
48 $Opt{output_perl_member_pattern} ||= qr/./;
49
50 BEGIN {
51 require 'manakai/genlib.pl';
52 require 'manakai/dis.pl';
53 }
54 sub n3_literal ($) {
55 my $s = shift;
56 impl_err ("Literal value not defined") unless defined $s;
57 qq<"$s">;
58 }
59 our $State = retrieve ($Opt{file_name})
60 or die "$0: $Opt{file_name}: Cannot load";
61 our $result = new manakai::n3;
62
63 if ($Opt{output_module}) {
64 for (keys %{$State->{Module}}) {
65 my $mod = $State->{Module}->{$_};
66 if ($_ eq $mod->{URI}) {
67 $result->add_triple ($mod->{URI} =>ExpandedURI q<rdf:type>=>
68 ExpandedURI q<d:Module>);
69 $result->add_triple ($mod->{URI} =>ExpandedURI q<d:Name>=>
70 n3_literal $mod->{Name});
71 $result->add_triple ($mod->{URI} =>ExpandedURI q<d:NameURI>=>
72 $mod->{NameURI});
73 $result->add_triple ($mod->{URI} =>ExpandedURI q<d:ModuleGroup>=>
74 $mod->{ModuleGroup});
75 $result->add_triple ($mod->{URI} =>ExpandedURI q<d:FileName>=>
76 n3_literal $mod->{FileName})
77 if defined $mod->{FileName};
78 $result->add_triple ($mod->{URI} =>ExpandedURI q<d:Namespace>=>
79 $mod->{Namespace});
80 for (@{$mod->{require_module}||[]}) {
81 $result->add_triple ($mod->{URI} =>ExpandedURI q<d:Require>=> $_);
82 }
83 for (keys %{$mod->{For}}) {
84 $result->add_triple ($mod->{URI} =>ExpandedURI q<d:For>=> $_);
85 }
86 for (@{$mod->{ISA}}) {
87 $result->add_triple ($mod->{URI} =>ExpandedURI q<rdfs:subClassOf>=> $_);
88 }
89 if ($Opt{output_prop_perl}) {
90 $result->add_triple ($mod->{URI} =>ExpandedURI q<dis2pm:packageName>=>
91 n3_literal $mod->{ExpandedURI q<dis2pm:packageName>})
92 if defined $mod->{ExpandedURI q<dis2pm:packageName>};
93 if ($Opt{output_resource}) {
94 for (values %{$mod->{ExpandedURI q<dis2pm:package>}}) {
95 my $uri = defined $_->{URI}
96 ? $_->{URI}
97 : ($_->{ExpandedURI q<d:anonID>}
98 ||= $result->get_new_anon_id (Name => $_->{Name}));
99 $result->add_triple ($mod->{URI} =>ExpandedURI q<dis2pm:package>=>
100 $uri);
101 }
102 }
103 }
104 } else {
105 $result->add_triple ($_ =>ExpandedURI q<owl:sameAs>=> $mod->{URI});
106 }
107 }}
108
109 if ($Opt{output_for}) {
110 for (keys %{$State->{For}}) {
111 my $mod = $State->{For}->{$_};
112 if ($_ eq $mod->{URI}) {
113 $result->add_triple ($mod->{URI} =>ExpandedURI q<rdf:type>=>
114 ExpandedURI q<d:For>);
115 $result->add_triple ($mod->{URI} =>ExpandedURI q<d:NameURI>=> $mod->{URI});
116 $result->add_triple ($mod->{URI} =>ExpandedURI q<d:FullName>=>
117 n3_literal $mod->{FullName})
118 if defined $mod->{FullName};
119 for (@{$mod->{ISA}}) {
120 $result->add_triple ($mod->{URI} =>ExpandedURI q<rdfs:subClassOf>=> $_);
121 }
122 for (@{$mod->{Implement}}) {
123 $result->add_triple ($mod->{URI} =>ExpandedURI q<d:Implement>=> $_);
124 }
125 } else {
126 $result->add_triple ($_ =>ExpandedURI q<owl:sameAs>=> $mod->{URI});
127 }
128 }}
129
130 sub res_canon ($) {
131 my $uri = shift;
132 if (defined $State->{Type}->{$uri}->{Name} and
133 defined $State->{Type}->{$uri}->{URI}) {
134 return $State->{Type}->{$uri}->{URI};
135 } else {
136 return $uri;
137 }
138 }
139
140 if ($Opt{output_resource}) {
141 sub class_to_rdf ($;%);
142 sub class_to_rdf ($;%) {
143 my ($mod, %opt) = @_;
144 return unless defined $mod->{Name};
145 return unless $mod->{parentModule} =~ /$Opt{output_resource_pattern}/;
146 return if $Opt{output_prop_perl} and
147 $mod->{ExpandedURI q<dis2pm:type>} and
148 {
149 ExpandedURI q<ManakaiDOM:DOMAttribute> => 1,
150 ExpandedURI q<ManakaiDOM:DOMMethod> => 1,
151 }->{$mod->{ExpandedURI q<dis2pm:type>}} and
152 $mod->{Name} and
153 $mod->{Name} !~ /$Opt{output_perl_member_pattern}/;
154 if ((defined $mod->{URI} and $opt{key} eq $mod->{URI}) or
155 not defined $mod->{URI}) {
156 return if defined $mod->{URI} and
157 $mod->{URI} !~ /$Opt{output_resource_uri_pattern}/;
158 return if not defined $mod->{URI} and not $Opt{output_anon_resource};
159 my $uri = defined $mod->{URI}
160 ? $mod->{URI}
161 : ($mod->{ExpandedURI q<d:anonID>}
162 ||= $result->get_new_anon_id (Name => $mod->{Name}));
163 $result->add_triple ($uri =>ExpandedURI q<d:Name>=>
164 n3_literal $mod->{Name}) if length $mod->{Name};
165 $result->add_triple ($uri =>ExpandedURI q<d:NameURI>=> $mod->{NameURI})
166 if defined $mod->{NameURI};
167 $result->add_triple ($uri =>ExpandedURI q<d:parentResource>=>
168 $opt{parent_class_uri})
169 if defined $opt{parent_class_uri};
170 if ($Opt{output_module}) {
171 $result->add_triple ($uri =>ExpandedURI q<d:parentModule>=>
172 $mod->{parentModule});
173 }
174 for (keys %{$mod->{Type}}) {
175 $result->add_triple ($uri =>ExpandedURI q<rdf:type>=> res_canon $_);
176 }
177 for (@{$mod->{ISA}}) {
178 $result->add_triple ($uri =>ExpandedURI q<rdfs:subClassOf>=>
179 res_canon $_);
180 }
181 for (grep {$mod->{subsetOf}->{$_}} keys %{$mod->{subsetOf}}) {
182 $result->add_triple ($uri =>ExpandedURI q<d:subsetOf>=>
183 res_canon $_);
184 }
185 for (@{$mod->{Implement}}) {
186 $result->add_triple ($uri =>ExpandedURI q<d:Implement>=> res_canon $_);
187 }
188 if ($Opt{output_for}) {
189 for (keys %{$mod->{For}}) {
190 $result->add_triple ($uri =>ExpandedURI q<d:For>=> $_);
191 }
192 }
193 for (@{$mod->{hasResource}||[]}) {
194 my $ruri = defined $_->{URI}
195 ? $_->{URI}
196 : ($_->{ExpandedURI q<d:anonID>}
197 ||= $result->get_new_anon_id (Name => $_->{Name}));
198 $result->add_triple ($uri =>ExpandedURI q<d:hasResource>=> $ruri);
199 }
200 if ($Opt{output_prop_perl}) {
201 for my $prop ([ExpandedURI q<dis2pm:packageName>],
202 [ExpandedURI q<dis2pm:ifPackagePrefix>],
203 [ExpandedURI q<dis2pm:methodName>],
204 [ExpandedURI q<dis2pm:paramName>],
205 [ExpandedURI q<dis2pm:constGroupName>],
206 [ExpandedURI q<dis2pm:constName>],
207 [ExpandedURI q<ManakaiDOM:isRedefining>,
208 ExpandedURI q<DOMMain:boolean>],
209 [ExpandedURI q<ManakaiDOM:isForInternal>,
210 ExpandedURI q<DOMMain:boolean>],
211 [ExpandedURI q<d:Read>, ExpandedURI q<DOMMain:boolean>],
212 [ExpandedURI q<d:Write>,
213 ExpandedURI q<DOMMain:boolean>],
214 [ExpandedURI q<dis2pm:undefable>,
215 ExpandedURI q<DOMMain:boolean>]) {
216 $result->add_triple ($uri =>$prop->[0]=>
217 n3_literal $mod->{$prop->[0]})
218 if defined $mod->{$prop->[0]};
219 }
220 for my $prop ([ExpandedURI q<d:Type>],
221 [ExpandedURI q<d:actualType>],
222 [ExpandedURI q<dis2pm:type>]) {
223 $result->add_triple ($uri =>$prop->[0]=> res_canon $mod->{$prop->[0]})
224 if defined $mod->{$prop->[0]} and
225 length $mod->{$prop->[0]};
226 }
227 for my $prop ([ExpandedURI q<dis2pm:getter>],
228 [ExpandedURI q<dis2pm:setter>],
229 [ExpandedURI q<dis2pm:return>]) {
230 my $oo = $mod->{$prop->[0]};
231 if ($oo and defined $oo->{Name}) {
232 my $o = defined $oo->{URI}
233 ? $oo->{URI}
234 : ($oo->{ExpandedURI q<d:anonID>}
235 ||= $result->get_new_anon_id (Name => $oo->{Name}));
236 $result->add_triple ($uri =>$prop->[0]=> $o)
237 }
238 }
239 for my $p (ExpandedURI q<dis2pm:method>,
240 ExpandedURI q<dis2pm:constGroup>,
241 ExpandedURI q<dis2pm:const>) {
242 for my $v (values %{$mod->{$p}||{}}) {
243 my $ruri = defined $v->{URI}
244 ? $v->{URI}
245 : ($v->{ExpandedURI q<d:anonID>}
246 ||= $result->get_new_anon_id (Name => $v->{Name}));
247 $result->add_triple ($uri =>$p=> $ruri);
248 }
249 }
250 if ($mod->{ExpandedURI q<dis2pm:type>} eq
251 ExpandedURI q<ManakaiDOM:DOMMethod>) {
252 $result->add_triple
253 ($uri =>ExpandedURI q<dis2pm:param>=>
254 my $p = $result->get_new_anon_id (Name => 'param'));
255 $result->add_triple ($uri =>ExpandedURI q<rdf:type>=>
256 ExpandedURI q<rdf:Seq>);
257 my $i = 0;
258 for (@{$mod->{ExpandedURI q<dis2pm:param>}||[]}) {
259 my $ruri = defined $_->{URI}
260 ? $_->{URI}
261 : ($_->{ExpandedURI q<d:anonID>}
262 ||= $result->get_new_anon_id (Name => $_->{Name}));
263 $result->add_triple ($p =>(ExpandedURI q<rdf:_>).++$i=> $ruri);
264 }
265 }
266 }
267 if ($Opt{output_local_resource}) {
268 for (keys %{$mod->{Resource}}) {
269 class_to_rdf ($mod->{Resource}->{$_}, %opt, parent_class => $mod,
270 parent_class_uri => $uri,
271 key => $_);
272 }
273 }
274 } else { ## Alias URI
275 return unless $opt{key} =~ /$Opt{output_resource_uri_pattern}/ or
276 $mod->{URI} =~ /$Opt{output_resource_uri_pattern}/;
277 $result->add_triple ($opt{key} =>ExpandedURI q<owl:sameAs>=> $mod->{URI});
278 }
279 }
280 for (sort keys %{$State->{Type}}) {
281 next if not $Opt{output_root_anon_resource} and
282 not defined $State->{Type}->{$_}->{URI};
283 class_to_rdf ($State->{Type}->{$_}, key => $_);
284 }
285 }
286
287 if ($Opt{output_as_xml}) {
288 print $result->stringify_as_xml;
289 } else {
290 print $result->stringify;
291 }
292
293 package manakai::n3;
294 sub new ($) {
295 bless {triple => [], anon => 0}, shift;
296 }
297
298 sub get_new_anon_id ($;%) {
299 my ($self, %opt) = @_;
300 my $s = $opt{Name} ? $opt{Name} : '';
301 return sprintf '_:r%d%s', $self->{anon}++, $s;
302 }
303
304 sub add_triple ($$$$) {
305 my ($self, $s =>$p=> $o) = @_;
306 main::impl_err ("Subject undefined") unless defined $s;
307 main::impl_err ("Property undefined") unless defined $p;
308 main::impl_err ("Object undefined") unless defined $o;
309 push @{$self->{triple}}, [$s =>$p=> $o];
310 }
311
312 sub stringify ($) {
313 my ($self) = @_;
314 return join "\n", @{main::array_uniq ([sort map {"$_."} map {
315 sprintf '%s %s %s', map {
316 $_ =~ /^[_"]/ ? $_ : "<$_>"
317 } @{$_}[0, 1, 2];
318 } @{$self->{triple}}])}, '';
319 }
320
321 sub stringify_as_xml ($) {
322 my ($self) = @_;
323 use RDF::Notation3::XML;
324 my $notation3 = RDF::Notation3::XML->new;
325 my $n3 = $self->stringify;
326 my $rdf_ = ExpandedURI q<rdf:_>;
327 $n3 =~ s{$rdf_}{ExpandedURI q<rdf:XXXX__dummy__XXXX>}ge;
328 $notation3->parse_string ($n3);
329 my $xml = $notation3->get_string;
330 $xml =~ s/\brdf:nodeID="_:/rdf:nodeID="/g;
331 $xml =~ s/XXXX__dummy__XXXX/_/g;
332 # $xml =~ s/^<\?xml version="1.0" encoding="utf-8"\?>\s*//;
333 $xml;
334 }
335
336 __END__
337
338 =head1 NAME
339
340 cdis2rdf - cdis to RDF converter
341
342 =head1 SYNOPSIS
343
344 perl cdis2rdf.pl input.cdis [options...] > output.rdf
345 perl cdis2rdf.pl --help
346
347 =head1 DESCRIPTION
348
349 The C<cdis2rdf> utility generates a RDF graph from a compiled
350 "dis" file. The graph describes relationship of module, "For" or
351 resource defined in the dis files. The RDF data outputed are able
352 to be used with other utilities that support RDF.
353
354 =head2 OPTIONS
355
356 =over 4
357
358 =item I<input.cdis>
359
360 A compiled "dis" file from which a RDF graph is generated.
361
362 =item I<output.rdf>
363
364 A file to which the RDF data generated is saved.
365
366 =item C<--output-anon-resource> (default) / C<--nooutput-anon-resource>
367
368 Set whether anonymous resources are outputed.
369
370 =item C<--output-as-n3>
371
372 Set to output the graph in RDF/Notation3 format.
373
374 =item C<--output-as-xml> (default)
375
376 Set to output the graph in RDF/XML format. Note that the
377 L<RDF::Notation3::XML> Perl module is used to generate the XML entity.
378
379 =item C<--help>
380
381 Show the help message.
382
383 =item C<--output-for> / C<--nooutput-for> (default)
384
385 Set whether relationships of "For" URI references are outputed.
386
387 =item C<--output-local-resource> (default) / C<--nooutput-local-resource>
388
389 Set whether local resources (resources that do have the locally-scoped
390 name but do not have the global name) are outputed.
391
392 =item C<--output-only-in-module=I<pattern>> (default: C<.>)
393
394 A regex filter that is applied to URI references of module names.
395 This filter is applied to defining-modules of resources (not modules themselves).
396
397 =item C<--output-module> / C<--nooutput-module> (default)
398
399 Set whehter relationships of modules are outputed.
400
401 =item C<--output-perl> / C<--nooutput-perl> (default)
402
403 Set whether "For"-Perl specific properties are outputed.
404
405 =item C<--output-perl-member-pattern=I<pattern>> (default: C<.>)
406
407 A regex filter that is applied to URI references of Perl
408 package members such as methods and constant values.
409
410 =item C<--output-resource> / C<--nooutput-resource> (default)
411
412 Set whether relationships of resources are outputed.
413
414 =item C<--output-resource-uri-pattern=I<pattern>> (default: C<.>)
415
416 A regex filter that is applied to URI references of
417 resources.
418
419 =item C<--output-root-anon-resource> / C<--nooutput-root-anon-resource> (default: same as C<--output-anon-resource> / C<--nooutput-anon-resource>)
420
421 Set whether anonymous resources that are direct children of modules.
422
423 =cut
424
425 =head1 LICENSE
426
427 Copyright 2004 Wakaba <w@suika.fam.cx>. All rights reserved.
428
429 This program is free software; you can redistribute it and/or
430 modify it under the same terms as Perl itself.
431
432 Note that the copyright holder(s) of this script does not claim
433 any rights for materials outputed by this script, although
434 some of its part comes from this script. The copyright
435 holder(s) of source document should define their license terms.
436
437 =cut

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24