manakai/bin/dis2rdf.pl

#!/usr/bin/perl -w 
use strict;

use Getopt::Long;
use Pod::Usage;
my %Opt;
GetOptions (
  'for=s' => \$Opt{For},
  'help' => \$Opt{help},
  'no-undef-check' => \$Opt{no_undef_check},
  'output-as-n3' => \$Opt{output_as_n3},
  'output-as-xml' => \$Opt{output_as_xml},
  'output-for' => \$Opt{output_for},
  'output-local-resource' => \$Opt{output_local_resource},
  'output-module' => \$Opt{output_module},
  'output-only-in-module=s' => \$Opt{output_resource_pattern},
  'output-prop-perl' => \$Opt{output_prop_perl},
  'output-resource' => \$Opt{output_resource},
  'output-resource-uri-pattern=s' => \$Opt{output_resource_uri_pattern},
) or pod2usage (2);
if ($Opt{help}) {
  pod2usage (0);
  exit;
}
if ($Opt{output_as_n3} and $Opt{output_as_xml}) {
  pod2usage (2);
  exit;
}
$Opt{output_as_xml} = 1 unless $Opt{output_as_n3};

BEGIN {
require 'manakai/genlib.pl';
require 'manakai/dis.pl';
}
sub n3_literal ($) {
  my $s = shift;
  qq<"$s">;
}
our $State;
our $result = new manakai::n3;

$Opt{file_name} = shift;
$Opt{output_resource_pattern} ||= qr/.+/;
$Opt{output_resource_uri_pattern} ||= qr/.+/;

$State->{DefaultFor} = $Opt{For};

my $source = dis_load_module_file (module_file_name => $Opt{file_name},
                                   For => $Opt{For},
                                   use_default_for => 1);
$State->{for_def_required}->{$State->{DefaultFor}} ||= 1;

dis_check_undef_type_and_for ()
  unless $Opt{no_undef_check};

if (dis_uri_for_match (ExpandedURI q<ManakaiDOM:Perl>, $State->{DefaultFor})) {
  dis_perl_init ($source, For => $State->{DefaultFor});
}

my $primary = $result->get_new_anon_id (Name => 'boot');
$result->add_triple ($primary =>ExpandedURI q<d:module>=> $State->{module})
                if $Opt{output_module};
$result->add_triple ($primary =>ExpandedURI q<d:DefaultFor> => $State->{DefaultFor})
                if $Opt{output_for};

if ($Opt{output_module}) {
for (keys %{$State->{Module}}) {
  my $mod = $State->{Module}->{$_};
  if ($_ eq $mod->{URI}) {
    $result->add_triple ($mod->{URI} =>ExpandedURI q<rdf:type>=>
                         ExpandedURI q<d:Module>);
    $result->add_triple ($mod->{URI} =>ExpandedURI q<d:Name>=>
                         n3_literal $mod->{Name});
    $result->add_triple ($mod->{URI} =>ExpandedURI q<d:NameURI>=>
                         $mod->{NameURI});
    $result->add_triple ($mod->{URI} =>ExpandedURI q<d:ModuleGroup>=>
                         $mod->{ModuleGroup});
    $result->add_triple ($mod->{URI} =>ExpandedURI q<d:FileName>=>
                         n3_literal $mod->{FileName})
      if defined $mod->{FileName};
    $result->add_triple ($mod->{URI} =>ExpandedURI q<d:Namespace>=>
                         $mod->{Namespace});
    for (@{$mod->{require_module}||[]}) {
      $result->add_triple ($mod->{URI} =>ExpandedURI q<d:Require>=> $_);
    }
    for (keys %{$mod->{For}}) {
      $result->add_triple ($mod->{URI} =>ExpandedURI q<d:For>=> $_);
    }
    for (@{$mod->{ISA}}) {
      $result->add_triple ($mod->{URI} =>ExpandedURI q<rdfs:subClassOf>=> $_);
    }
    if ($Opt{output_prop_perl}) {
      $result->add_triple ($mod->{URI} =>ExpandedURI q<dis2pm:packageName>=>
                           n3_literal $mod->{ExpandedURI q<dis2pm:packageName>})
        if defined $mod->{ExpandedURI q<dis2pm:packageName>};
    }
  } else {
    $result->add_triple ($_ =>ExpandedURI q<owl:sameAs>=> $mod->{URI});
  }
}}

