manakai/bin/dis2rdf.pl

#!/usr/bin/perl -w 
use strict;
use Message::Util::QName::Filter {
  d => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis-->,
  dis2pm => q<http://suika.fam.cx/~wakaba/archive/2004/11/8/dis2pm#>,
  DOMCore => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#>,
  DOMMain => q<http://suika.fam.cx/~wakaba/archive/2004/dom/main#>,
  lang => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#>,
  Perl => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#Perl-->,
  license => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/license#>,
  ManakaiDOM => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#>,
  owl => q<http://www.w3.org/2002/07/owl#>,
  rdf => q<http://www.w3.org/1999/02/22-rdf-syntax-ns#>,
  rdfs => q<http://www.w3.org/2000/01/rdf-schema#>,
};

use Getopt::Long;
use Pod::Usage;
my %Opt;
GetOptions (
  'for=s' => \$Opt{For},
  'help' => \$Opt{help},
  'undef-check!' => \$Opt{no_undef_check},
  'output-anon-resource!' => \$Opt{output_anon_resource},
  '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-perl!' => \$Opt{output_prop_perl},
  'output-perl-member-pattern=s' => \$Opt{output_perl_member_pattern},
  'output-resource!' => \$Opt{output_resource},
  'output-resource-uri-pattern=s' => \$Opt{output_resource_uri_pattern},
  'output-root-anon-resource!' => $Opt{output_root_anon_resource},
) or pod2usage (2);
if ($Opt{help}) {
  pod2usage (0);
  exit;
}
if ($Opt{output_as_n3} and $Opt{output_as_xml}) {
  pod2usage (2);
  exit;
}
$Opt{file_name} = shift;
$Opt{output_resource_pattern} ||= qr/./;
$Opt{output_resource_uri_pattern} ||= qr/./;
$Opt{output_root_anon_resource} = $Opt{output_anon_resource}
  unless defined $Opt{output_anon_resource};
$Opt{output_as_xml} = 1 unless $Opt{output_as_n3};
$Opt{output_anon_resource} = 1 unless defined $Opt{output_anon_resource};
$Opt{output_local_resource} = 1 unless defined $Opt{output_local_resource};
$Opt{no_undef_check} = defined $Opt{no_undef_check}
                         ? $Opt{no_undef_check} ? 0 : 1 : 0;
$Opt{output_perl_member_pattern} ||= qr/./;

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

$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>};
      if ($Opt{output_resource}) {
        for (values %{$mod->{ExpandedURI q<dis2pm:package>}}) {
          my $uri = defined $_->{URI}
                       ? $_->{URI}
                       : ($_->{ExpandedURI q<d:anonID>}
                            ||= $result->get_new_anon_id (Name => $_->{Name}));
          $result->add_triple ($mod->{URI} =>ExpandedURI q<dis2pm:package>=>
                               $uri);
        }
      }
    }
  } else {
    $result->add_triple ($_ =>ExpandedURI q<owl:sameAs>=> $mod->{URI});
  }
}}

