manakai/bin/dac2pm.pl

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

=head1 NAME

cdis2pm - Generating Perl Module from a Compiled "dis"

=head1 SYNOPSIS

  perl path/to/cdis2pm.pl input.cdis \
            {--module-name=ModuleName | --module-uri=module-uri} \
            [--for=for-uri] [options] > ModuleName.pm
  perl path/to/cdis2pm.pl --help

=head1 DESCRIPTION

The C<cdis2pm> script generates a Perl module from a compiled "dis"
("cdis") file.  It is intended to be used to generate a manakai 
DOM Perl module files, although it might be useful for other purpose. 

This script is part of manakai. 

=cut

use strict;
use Message::DOM::DOMMetaImpl;
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/>,
};
use Message::Util::DIS;
use Message::Util::PerlCode;

=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, if any, or the C<ManakaiDOM:all> is assumed. 

=item --help

Shows the help message. 

=item --module-name=I<ModuleName>

The name of module to output.  It is the local name part of 
the C<Module> C<QName> in the source "dis" file.  Either 
C<--module-name> or C<--module-uri> is required. 

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

A URI reference that identifies a module to output.  Either 
C<--module-name> or C<--module-uri> is required. 

=item --output-module-version (default) / --nooutput-module-version

Whether the C<$VERSION> special variable should be generated or not. 

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

Whether a verbose message mode should be selected or not. 

=back

=cut