if ($Opt{output_for}) {
for (keys %{$State->{For}}) {
  my $mod = $State->{For}->{$_};
  next unless $mod->{parentModule} =~ /$Opt{output_resource_pattern}/;
  if ($_ eq $mod->{URI}) {
    $result->add_triple ($mod->{URI} =>ExpandedURI q<rdf:type>=>
                         ExpandedURI q<d:For>);
    $result->add_triple ($mod->{URI} =>ExpandedURI q<d:NameURI>=> $mod->{URI});
    $result->add_triple ($mod->{URI} =>ExpandedURI q<d:FullName>=>
                         n3_literal $mod->{FullName});
    $result->add_triple ($mod->{URI} =>ExpandedURI q<d:parentModule>=>
                         $mod->{parentModule});
    for (@{$mod->{ISA}}) {
      $result->add_triple ($mod->{URI} =>ExpandedURI q<rdfs:subClassOf>=> $_);
    }
    for (@{$mod->{Implement}}) {
      $result->add_triple ($mod->{URI} =>ExpandedURI q<d:Implement>=> $_);
    }
  } else {
    $result->add_triple ($_ =>ExpandedURI q<owl:sameAs>=> $mod->{URI});
  }
}}

if ($Opt{output_resource}) {
  sub class_to_rdf ($;%);
  sub class_to_rdf ($;%) {
    my ($mod, %opt) = @_;
    return unless defined $mod->{Name};
    return unless $mod->{parentModule} =~ /$Opt{output_resource_pattern}/;
    if ((defined $mod->{URI} and $opt{key} eq $mod->{URI}) or
        not defined $mod->{URI}) {
      return if defined $mod->{URI} and
                $mod->{URI} !~ /$Opt{output_resource_uri_pattern}/;
      my $uri = defined $mod->{URI}
                       ? $mod->{URI}
                       : $result->get_new_anon_id (Name => $mod->{Name});
      $result->add_triple ($uri =>ExpandedURI q<d:Name>=>
                           n3_literal $mod->{Name}) if length $mod->{Name};
      $result->add_triple ($uri =>ExpandedURI q<d:NameURI>=> $mod->{NameURI})
        if defined $mod->{NameURI};
      $result->add_triple ($uri =>ExpandedURI q<d:parentResource>=>
                           $opt{parent_class_uri})
        if defined $opt{parent_class_uri};
      $result->add_triple ($uri =>ExpandedURI q<d:parentModule>=>
                           $mod->{parentModule});
      for (keys %{$mod->{Type}}) {
        $result->add_triple ($uri =>ExpandedURI q<rdf:type>=> $_);
      }
      for (@{$mod->{ISA}}) {
        $result->add_triple ($uri =>ExpandedURI q<rdfs:subClassOf>=> $_);
      }
      for (@{$mod->{Implement}}) {
        $result->add_triple ($uri =>ExpandedURI q<d:Implement>=> $_);
      }
      if ($Opt{output_local_resource}) {
        for (keys %{$mod->{Resource}}) {
          class_to_rdf ($mod->{Resource}->{$_}, parent_class => $mod,
                        parent_class_uri => $uri,
                        key => $_);
        }
      }
    } else { ## Alias URI
      return if $opt{key} !~ /$Opt{output_resource_uri_pattern}/;
      $result->add_triple ($opt{key} =>ExpandedURI q<owl:sameAs>=> $mod->{URI});
    }
  }
  for (sort keys %{$State->{Type}}) {
    class_to_rdf ($State->{Type}->{$_}, key => $_);
  }
}

if ($Opt{output_as_xml}) {
  print $result->stringify_as_xml;
} else {
  print $result->stringify;
}

package manakai::n3;
sub new ($) {
  bless {triple => [], anon => 0}, shift;
}

sub get_new_anon_id ($;%) {
  my ($self, %opt) = @_;
  my $s = $opt{Name} ? $opt{Name} : '';
  return sprintf '_:r%d%s', $self->{anon}++, $s;
}

sub add_triple ($$$$) {
  my ($self, $s =>$p=> $o) = @_;
  push @{$self->{triple}}, [$s =>$p=> $o];
}