if ($Opt{output_for}) {
for (keys %{$State->{For}}) {
  my $mod = $State->{For}->{$_};
  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})
      if defined $mod->{FullName};
    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}/;
    return if $Opt{output_prop_perl} and
              $mod->{ExpandedURI q<dis2pm:type>} and
              {
                ExpandedURI q<ManakaiDOM:DOMAttribute> => 1,
                ExpandedURI q<ManakaiDOM:DOMMethod> => 1,
              }->{$mod->{ExpandedURI q<dis2pm:type>}} and
              $mod->{Name} and
              $mod->{Name} !~ /$Opt{output_perl_member_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}/;
      return if not defined $mod->{URI} and not $Opt{output_anon_resource};
      my $uri = defined $mod->{URI}
                       ? $mod->{URI}
                       : ($mod->{ExpandedURI q<d:anonID>}
                            ||= $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};
      if ($Opt{output_module}) {
        $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_for}) {
        for (keys %{$mod->{For}}) {
          $result->add_triple ($uri =>ExpandedURI q<d:For>=> $_);
        }
      }
      for (@{$mod->{hasResource}||[]}) {
        my $ruri = defined $_->{URI}
                      ? $_->{URI}
                      : ($_->{ExpandedURI q<d:anonID>}
                              ||= $result->get_new_anon_id (Name => $_->{Name}));
        $result->add_triple ($uri =>ExpandedURI q<d:hasResource>=> $ruri);
      }
      if ($Opt{output_prop_perl}) {
        for my $prop ([ExpandedURI q<dis2pm:packageName>],
                      [ExpandedURI q<dis2pm:ifPackagePrefix>],
                      [ExpandedURI q<dis2pm:methodName>],
                      [ExpandedURI q<dis2pm:paramName>],
                      [ExpandedURI q<dis2pm:constGroupName>],
                      [ExpandedURI q<dis2pm:constName>],
                      [ExpandedURI q<ManakaiDOM:isRedefining>,
                        ExpandedURI q<DOMMain:boolean>],
                      [ExpandedURI q<ManakaiDOM:isForInternal>,
                        ExpandedURI q<DOMMain:boolean>],
                      [ExpandedURI q<d:Read>, ExpandedURI q<DOMMain:boolean>],
                      [ExpandedURI q<d:Write>,
                        ExpandedURI q<DOMMain:boolean>],
                      [ExpandedURI q<dis2pm:undefable>,
                        ExpandedURI q<DOMMain:boolean>]) {
          $result->add_triple ($uri =>$prop->[0]=>
                               n3_literal $mod->{$prop->[0]})
            if defined $mod->{$prop->[0]};
        }
        for my $prop ([ExpandedURI q<d:Type>],
                      [ExpandedURI q<d:actualType>]) {
          $result->add_triple ($uri =>$prop->[0]=> $mod->{$prop->[0]})
            if defined $mod->{$prop->[0]};
        }
        for my $prop ([ExpandedURI q<dis2pm:getter>],
                      [ExpandedURI q<dis2pm:setter>],
                      [ExpandedURI q<dis2pm:return>]) {
          my $oo = $mod->{$prop->[0]};
          if ($oo and defined $oo->{Name}) {
            my $o = defined $oo->{URI}
                      ? $oo->{URI}
                      : ($oo->{ExpandedURI q<d:anonID>}
                            ||= $result->get_new_anon_id (Name => $oo->{Name}));
            $result->add_triple ($uri =>$prop->[0]=> $o)
          }
        }
        for my $p (ExpandedURI q<dis2pm:method>,
                   ExpandedURI q<dis2pm:constGroup>,
                   ExpandedURI q<dis2pm:const>) {
          for my $v (values %{$mod->{$p}||{}}) {
            my $ruri = defined $v->{URI}
                      ? $v->{URI}
                      : ($v->{ExpandedURI q<d:anonID>}
                              ||= $result->get_new_anon_id (Name => $v->{Name}));
            $result->add_triple ($uri =>$p=> $ruri);
          }
        }
        if ($mod->{ExpandedURI q<dis2pm:type>} eq
              ExpandedURI q<ManakaiDOM:DOMMethod>) {
          $result->add_triple
                      ($uri =>ExpandedURI q<dis2pm:param>=>
                       my $p = $result->get_new_anon_id (Name => 'param'));
          $result->add_triple ($uri =>ExpandedURI q<rdf:type>=>
                               ExpandedURI q<rdf:Seq>);
          my $i = 0;
          for (@{$mod->{ExpandedURI q<dis2pm:param>}||[]}) {
            my $ruri = defined $_->{URI}
                          ? $_->{URI}
                          : ($_->{ExpandedURI q<d:anonID>}
                              ||= $result->get_new_anon_id (Name => $_->{Name}));
            $result->add_triple ($p =>(ExpandedURI q<rdf:_>).++$i=> $ruri);
          }
        }
      }
      if ($Opt{output_local_resource}) {
        for (keys %{$mod->{Resource}}) {
          class_to_rdf ($mod->{Resource}->{$_}, %opt, parent_class => $mod,
                        parent_class_uri => $uri,
                        key => $_);
        }
      }
    } else { ## Alias URI
      return unless $opt{key} =~ /$Opt{output_resource_uri_pattern}/ or
                    $mod->{URI} =~ /$Opt{output_resource_uri_pattern}/;
      $result->add_triple ($opt{key} =>ExpandedURI q<owl:sameAs>=> $mod->{URI});
    }
  }
  for (sort keys %{$State->{Type}}) {
    next if not $Opt{output_root_anon_resource} and
            not defined $State->{Type}->{$_}->{URI};
    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) = @_;
  main::impl_err ("Subject undefined") unless defined $s;
  main::impl_err ("Property undefined") unless defined $p;
  main::impl_err ("Object undefined") unless defined $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;
  my $n3 = $self->stringify;
  my $rdf_ = ExpandedURI q<rdf:_>;
  $n3 =~ s{$rdf_}{ExpandedURI q<rdf:XXXX__dummy__XXXX>}ge;
  $notation3->parse_string ($n3);
  my $xml = $notation3->get_string;
  $xml =~ s/\brdf:nodeID="_:/rdf:nodeID="/g;
  $xml =~ s/XXXX__dummy__XXXX/_/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	wakaba	1.6	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	wakaba	1.1
