manakai/bin/dac2pm.pl

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

=head1 NAME

dac2pm - Generating Perl Module from "dac" File

=head1 SYNOPSIS

  perl path/to/dac2pm.pl input.dac \
            --module-uri=module-uri [--for=for-uri] [options] > ModuleName.pm
  perl path/to/dac2pm.pl input.dac \
            --module-uri=module-uri [--for=for-uri] [options] \
            --output-file-path=ModuleName.pm
  perl path/to/dac2pm.pl --help

=head1 DESCRIPTION

The C<dac2pm> script generates a Perl module from a "dac" file.

This script is part of manakai. 

=cut

use strict;
use Message::Util::DIS;
use Message::Util::QName::Filter {
  DIS => q<http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#>,
  dis => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis-->,
  dis2pm => q<http://suika.fam.cx/~wakaba/archive/2004/11/8/dis2pm#>,
  DISCore => q<http://suika.fam.cx/~wakaba/archive/2004/dis/Core#>,
  DISLang => q<http://suika.fam.cx/~wakaba/archive/2004/dis/Lang#>,
  DISPerl => q<http://suika.fam.cx/~wakaba/archive/2004/dis/Perl#>,
  disPerl => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--Perl-->,
  DOMCore => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#>,
  DOMEvents => q<http://suika.fam.cx/~wakaba/archive/2004/dom/events#>,
  DOMMain => q<http://suika.fam.cx/~wakaba/archive/2004/dom/main#>,
  DOMXML => q<http://suika.fam.cx/~wakaba/archive/2004/dom/xml#>,
  DX => q<http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#>,
  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#>,
  Markup => q<http://suika.fam.cx/~wakaba/archive/2005/manakai/Markup#>,
  MDOMX => q<http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#>,
  owl => q<http://www.w3.org/2002/07/owl#>,
  pc => q<http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/PerlCode#>,
  rdf => q<http://www.w3.org/1999/02/22-rdf-syntax-ns#>,
  rdfs => q<http://www.w3.org/2000/01/rdf-schema#>,
  swcfg21 => q<http://suika.fam.cx/~wakaba/archive/2005/swcfg21#>,
  TreeCore => q<>,
  Util => q<http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/>,
};

=head1 OPTIONS

=over 4

=item --enable-assertion / --noenable-assertion (default)

Whether assertion codes should be outputed or not. 

=item --for=I<for-uri> (Optional)

Specifies the "For" URI reference for which the outputed module is. 
If this parameter is ommitted, the default "For" URI reference 
for the module specified by the C<dis:DefaultFor> attribute
of the C<dis:Module> element, if any, or C<ManakaiDOM:all> is assumed. 

=item --help

Shows the help message. 

=item --module-uri=I<module-uri>

A URI reference that identifies a module from which a Perl
module file is generated.  This argument is I<required>.

=item --output-file-path=I<perl-module-file-path> (default: the standard output)

A platform-dependent file path to which the Perl module
is written down.

=item --verbose / --noverbose (default)

Whether a verbose message mode should be selected or not. 

=back

=cut

use Getopt::Long;
use Pod::Usage;
my %Opt;
GetOptions (
  'enable-assertion!' => \$Opt{outputAssertion},
  'for=s' => \$Opt{For},
  'help' => \$Opt{help},
  'module-uri=s' => \$Opt{module_uri},
  'output-file-path=s' => \$Opt{output_file_name},
  'verbose!' => $Opt{verbose},
) or pod2usage (2);
pod2usage ({-exitval => 0, -verbose => 1}) if $Opt{help};
$Opt{file_name} = shift;
pod2usage ({-exitval => 2, -verbose => 0}) unless $Opt{file_name};
pod2usage (2) unless $Opt{module_uri};

## TODO: Assertion control

## TODO: Verbose mode

my $impl = $Message::DOM::ImplementationRegistry->get_implementation
               ({
                 ExpandedURI q<ManakaiDOM:Minimum> => '3.0',
                 '+' . ExpandedURI q<DIS:Core> => '1.0',
                 '+' . ExpandedURI q<Util:PerlCode> => '1.0',
                });
my $pc = $impl->get_feature (ExpandedURI q<Util:PerlCode> => '1.0');
my $di = $impl->get_feature (ExpandedURI q<DIS:Core> => '1.0');

print STDERR qq<Loading the database "$Opt{file_name}"...>;
my $db = $di->pl_load_dis_database ($Opt{file_name});
print STDERR "done\n";

my $mod = $db->get_module ($Opt{module_uri}, for_arg => $Opt{For});
unless ($Opt{For}) {
  $Opt{For} = $mod->get_property_text (ExpandedURI q<dis:DefaultFor>, undef);
  if (defined $Opt{For}) {
    $mod = $db->get_module ($Opt{module_uri}, for_arg => $Opt{For});
  } else {
    my $el = $mod->source_element;
    if ($el) {
      $Opt{For} = $el->default_for_uri;
      $mod = $db->get_module ($Opt{module_uri}, for_arg => $Opt{For});
    }
  }
}
unless ($mod->is_defined) {
  die qq<$0: Module <$Opt{module_uri}> for <$Opt{For}> is not defined>;
}