sub stringify ($) {
  my ($self) = @_;
  return join "\n", (map {"$_."} map {
    sprintf '%s %s %s', map {
      $_ =~ /^[_"]/ ? $_ : "<$_>"
    } @{$_}[0, 1, 2];
  } @{$self->{triple}}), '';
}

sub stringify_as_xml ($) {
  my ($self) = @_;
  use RDF::Notation3::XML;
  my $notation3 = RDF::Notation3::XML->new;
  $notation3->parse_string ($self->stringify);
  my $xml = $notation3->get_string;
  $xml =~ s/\brdf:nodeID="_:/rdf:nodeID="/g;
#  $xml =~ s/^<\?xml version="1.0" encoding="utf-8"\?>\s*//;
  $xml;
}

1;

__END__

=head1 NAME

dis2rdf.pl - dis to RDF converter

=head1 SYNOPSIS

  $ perl dis2rdf.pl input.dis [options...] > output.rdf

=head1 DESCRIPTION

This script generates a RDF graph from a "dis" file.

=over 4

=item I<input.dis>

The "dis" file from which a RDF graph is generated.

=item I<output.rdf>

An RDF/XML entity is outputed.

=item C<--output-module>

Show the relationship of modules.

=item C<--output-type>

Show the relationship of types.

=item C<--output-for>

Show the relationship of "for"s.

=cut

=head1 LICENSE

Copyright 2004 Wakaba <w@suika.fam.cx>.  All rights reserved.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

Note that the copyright holder(s) of this script does not claim 
any rights for materials outputed by this script, although 
some of its part comes from this script.  The copyright 
holder(s) of source document should define their license terms.

=cut
1	wakaba	1.1	#!/usr/bin/perl -w
2			use strict;
3
4			use Getopt::Long;
5			use Pod::Usage;
6			my %Opt;
7			GetOptions (
8			'for=s' => \$Opt{For},
9			'help' => \$Opt{help},
10	wakaba	1.2	'no-undef-check' => \$Opt{no_undef_check},
11	wakaba	1.4	'output-as-n3' => \$Opt{output_as_n3},
12			'output-as-xml' => \$Opt{output_as_xml},
13	wakaba	1.1	'output-for' => \$Opt{output_for},
14	wakaba	1.3	'output-local-resource' => \$Opt{output_local_resource},
15	wakaba	1.1	'output-module' => \$Opt{output_module},
16	wakaba	1.4	'output-only-in-module=s' => \$Opt{output_resource_pattern},
17			'output-prop-perl' => \$Opt{output_prop_perl},
18	wakaba	1.3	'output-resource' => \$Opt{output_resource},
19	wakaba	1.4	'output-resource-uri-pattern=s' => \$Opt{output_resource_uri_pattern},
20	wakaba	1.1	) or pod2usage (2);
21			if ($Opt{help}) {
22			pod2usage (0);
23			exit;
24			}
25	wakaba	1.4	if ($Opt{output_as_n3} and $Opt{output_as_xml}) {
26			pod2usage (2);
27			exit;
28			}
29			$Opt{output_as_xml} = 1 unless $Opt{output_as_n3};
30	wakaba	1.1
31			BEGIN {
32			require 'manakai/genlib.pl';
33			require 'manakai/dis.pl';
34			}
35			sub n3_literal ($) {
36			my $s = shift;
37			qq<"$s">;
38			}
39			our $State;
40			our $result = new manakai::n3;
41
42			$Opt{file_name} = shift;
43	wakaba	1.4	$Opt{output_resource_pattern} \|\|= qr/.+/;
44			$Opt{output_resource_uri_pattern} \|\|= qr/.+/;
45	wakaba	1.1
46			$State->{DefaultFor} = $Opt{For};
47	wakaba	1.2
48	wakaba	1.1	my $source = dis_load_module_file (module_file_name => $Opt{file_name},
49	wakaba	1.2	For => $Opt{For},
50	wakaba	1.1	use_default_for => 1);
51			$State->{for_def_required}->{$State->{DefaultFor}} \|\|= 1;
52
53	wakaba	1.2	dis_check_undef_type_and_for ()
54			unless $Opt{no_undef_check};
55	wakaba	1.1
56	wakaba	1.4	if (dis_uri_for_match (ExpandedURI q<ManakaiDOM:Perl>, $State->{DefaultFor})) {
57			dis_perl_init ($source, For => $State->{DefaultFor});
58			}
59
60			my $primary = $result->get_new_anon_id (Name => 'boot');
61	wakaba	1.1	$result->add_triple ($primary =>ExpandedURI q<d:module>=> $State->{module})
62			if $Opt{output_module};
63			$result->add_triple ($primary =>ExpandedURI q<d:DefaultFor> => $State->{DefaultFor})
64			if $Opt{output_for};
65
66			if ($Opt{output_module}) {
67			for (keys %{$State->{Module}}) {
68			my $mod = $State->{Module}->{$_};
69	wakaba	1.2	if ($_ eq $mod->{URI}) {
70			$result->add_triple ($mod->{URI} =>ExpandedURI q<rdf:type>=>
71			ExpandedURI q<d:Module>);
72			$result->add_triple ($mod->{URI} =>ExpandedURI q<d:Name>=>
73	wakaba	1.1	n3_literal $mod->{Name});
74	wakaba	1.2	$result->add_triple ($mod->{URI} =>ExpandedURI q<d:NameURI>=>
75			$mod->{NameURI});
76			$result->add_triple ($mod->{URI} =>ExpandedURI q<d:ModuleGroup>=>
77			$mod->{ModuleGroup});
78			$result->add_triple ($mod->{URI} =>ExpandedURI q<d:FileName>=>
79	wakaba	1.1	n3_literal $mod->{FileName})
80			if defined $mod->{FileName};
81	wakaba	1.2	$result->add_triple ($mod->{URI} =>ExpandedURI q<d:Namespace>=>
82			$mod->{Namespace});
83	wakaba	1.1	for (@{$mod->{require_module}\|\|[]}) {
84	wakaba	1.2	$result->add_triple ($mod->{URI} =>ExpandedURI q<d:Require>=> $_);
85			}
86			for (keys %{$mod->{For}}) {
87			$result->add_triple ($mod->{URI} =>ExpandedURI q<d:For>=> $_);
88			}
89	wakaba	1.4	for (@{$mod->{ISA}}) {
90	wakaba	1.2	$result->add_triple ($mod->{URI} =>ExpandedURI q<rdfs:subClassOf>=> $_);
91	wakaba	1.1	}
92	wakaba	1.4	if ($Opt{output_prop_perl}) {
93			$result->add_triple ($mod->{URI} =>ExpandedURI q<dis2pm:packageName>=>
94			n3_literal $mod->{ExpandedURI q<dis2pm:packageName>})
95			if defined $mod->{ExpandedURI q<dis2pm:packageName>};
96			}
97	wakaba	1.1	} else {
98	wakaba	1.2	$result->add_triple ($_ =>ExpandedURI q<owl:sameAs>=> $mod->{URI});
99	wakaba	1.1	}
100			}}
101
102			if ($Opt{output_for}) {
103			for (keys %{$State->{For}}) {
104			my $mod = $State->{For}->{$_};
105	wakaba	1.4	next unless $mod->{parentModule} =~ /$Opt{output_resource_pattern}/;
106	wakaba	1.2	if ($_ eq $mod->{URI}) {
107			$result->add_triple ($mod->{URI} =>ExpandedURI q<rdf:type>=>
108			ExpandedURI q<d:For>);
109			$result->add_triple ($mod->{URI} =>ExpandedURI q<d:NameURI>=> $mod->{URI});
110			$result->add_triple ($mod->{URI} =>ExpandedURI q<d:FullName>=>
111			n3_literal $mod->{FullName});
112	wakaba	1.4	$result->add_triple ($mod->{URI} =>ExpandedURI q<d:parentModule>=>
113			$mod->{parentModule});
114			for (@{$mod->{ISA}}) {
115	wakaba	1.2	$result->add_triple ($mod->{URI} =>ExpandedURI q<rdfs:subClassOf>=> $_);
116	wakaba	1.1	}
117	wakaba	1.4	for (@{$mod->{Implement}}) {
118	wakaba	1.2	$result->add_triple ($mod->{URI} =>ExpandedURI q<d:Implement>=> $_);
119	wakaba	1.1	}
120			} else {
121	wakaba	1.2	$result->add_triple ($_ =>ExpandedURI q<owl:sameAs>=> $mod->{URI});
122	wakaba	1.1	}
123			}}
124
125	wakaba	1.3	if ($Opt{output_resource}) {
126	wakaba	1.2	sub class_to_rdf ($;%);
127			sub class_to_rdf ($;%) {
128			my ($mod, %opt) = @_;
129			return unless defined $mod->{Name};
130	wakaba	1.4	return unless $mod->{parentModule} =~ /$Opt{output_resource_pattern}/;
131	wakaba	1.2	if ((defined $mod->{URI} and $opt{key} eq $mod->{URI}) or
132			not defined $mod->{URI}) {
133	wakaba	1.4	return if defined $mod->{URI} and
134			$mod->{URI} !~ /$Opt{output_resource_uri_pattern}/;
135			my $uri = defined $mod->{URI}
136			? $mod->{URI}
137			: $result->get_new_anon_id (Name => $mod->{Name});
138	wakaba	1.2	$result->add_triple ($uri =>ExpandedURI q<d:Name>=>
139			n3_literal $mod->{Name}) if length $mod->{Name};
140			$result->add_triple ($uri =>ExpandedURI q<d:NameURI>=> $mod->{NameURI})
141			if defined $mod->{NameURI};
142	wakaba	1.3	$result->add_triple ($uri =>ExpandedURI q<d:parentResource>=>
143	wakaba	1.2	$opt{parent_class_uri})
144			if defined $opt{parent_class_uri};
145	wakaba	1.4	$result->add_triple ($uri =>ExpandedURI q<d:parentModule>=>
146			$mod->{parentModule});
147	wakaba	1.2	for (keys %{$mod->{Type}}) {
148			$result->add_triple ($uri =>ExpandedURI q<rdf:type>=> $_);
149			}
150	wakaba	1.4	for (@{$mod->{ISA}}) {
151	wakaba	1.2	$result->add_triple ($uri =>ExpandedURI q<rdfs:subClassOf>=> $_);
152			}
153	wakaba	1.4	for (@{$mod->{Implement}}) {
154	wakaba	1.2	$result->add_triple ($uri =>ExpandedURI q<d:Implement>=> $_);
155			}
156	wakaba	1.3	if ($Opt{output_local_resource}) {
157	wakaba	1.4	for (keys %{$mod->{Resource}}) {
158			class_to_rdf ($mod->{Resource}->{$_}, parent_class => $mod,
159	wakaba	1.2	parent_class_uri => $uri,
160			key => $_);
161			}
162			}
163			} else { ## Alias URI
164	wakaba	1.4	return if $opt{key} !~ /$Opt{output_resource_uri_pattern}/;
165			$result->add_triple ($opt{key} =>ExpandedURI q<owl:sameAs>=> $mod->{URI});
166	wakaba	1.1	}
167			}
168	wakaba	1.4	for (sort keys %{$State->{Type}}) {
169	wakaba	1.2	class_to_rdf ($State->{Type}->{$_}, key => $_);
170			}
171			}
172	wakaba	1.1
173	wakaba	1.4	if ($Opt{output_as_xml}) {
174			print $result->stringify_as_xml;
175			} else {
176			print $result->stringify;
177			}
178	wakaba	1.1
179			package manakai::n3;
180			sub new ($) {
181			bless {triple => [], anon => 0}, shift;
182			}
183
184	wakaba	1.4	sub get_new_anon_id ($;%) {
185			my ($self, %opt) = @_;
186			my $s = $opt{Name} ? $opt{Name} : '';
187			return sprintf '_:r%d%s', $self->{anon}++, $s;
188	wakaba	1.1	}
189
190			sub add_triple ($$$$) {
191			my ($self, $s =>$p=> $o) = @_;
192			push @{$self->{triple}}, [$s =>$p=> $o];
193			}
194
195			sub stringify ($) {
196			my ($self) = @_;
197			return join "\n", (map {"$_."} map {
198			sprintf '%s %s %s', map {
199			$_ =~ /^[_"]/ ? $_ : "<$_>"
200			} @{$_}[0, 1, 2];
201			} @{$self->{triple}}), '';
202			}
203
204			sub stringify_as_xml ($) {
205			my ($self) = @_;
206			use RDF::Notation3::XML;
207			my $notation3 = RDF::Notation3::XML->new;
208			$notation3->parse_string ($self->stringify);
209	wakaba	1.2	my $xml = $notation3->get_string;
210			$xml =~ s/\brdf:nodeID="_:/rdf:nodeID="/g;
211			# $xml =~ s/^<\?xml version="1.0" encoding="utf-8"\?>\s*//;
212			$xml;
213	wakaba	1.1	}
214
215			1;
216
217			__END__
218
219			=head1 NAME
220
221			dis2rdf.pl - dis to RDF converter
222
223			=head1 SYNOPSIS
224
225			$ perl dis2rdf.pl input.dis [options...] > output.rdf
226
227			=head1 DESCRIPTION
228
229			This script generates a RDF graph from a "dis" file.
230
231			=over 4
232
233			=item I<input.dis>
234
235			The "dis" file from which a RDF graph is generated.
236
237			=item I<output.rdf>
238
239			An RDF/XML entity is outputed.
240
241			=item C<--output-module>
242
243			Show the relationship of modules.
244
245			=item C<--output-type>
246
247			Show the relationship of types.
248
249			=item C<--output-for>
250
251			Show the relationship of "for"s.
252
253			=cut
254
255			=head1 LICENSE
256
257			Copyright 2004 Wakaba <w@suika.fam.cx>. All rights reserved.
258
259			This program is free software; you can redistribute it and/or
260			modify it under the same terms as Perl itself.
261
262			Note that the copyright holder(s) of this script does not claim
263			any rights for materials outputed by this script, although
264			some of its part comes from this script. The copyright
265			holder(s) of source document should define their license terms.
266
267			=cut