17			use Getopt::Long;
18			use Pod::Usage;
19			my %Opt;
20			GetOptions (
21			'for=s' => \$Opt{For},
22			'help' => \$Opt{help},
23	wakaba	1.5	'undef-check!' => \$Opt{no_undef_check},
24			'output-anon-resource!' => \$Opt{output_anon_resource},
25	wakaba	1.4	'output-as-n3' => \$Opt{output_as_n3},
26			'output-as-xml' => \$Opt{output_as_xml},
27	wakaba	1.5	'output-for!' => \$Opt{output_for},
28			'output-local-resource!' => \$Opt{output_local_resource},
29			'output-module!' => \$Opt{output_module},
30	wakaba	1.4	'output-only-in-module=s' => \$Opt{output_resource_pattern},
31	wakaba	1.7	'output-perl!' => \$Opt{output_prop_perl},
32			'output-perl-member-pattern=s' => \$Opt{output_perl_member_pattern},
33	wakaba	1.5	'output-resource!' => \$Opt{output_resource},
34	wakaba	1.4	'output-resource-uri-pattern=s' => \$Opt{output_resource_uri_pattern},
35	wakaba	1.7	'output-root-anon-resource!' => $Opt{output_root_anon_resource},
36	wakaba	1.1	) or pod2usage (2);
37			if ($Opt{help}) {
38			pod2usage (0);
39			exit;
40			}
41	wakaba	1.4	if ($Opt{output_as_n3} and $Opt{output_as_xml}) {
42			pod2usage (2);
43			exit;
44			}
45	wakaba	1.7	$Opt{file_name} = shift;
46			$Opt{output_resource_pattern} \|\|= qr/./;
47			$Opt{output_resource_uri_pattern} \|\|= qr/./;
48			$Opt{output_root_anon_resource} = $Opt{output_anon_resource}
49			unless defined $Opt{output_anon_resource};
50	wakaba	1.4	$Opt{output_as_xml} = 1 unless $Opt{output_as_n3};
51	wakaba	1.5	$Opt{output_anon_resource} = 1 unless defined $Opt{output_anon_resource};
52			$Opt{output_local_resource} = 1 unless defined $Opt{output_local_resource};
53	wakaba	1.8	$Opt{no_undef_check} = defined $Opt{no_undef_check}
54			? $Opt{no_undef_check} ? 0 : 1 : 0;
55	wakaba	1.7	$Opt{output_perl_member_pattern} \|\|= qr/./;
56	wakaba	1.1
57			BEGIN {
58			require 'manakai/genlib.pl';
59			require 'manakai/dis.pl';
60			}
61			sub n3_literal ($) {
62			my $s = shift;
63	wakaba	1.5	impl_err ("Literal value not defined") unless defined $s;
64	wakaba	1.1	qq<"$s">;
65			}
66			our $State;
67			our $result = new manakai::n3;
68
69			$State->{DefaultFor} = $Opt{For};
70	wakaba	1.2
71	wakaba	1.1	my $source = dis_load_module_file (module_file_name => $Opt{file_name},
72	wakaba	1.2	For => $Opt{For},
73	wakaba	1.1	use_default_for => 1);
74			$State->{for_def_required}->{$State->{DefaultFor}} \|\|= 1;
75
76	wakaba	1.9	dis_check_undef_type_and_for () unless $Opt{no_undef_check};
77	wakaba	1.1
78	wakaba	1.4	if (dis_uri_for_match (ExpandedURI q<ManakaiDOM:Perl>, $State->{DefaultFor})) {
79			dis_perl_init ($source, For => $State->{DefaultFor});
80			}
81
82			my $primary = $result->get_new_anon_id (Name => 'boot');
83	wakaba	1.1	$result->add_triple ($primary =>ExpandedURI q<d:module>=> $State->{module})
84			if $Opt{output_module};
85	wakaba	1.7	$result->add_triple
86			($primary =>ExpandedURI q<d:DefaultFor> => $State->{DefaultFor})
87	wakaba	1.1	if $Opt{output_for};
88
89			if ($Opt{output_module}) {
90			for (keys %{$State->{Module}}) {
91			my $mod = $State->{Module}->{$_};
92	wakaba	1.2	if ($_ eq $mod->{URI}) {
93			$result->add_triple ($mod->{URI} =>ExpandedURI q<rdf:type>=>
94			ExpandedURI q<d:Module>);
95			$result->add_triple ($mod->{URI} =>ExpandedURI q<d:Name>=>
96	wakaba	1.1	n3_literal $mod->{Name});
97	wakaba	1.2	$result->add_triple ($mod->{URI} =>ExpandedURI q<d:NameURI>=>
98			$mod->{NameURI});
99			$result->add_triple ($mod->{URI} =>ExpandedURI q<d:ModuleGroup>=>
100			$mod->{ModuleGroup});
101			$result->add_triple ($mod->{URI} =>ExpandedURI q<d:FileName>=>
102	wakaba	1.1	n3_literal $mod->{FileName})
103			if defined $mod->{FileName};
104	wakaba	1.2	$result->add_triple ($mod->{URI} =>ExpandedURI q<d:Namespace>=>
105			$mod->{Namespace});
106	wakaba	1.1	for (@{$mod->{require_module}\|\|[]}) {
107	wakaba	1.2	$result->add_triple ($mod->{URI} =>ExpandedURI q<d:Require>=> $_);
108			}
109			for (keys %{$mod->{For}}) {
110			$result->add_triple ($mod->{URI} =>ExpandedURI q<d:For>=> $_);
111			}
112	wakaba	1.4	for (@{$mod->{ISA}}) {
113	wakaba	1.2	$result->add_triple ($mod->{URI} =>ExpandedURI q<rdfs:subClassOf>=> $_);
114	wakaba	1.1	}
115	wakaba	1.4	if ($Opt{output_prop_perl}) {
116			$result->add_triple ($mod->{URI} =>ExpandedURI q<dis2pm:packageName>=>
117			n3_literal $mod->{ExpandedURI q<dis2pm:packageName>})
118			if defined $mod->{ExpandedURI q<dis2pm:packageName>};
119	wakaba	1.6	if ($Opt{output_resource}) {
120			for (values %{$mod->{ExpandedURI q<dis2pm:package>}}) {
121			my $uri = defined $_->{URI}
122			? $_->{URI}
123			: ($_->{ExpandedURI q<d:anonID>}
124			\|\|= $result->get_new_anon_id (Name => $_->{Name}));
125			$result->add_triple ($mod->{URI} =>ExpandedURI q<dis2pm:package>=>
126			$uri);
127			}
128			}
129	wakaba	1.4	}
130	wakaba	1.1	} else {
131	wakaba	1.2	$result->add_triple ($_ =>ExpandedURI q<owl:sameAs>=> $mod->{URI});
132	wakaba	1.1	}
133			}}
134
135			if ($Opt{output_for}) {
136			for (keys %{$State->{For}}) {
137			my $mod = $State->{For}->{$_};
138	wakaba	1.2	if ($_ eq $mod->{URI}) {
139			$result->add_triple ($mod->{URI} =>ExpandedURI q<rdf:type>=>
140			ExpandedURI q<d:For>);
141			$result->add_triple ($mod->{URI} =>ExpandedURI q<d:NameURI>=> $mod->{URI});
142			$result->add_triple ($mod->{URI} =>ExpandedURI q<d:FullName>=>
143	wakaba	1.5	n3_literal $mod->{FullName})
144			if defined $mod->{FullName};
145	wakaba	1.4	for (@{$mod->{ISA}}) {
146	wakaba	1.2	$result->add_triple ($mod->{URI} =>ExpandedURI q<rdfs:subClassOf>=> $_);
147	wakaba	1.1	}
148	wakaba	1.4	for (@{$mod->{Implement}}) {
149	wakaba	1.2	$result->add_triple ($mod->{URI} =>ExpandedURI q<d:Implement>=> $_);
150	wakaba	1.1	}
151			} else {
152	wakaba	1.2	$result->add_triple ($_ =>ExpandedURI q<owl:sameAs>=> $mod->{URI});
153	wakaba	1.1	}
154			}}
155
156	wakaba	1.3	if ($Opt{output_resource}) {
157	wakaba	1.2	sub class_to_rdf ($;%);
158			sub class_to_rdf ($;%) {
159			my ($mod, %opt) = @_;
160			return unless defined $mod->{Name};
161	wakaba	1.4	return unless $mod->{parentModule} =~ /$Opt{output_resource_pattern}/;
162	wakaba	1.7	return if $Opt{output_prop_perl} and
163			$mod->{ExpandedURI q<dis2pm:type>} and
164			{
165			ExpandedURI q<ManakaiDOM:DOMAttribute> => 1,
166			ExpandedURI q<ManakaiDOM:DOMMethod> => 1,
167			}->{$mod->{ExpandedURI q<dis2pm:type>}} and
168			$mod->{Name} and
169			$mod->{Name} !~ /$Opt{output_perl_member_pattern}/;
170	wakaba	1.2	if ((defined $mod->{URI} and $opt{key} eq $mod->{URI}) or
171			not defined $mod->{URI}) {
172	wakaba	1.4	return if defined $mod->{URI} and
173			$mod->{URI} !~ /$Opt{output_resource_uri_pattern}/;
174	wakaba	1.5	return if not defined $mod->{URI} and not $Opt{output_anon_resource};
175	wakaba	1.4	my $uri = defined $mod->{URI}
176			? $mod->{URI}
177	wakaba	1.5	: ($mod->{ExpandedURI q<d:anonID>}
178			\|\|= $result->get_new_anon_id (Name => $mod->{Name}));
179	wakaba	1.2	$result->add_triple ($uri =>ExpandedURI q<d:Name>=>
180			n3_literal $mod->{Name}) if length $mod->{Name};
181			$result->add_triple ($uri =>ExpandedURI q<d:NameURI>=> $mod->{NameURI})
182			if defined $mod->{NameURI};
183	wakaba	1.3	$result->add_triple ($uri =>ExpandedURI q<d:parentResource>=>
184	wakaba	1.2	$opt{parent_class_uri})
185			if defined $opt{parent_class_uri};
186	wakaba	1.7	if ($Opt{output_module}) {
187			$result->add_triple ($uri =>ExpandedURI q<d:parentModule>=>
188			$mod->{parentModule});
189			}
190	wakaba	1.2	for (keys %{$mod->{Type}}) {
191			$result->add_triple ($uri =>ExpandedURI q<rdf:type>=> $_);
192			}
193	wakaba	1.4	for (@{$mod->{ISA}}) {
194	wakaba	1.2	$result->add_triple ($uri =>ExpandedURI q<rdfs:subClassOf>=> $_);
195			}
196	wakaba	1.4	for (@{$mod->{Implement}}) {
197	wakaba	1.2	$result->add_triple ($uri =>ExpandedURI q<d:Implement>=> $_);
198			}
199	wakaba	1.7	if ($Opt{output_for}) {
200			for (keys %{$mod->{For}}) {
201			$result->add_triple ($uri =>ExpandedURI q<d:For>=> $_);
202			}
203	wakaba	1.5	}
204			for (@{$mod->{hasResource}\|\|[]}) {
205			my $ruri = defined $_->{URI}
206			? $_->{URI}
207			: ($_->{ExpandedURI q<d:anonID>}
208			\|\|= $result->get_new_anon_id (Name => $_->{Name}));
209			$result->add_triple ($uri =>ExpandedURI q<d:hasResource>=> $ruri);
210			}
211			if ($Opt{output_prop_perl}) {
212	wakaba	1.6	for my $prop ([ExpandedURI q<dis2pm:packageName>],
213			[ExpandedURI q<dis2pm:ifPackagePrefix>],
214			[ExpandedURI q<dis2pm:methodName>],
215	wakaba	1.7	[ExpandedURI q<dis2pm:paramName>],
216	wakaba	1.9	[ExpandedURI q<dis2pm:constGroupName>],
217			[ExpandedURI q<dis2pm:constName>],
218	wakaba	1.6	[ExpandedURI q<ManakaiDOM:isRedefining>,
219			ExpandedURI q<DOMMain:boolean>],
220			[ExpandedURI q<ManakaiDOM:isForInternal>,
221	wakaba	1.7	ExpandedURI q<DOMMain:boolean>],
222			[ExpandedURI q<d:Read>, ExpandedURI q<DOMMain:boolean>],
223			[ExpandedURI q<d:Write>,
224	wakaba	1.9	ExpandedURI q<DOMMain:boolean>],
225			[ExpandedURI q<dis2pm:undefable>,
226	wakaba	1.6	ExpandedURI q<DOMMain:boolean>]) {
227			$result->add_triple ($uri =>$prop->[0]=>
228			n3_literal $mod->{$prop->[0]})
229			if defined $mod->{$prop->[0]};
230			}
231	wakaba	1.7	for my $prop ([ExpandedURI q<d:Type>],
232	wakaba	1.8	[ExpandedURI q<d:actualType>]) {
233	wakaba	1.7	$result->add_triple ($uri =>$prop->[0]=> $mod->{$prop->[0]})
234			if defined $mod->{$prop->[0]};
235			}
236	wakaba	1.8	for my $prop ([ExpandedURI q<dis2pm:getter>],
237			[ExpandedURI q<dis2pm:setter>],
238			[ExpandedURI q<dis2pm:return>]) {
239			my $oo = $mod->{$prop->[0]};
240			if ($oo and defined $oo->{Name}) {
241			my $o = defined $oo->{URI}
242			? $oo->{URI}
243			: ($oo->{ExpandedURI q<d:anonID>}
244			\|\|= $result->get_new_anon_id (Name => $oo->{Name}));
245			$result->add_triple ($uri =>$prop->[0]=> $o)
246			}
247			}
248	wakaba	1.9	for my $p (ExpandedURI q<dis2pm:method>,
249			ExpandedURI q<dis2pm:constGroup>,
250			ExpandedURI q<dis2pm:const>) {
251			for my $v (values %{$mod->{$p}\|\|{}}) {
252			my $ruri = defined $v->{URI}
253			? $v->{URI}
254			: ($v->{ExpandedURI q<d:anonID>}
255			\|\|= $result->get_new_anon_id (Name => $v->{Name}));
256			$result->add_triple ($uri =>$p=> $ruri);
257			}
258	wakaba	1.5	}
259	wakaba	1.7	if ($mod->{ExpandedURI q<dis2pm:type>} eq
260			ExpandedURI q<ManakaiDOM:DOMMethod>) {
261			$result->add_triple
262			($uri =>ExpandedURI q<dis2pm:param>=>
263			my $p = $result->get_new_anon_id (Name => 'param'));
264			$result->add_triple ($uri =>ExpandedURI q<rdf:type>=>
265			ExpandedURI q<rdf:Seq>);
266			my $i = 0;
267			for (@{$mod->{ExpandedURI q<dis2pm:param>}\|\|[]}) {
268			my $ruri = defined $_->{URI}
269			? $_->{URI}
270			: ($_->{ExpandedURI q<d:anonID>}
271			\|\|= $result->get_new_anon_id (Name => $_->{Name}));
272			$result->add_triple ($p =>(ExpandedURI q<rdf:_>).++$i=> $ruri);
273			}
274			}
275	wakaba	1.5	}
276	wakaba	1.3	if ($Opt{output_local_resource}) {
277	wakaba	1.4	for (keys %{$mod->{Resource}}) {
278	wakaba	1.7	class_to_rdf ($mod->{Resource}->{$_}, %opt, parent_class => $mod,
279	wakaba	1.2	parent_class_uri => $uri,
280			key => $_);
281			}
282			}
283			} else { ## Alias URI
284	wakaba	1.7	return unless $opt{key} =~ /$Opt{output_resource_uri_pattern}/ or
285			$mod->{URI} =~ /$Opt{output_resource_uri_pattern}/;
286	wakaba	1.4	$result->add_triple ($opt{key} =>ExpandedURI q<owl:sameAs>=> $mod->{URI});
287	wakaba	1.1	}
288			}
289	wakaba	1.4	for (sort keys %{$State->{Type}}) {
290	wakaba	1.7	next if not $Opt{output_root_anon_resource} and
291			not defined $State->{Type}->{$_}->{URI};
292	wakaba	1.2	class_to_rdf ($State->{Type}->{$_}, key => $_);
293			}
294			}
295	wakaba	1.1
296	wakaba	1.4	if ($Opt{output_as_xml}) {
297			print $result->stringify_as_xml;
298			} else {
299			print $result->stringify;
300			}
301	wakaba	1.1
302			package manakai::n3;
303			sub new ($) {
304			bless {triple => [], anon => 0}, shift;
305			}
306
307	wakaba	1.4	sub get_new_anon_id ($;%) {
308			my ($self, %opt) = @_;
309			my $s = $opt{Name} ? $opt{Name} : '';
310			return sprintf '_:r%d%s', $self->{anon}++, $s;
311	wakaba	1.1	}
312
313			sub add_triple ($$$$) {
314			my ($self, $s =>$p=> $o) = @_;
315	wakaba	1.5	main::impl_err ("Subject undefined") unless defined $s;
316			main::impl_err ("Property undefined") unless defined $p;
317			main::impl_err ("Object undefined") unless defined $o;
318	wakaba	1.1	push @{$self->{triple}}, [$s =>$p=> $o];
319			}
320
321			sub stringify ($) {
322			my ($self) = @_;
323			return join "\n", (map {"$_."} map {
324			sprintf '%s %s %s', map {
325			$_ =~ /^[_"]/ ? $_ : "<$_>"
326			} @{$_}[0, 1, 2];
327			} @{$self->{triple}}), '';
328			}
329
330			sub stringify_as_xml ($) {
331			my ($self) = @_;
332			use RDF::Notation3::XML;
333			my $notation3 = RDF::Notation3::XML->new;
334	wakaba	1.7	my $n3 = $self->stringify;
335			my $rdf_ = ExpandedURI q<rdf:_>;
336	wakaba	1.8	$n3 =~ s{$rdf_}{ExpandedURI q<rdf:XXXX__dummy__XXXX>}ge;
337	wakaba	1.7	$notation3->parse_string ($n3);
338	wakaba	1.2	my $xml = $notation3->get_string;
339			$xml =~ s/\brdf:nodeID="_:/rdf:nodeID="/g;
340	wakaba	1.8	$xml =~ s/XXXX__dummy__XXXX/_/g;
341	wakaba	1.2	# $xml =~ s/^<\?xml version="1.0" encoding="utf-8"\?>\s*//;
342			$xml;
343	wakaba	1.1	}
344
345			1;
346
347			__END__
348
349			=head1 NAME
350
351			dis2rdf.pl - dis to RDF converter
352
353			=head1 SYNOPSIS
354
355			$ perl dis2rdf.pl input.dis [options...] > output.rdf
356
357			=head1 DESCRIPTION
358
359			This script generates a RDF graph from a "dis" file.
360
361			=over 4
362
363			=item I<input.dis>
364
365			The "dis" file from which a RDF graph is generated.
366
367			=item I<output.rdf>
368
369			An RDF/XML entity is outputed.
370
371			=item C<--output-module>
372
373			Show the relationship of modules.
374
375			=item C<--output-type>
376
377			Show the relationship of types.
378
379			=item C<--output-for>
380
381			Show the relationship of "for"s.
382
383			=cut
384
385			=head1 LICENSE
386
387			Copyright 2004 Wakaba <w@suika.fam.cx>. All rights reserved.
388
389			This program is free software; you can redistribute it and/or
390			modify it under the same terms as Perl itself.
391
392			Note that the copyright holder(s) of this script does not claim
393			any rights for materials outputed by this script, although
394			some of its part comes from this script. The copyright
395			holder(s) of source document should define their license terms.
396
397			=cut