my $pl = $mod->pl_generate_perl_module_file;

my $output;
defined $Opt{output_file_name} 
      ? (open $output, '>', $Opt{output_file_name}
           or die "$0: $Opt{output_file_name}: $!")
      : ($output = \*STDOUT);

printf STDERR qq<Writing file "%s"...>,
  defined $Opt{output_file_name} ? $Opt{output_file_name} : '';
print $output $pl->stringify;
close $output;
print STDERR "done\n";

print STDERR "Checking undefined resources...";
$db->check_undefined_resource;
print STDERR "done\n";

print STDERR "Closing the database...";
$db->free;
print STDERR "done\n";

=head1 SEE ALSO

L<lib/Message/Util/DIS.dis> - The <QUOTE::dis> object implementation.

L<lib/Message/Util/PerlCode.dis> - The Perl code generator.

L<lib/manakai/DISCore.dis> - The definition for the "dis" format. 

L<lib/manakai/DISPerl.dis> - The definition for the "dis" Perl-specific 
vocabulary. 

L<bin/dac.pl> - The "dac" database generator.

=head1 LICENSE

Copyright 2004-2005 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.

=cut

1; # $Date: 2005/09/09 04:26:04 $
1	wakaba	1.1	#!/usr/bin/perl -w
2			use strict;
3
4			=head1 NAME
5
6	wakaba	1.5	dac2pm - Generating Perl Module from "dac" File
7	wakaba	1.1
8			=head1 SYNOPSIS
9
10	wakaba	1.5	perl path/to/dac2pm.pl input.dac \
11			--module-uri=module-uri [--for=for-uri] [options] > ModuleName.pm
12			perl path/to/dac2pm.pl input.dac \
13			--module-uri=module-uri [--for=for-uri] [options] \
14			--output-file-path=ModuleName.pm
15			perl path/to/dac2pm.pl --help
16	wakaba	1.1
17			=head1 DESCRIPTION
18
19	wakaba	1.5	The C<dac2pm> script generates a Perl module from a "dac" file.
20	wakaba	1.1
21			This script is part of manakai.
22
23			=cut
24
25			use strict;
26	wakaba	1.5	use Message::Util::DIS;
27	wakaba	1.1	use Message::Util::QName::Filter {
28			DIS => q<http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#>,
29			dis => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis-->,
30			dis2pm => q<http://suika.fam.cx/~wakaba/archive/2004/11/8/dis2pm#>,
31			DISCore => q<http://suika.fam.cx/~wakaba/archive/2004/dis/Core#>,
32			DISLang => q<http://suika.fam.cx/~wakaba/archive/2004/dis/Lang#>,
33			DISPerl => q<http://suika.fam.cx/~wakaba/archive/2004/dis/Perl#>,
34			disPerl => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--Perl-->,
35			DOMCore => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#>,
36			DOMEvents => q<http://suika.fam.cx/~wakaba/archive/2004/dom/events#>,
37			DOMMain => q<http://suika.fam.cx/~wakaba/archive/2004/dom/main#>,
38			DOMXML => q<http://suika.fam.cx/~wakaba/archive/2004/dom/xml#>,
39			DX => q<http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#>,
40			lang => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#>,
41			Perl => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#Perl-->,
42			license => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/license#>,
43			ManakaiDOM => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#>,
44			Markup => q<http://suika.fam.cx/~wakaba/archive/2005/manakai/Markup#>,
45			MDOMX => q<http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#>,
46			owl => q<http://www.w3.org/2002/07/owl#>,
47			pc => q<http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/PerlCode#>,
48			rdf => q<http://www.w3.org/1999/02/22-rdf-syntax-ns#>,
49			rdfs => q<http://www.w3.org/2000/01/rdf-schema#>,
50			swcfg21 => q<http://suika.fam.cx/~wakaba/archive/2005/swcfg21#>,
51			TreeCore => q<>,
52			Util => q<http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/>,
53			};
54
55			=head1 OPTIONS
56
57			=over 4
58
59			=item --enable-assertion / --noenable-assertion (default)
60
61			Whether assertion codes should be outputed or not.
62
63			=item --for=I<for-uri> (Optional)
64
65			Specifies the "For" URI reference for which the outputed module is.
66			If this parameter is ommitted, the default "For" URI reference
67	wakaba	1.5	for the module specified by the C<dis:DefaultFor> attribute
68			of the C<dis:Module> element, if any, or C<ManakaiDOM:all> is assumed.
69	wakaba	1.1
70			=item --help
71
72			Shows the help message.
73
74			=item --module-uri=I<module-uri>
75
76	wakaba	1.5	A URI reference that identifies a module from which a Perl
77			module file is generated. This argument is I<required>.
78	wakaba	1.4
79	wakaba	1.5	=item --output-file-path=I<perl-module-file-path> (default: the standard output)
80	wakaba	1.1
81	wakaba	1.5	A platform-dependent file path to which the Perl module
82			is written down.
83	wakaba	1.1
84			=item --verbose / --noverbose (default)
85
86			Whether a verbose message mode should be selected or not.
87
88			=back
89
90			=cut
91
92			use Getopt::Long;
93			use Pod::Usage;
94			my %Opt;
95			GetOptions (
96			'enable-assertion!' => \$Opt{outputAssertion},
97			'for=s' => \$Opt{For},
98			'help' => \$Opt{help},
99			'module-uri=s' => \$Opt{module_uri},
100	wakaba	1.4	'output-file-path=s' => \$Opt{output_file_name},
101	wakaba	1.1	'verbose!' => $Opt{verbose},
102			) or pod2usage (2);
103			pod2usage ({-exitval => 0, -verbose => 1}) if $Opt{help};
104			$Opt{file_name} = shift;
105			pod2usage ({-exitval => 2, -verbose => 0}) unless $Opt{file_name};
106			pod2usage (2) unless $Opt{module_uri};
107
108			## TODO: Assertion control
109
110			## TODO: Verbose mode
111
112	wakaba	1.5	my $impl = $Message::DOM::ImplementationRegistry->get_implementation
113	wakaba	1.1	({
114			ExpandedURI q<ManakaiDOM:Minimum> => '3.0',
115			'+' . ExpandedURI q<DIS:Core> => '1.0',
116			'+' . ExpandedURI q<Util:PerlCode> => '1.0',
117			});
118			my $pc = $impl->get_feature (ExpandedURI q<Util:PerlCode> => '1.0');
119			my $di = $impl->get_feature (ExpandedURI q<DIS:Core> => '1.0');
120
121	wakaba	1.6	print STDERR qq<Loading the database "$Opt{file_name}"...>;
122	wakaba	1.1	my $db = $di->pl_load_dis_database ($Opt{file_name});
123	wakaba	1.5	print STDERR "done\n";
124	wakaba	1.1
125			my $mod = $db->get_module ($Opt{module_uri}, for_arg => $Opt{For});
126			unless ($Opt{For}) {
127	wakaba	1.6	$Opt{For} = $mod->get_property_text (ExpandedURI q<dis:DefaultFor>, undef);
128			if (defined $Opt{For}) {
129	wakaba	1.1	$mod = $db->get_module ($Opt{module_uri}, for_arg => $Opt{For});
130	wakaba	1.6	} else {
131			my $el = $mod->source_element;
132			if ($el) {
133			$Opt{For} = $el->default_for_uri;
134			$mod = $db->get_module ($Opt{module_uri}, for_arg => $Opt{For});
135			}
136	wakaba	1.1	}
137			}
138			unless ($mod->is_defined) {
139			die qq<$0: Module <$Opt{module_uri}> for <$Opt{For}> is not defined>;
140			}
141
142			my $pl = $mod->pl_generate_perl_module_file;
143
144	wakaba	1.4	my $output;
145			defined $Opt{output_file_name}
146			? (open $output, '>', $Opt{output_file_name}
147			or die "$0: $Opt{output_file_name}: $!")
148			: ($output = \*STDOUT);
149
150	wakaba	1.5	printf STDERR qq<Writing file "%s"...>,
151			defined $Opt{output_file_name} ? $Opt{output_file_name} : '';
152	wakaba	1.4	print $output $pl->stringify;
153	wakaba	1.5	close $output;
154			print STDERR "done\n";
155	wakaba	1.3
156	wakaba	1.5	print STDERR "Checking undefined resources...";
157	wakaba	1.1	$db->check_undefined_resource;
158	wakaba	1.5	print STDERR "done\n";
159
160			print STDERR "Closing the database...";
161			$db->free;
162			print STDERR "done\n";
163	wakaba	1.1
164			=head1 SEE ALSO
165
166			L<lib/Message/Util/DIS.dis> - The <QUOTE::dis> object implementation.
167
168			L<lib/Message/Util/PerlCode.dis> - The Perl code generator.
169
170			L<lib/manakai/DISCore.dis> - The definition for the "dis" format.
171
172			L<lib/manakai/DISPerl.dis> - The definition for the "dis" Perl-specific
173			vocabulary.
174
175	wakaba	1.5	L<bin/dac.pl> - The "dac" database generator.
176
177	wakaba	1.1	=head1 LICENSE
178
179			Copyright 2004-2005 Wakaba <w@suika.fam.cx>. All rights reserved.
180
181			This program is free software; you can redistribute it and/or
182			modify it under the same terms as Perl itself.
183
184			=cut
185
186	wakaba	1.6	1; # $Date: 2005/09/09 04:26:04 $