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#>,
  infoset => q<http://www.w3.org/2001/04/infoset#>,
  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#>,
  MDOM_EXCEPTION => q<http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#>,
  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#>,
  xml => q<http://www.w3.org/XML/1998/namespace>,
  xmlns => q<http://www.w3.org/2000/xmlns/>,
  xsd => q<http://www.w3.org/2001/XMLSchema#>,
};

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