use Getopt::Long;
use Pod::Usage;
use Storable;
my %Opt;
GetOptions (
  'enable-assertion!' => \$Opt{outputAssertion},
  'for=s' => \$Opt{For},
  'help' => \$Opt{help},
  'implementation-registry-package=s' => \$Opt{implreg_pack},
  'module-uri=s' => \$Opt{module_uri},
  'output-module-version!' => \$Opt{outputModuleVersion},
  '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:
$Opt{outputModuleVersion} = 1 unless defined $Opt{outputModuleVersion};

## TODO: Assertion control

## TODO: Verbose mode

$Opt{implreg_pack} ||= $Message::DOM::DOMImplementationRegistry;
if ($Opt{implreg_pack} eq
    'Message::DOM::DOMMetaImpl::ManakaiDOMImplementationRegistryCompat') {
  unshift @Message::Markup::SuikaWikiConfig21::ManakaiSWCFGImplementation::ISA,
          'Message::DOM::DOMMetaImpl::ManakaiDOMMinimumImplementationCompat';
}

my $impl = $Opt{implreg_pack}->get_dom_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');

my $db = $di->pl_load_dis_database ($Opt{file_name});

my $mod = $db->get_module ($Opt{module_uri}, for_arg => $Opt{For});
unless ($Opt{For}) {
  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;

$db->check_undefined_resource;

print $pl->stringify;

=head1 SEE ALSO

L<lib/manakai/dis.pl> and L<bin/cdis2pm.pl> - Old version of 
this script.

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. 

=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/04/28 15:22:59 $
1	wakaba	1.1	#!/usr/bin/perl -w
2			use strict;
3
4			=head1 NAME
5
6			cdis2pm - Generating Perl Module from a Compiled "dis"
7
8			=head1 SYNOPSIS
9
10			perl path/to/cdis2pm.pl input.cdis \
11			{--module-name=ModuleName \| --module-uri=module-uri} \
12			[--for=for-uri] [options] > ModuleName.pm
13			perl path/to/cdis2pm.pl --help
14
15			=head1 DESCRIPTION
16
17			The C<cdis2pm> script generates a Perl module from a compiled "dis"
18			("cdis") file. It is intended to be used to generate a manakai
19			DOM Perl module files, although it might be useful for other purpose.
20
21			This script is part of manakai.
22
23			=cut
24
25			use strict;
26			use Message::DOM::DOMMetaImpl;
27			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			use Message::Util::DIS;
55			use Message::Util::PerlCode;
56
57			=head1 OPTIONS
58
59			=over 4
60
61			=item --enable-assertion / --noenable-assertion (default)
62
63			Whether assertion codes should be outputed or not.
64
65			=item --for=I<for-uri> (Optional)
66
67			Specifies the "For" URI reference for which the outputed module is.
68			If this parameter is ommitted, the default "For" URI reference
69			for the module, if any, or the C<ManakaiDOM:all> is assumed.
70
71			=item --help
72
73			Shows the help message.
74
75			=item --module-name=I<ModuleName>
76
77			The name of module to output. It is the local name part of
78			the C<Module> C<QName> in the source "dis" file. Either
79			C<--module-name> or C<--module-uri> is required.
80
81			=item --module-uri=I<module-uri>
82
83			A URI reference that identifies a module to output. Either
84			C<--module-name> or C<--module-uri> is required.
85
86			=item --output-module-version (default) / --nooutput-module-version
87
88			Whether the C<$VERSION> special variable should be generated or not.
89
90			=item --verbose / --noverbose (default)
91
92			Whether a verbose message mode should be selected or not.
93
94			=back
95
96			=cut
97
98			use Getopt::Long;
99			use Pod::Usage;
100			use Storable;
101			my %Opt;
102			GetOptions (
103			'enable-assertion!' => \$Opt{outputAssertion},
104			'for=s' => \$Opt{For},
105			'help' => \$Opt{help},
106	wakaba	1.2	'implementation-registry-package=s' => \$Opt{implreg_pack},
107	wakaba	1.1	'module-uri=s' => \$Opt{module_uri},
108			'output-module-version!' => \$Opt{outputModuleVersion},
109			'verbose!' => $Opt{verbose},
110			) or pod2usage (2);
111			pod2usage ({-exitval => 0, -verbose => 1}) if $Opt{help};
112			$Opt{file_name} = shift;
113			pod2usage ({-exitval => 2, -verbose => 0}) unless $Opt{file_name};
114			pod2usage (2) unless $Opt{module_uri};
115
116			## TODO:
117			$Opt{outputModuleVersion} = 1 unless defined $Opt{outputModuleVersion};
118
119			## TODO: Assertion control
120
121			## TODO: Verbose mode
122
123	wakaba	1.2	$Opt{implreg_pack} \|\|= $Message::DOM::DOMImplementationRegistry;
124			if ($Opt{implreg_pack} eq
125			'Message::DOM::DOMMetaImpl::ManakaiDOMImplementationRegistryCompat') {
126			unshift @Message::Markup::SuikaWikiConfig21::ManakaiSWCFGImplementation::ISA,
127			'Message::DOM::DOMMetaImpl::ManakaiDOMMinimumImplementationCompat';
128			}
129
130			my $impl = $Opt{implreg_pack}->get_dom_implementation
131	wakaba	1.1	({
132			ExpandedURI q<ManakaiDOM:Minimum> => '3.0',
133			'+' . ExpandedURI q<DIS:Core> => '1.0',
134			'+' . ExpandedURI q<Util:PerlCode> => '1.0',
135			});
136			my $pc = $impl->get_feature (ExpandedURI q<Util:PerlCode> => '1.0');
137			my $di = $impl->get_feature (ExpandedURI q<DIS:Core> => '1.0');
138
139			my $db = $di->pl_load_dis_database ($Opt{file_name});
140
141			my $mod = $db->get_module ($Opt{module_uri}, for_arg => $Opt{For});
142			unless ($Opt{For}) {
143			my $el = $mod->source_element;
144			if ($el) {
145			$Opt{For} = $el->default_for_uri;
146			$mod = $db->get_module ($Opt{module_uri}, for_arg => $Opt{For});
147			}
148			}
149			unless ($mod->is_defined) {
150			die qq<$0: Module <$Opt{module_uri}> for <$Opt{For}> is not defined>;
151			}
152
153			my $pl = $mod->pl_generate_perl_module_file;
154
155			$db->check_undefined_resource;
156
157			print $pl->stringify;
158
159			=head1 SEE ALSO
160
161			L<lib/manakai/dis.pl> and L<bin/cdis2pm.pl> - Old version of
162			this script.
163
164			L<lib/Message/Util/DIS.dis> - The <QUOTE::dis> object implementation.
165
166			L<lib/Message/Util/PerlCode.dis> - The Perl code generator.
167
168			L<lib/manakai/DISCore.dis> - The definition for the "dis" format.
169
170			L<lib/manakai/DISPerl.dis> - The definition for the "dis" Perl-specific
171			vocabulary.
172
173			=head1 LICENSE
174
175			Copyright 2004-2005 Wakaba <w@suika.fam.cx>. All rights reserved.
176
177			This program is free software; you can redistribute it and/or
178			modify it under the same terms as Perl itself.
179
180			=cut
181
182	wakaba	1.2	1; # $Date: 2005/04/28 15:22:59 $