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 input.dac \
            --create-perl-module="module-uri ModuleName.pm [for-uri]" \
            [--create-perl-module="..." ...]
  perl path/to/dac2pm.pl --help

=head1 DESCRIPTION

The C<dac2pm.pl> script generates Perl modules from a "dac" database file
created by C<dac.pl>.

This script is part of manakai. 

=cut

use strict;
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-->,
  ManakaiDOM => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#>,
  Markup => q<http://suika.fam.cx/~wakaba/archive/2005/manakai/Markup#>,
  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 --create-perl-module="I<module-uri> I<ModuleName.pm> [I<for-uri>]" (Zero or more)

The C<--create-perl-module> option can be used to specify
I<--module-uri>, I<--output-file-path>, and I<--for> options
once.  Its value is a space-separated triplet of "dis" module name URI,
Perl module file path (environment dependent), and optional
"dis" module "for" URI.

This option can be specified more than once; it would
make multiple Perl module files to be created.  If 
both I<--module-uri> and this options are specified,
I<--module-uri>, I<--output-file-path>, and I<--for>
options are treated as if there is another I<--create-perl-module>
option specified.

=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 = (
  create_module => [],
);
GetOptions (
  'create-perl-module=s' => sub {
    shift;
    push @{$Opt{create_module}}, [split /\s+/, shift, 3];
  },
  '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};

if ($Opt{module_uri}) {
  push @{$Opt{create_module}},
       [$Opt{module_uri}, $Opt{output_file_name}, $Opt{For}];
}

pod2usage (2) unless @{$Opt{create_module}};

sub status_msg ($) {
  my $s = shift;
  $s .= "\n" unless $s =~ /\n$/;
  print STDERR $s;
}

sub status_msg_ ($) {
  my $s = shift;
  print STDERR $s;
}

sub verbose_msg ($) {
  my $s = shift;
  $s .= "\n" unless $s =~ /\n$/;
  print STDERR $s if $Opt{verbose};
}

sub verbose_msg_ ($) {
  my $s = shift;
  print STDERR $s if $Opt{verbose};
}

## TODO: Assertion control

use Message::Util::DIS::DNLite;

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');

status_msg_ qq<Loading the database "$Opt{file_name}"...>;
my $db = $di->pl_load_dis_database ($Opt{file_name});
status_msg q<done>;

for (@{$Opt{create_module}}) {
  my ($mod_uri, $out_file_path, $mod_for) = @$_;
  
  my $mod = $db->get_module ($mod_uri, for_arg => $mod_for);
  unless ($mod_for) {
    $mod_for = $mod->get_property_text (ExpandedURI q<dis:DefaultFor>, undef);
    if (defined $mod_for) {
      $mod = $db->get_module ($mod_uri, for_arg => $mod_for);
    }
  }
  unless ($mod->is_defined) {
    die qq<$0: Module <$mod_uri> for <$mod_for> is not defined>;
  }

  status_msg_ qq<Generating Perl module from <$mod_uri> for <$mod_for>...>;
  my $pl = $mod->pl_generate_perl_module_file;
  status_msg qq<done>;
  
  my $output;
  defined $out_file_path
      ? (open $output, '>', $out_file_path or die "$0: $out_file_path: $!")
      : ($output = \*STDOUT);
  
  status_msg_ sprintf qq<Writing Perl module %s...>,
                      defined $out_file_path
                        ? q<">.$out_file_path.q<">
                        : 'to stdout';
  print $output $pl->stringify;
  close $output;
  status_msg q<done>;
} # create_module

status_msg_ "Checking undefined resources...";
$db->check_undefined_resource;
status_msg q<done>;

status_msg_ "Closing the database...";
$db->free;
undef $db;
status_msg q<done>;

=head1 SEE ALSO

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

L<lib/Message/Util/DIS/Perl.dis> - The <QUOTE::dis> object implementation,
submodule for Perl modules.

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/19 16:17:50 $
1	#!/usr/bin/perl -w
2	use strict;
3
4	=head1 NAME
5
6	dac2pm - Generating Perl Module from "dac" File
7
8	=head1 SYNOPSIS
9
10	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 input.dac \
16	--create-perl-module="module-uri ModuleName.pm [for-uri]" \
17	[--create-perl-module="..." ...]
18	perl path/to/dac2pm.pl --help
19
20	=head1 DESCRIPTION
21
22	The C<dac2pm.pl> script generates Perl modules from a "dac" database file
23	created by C<dac.pl>.
24
25	This script is part of manakai.
26
27	=cut
28
29	use strict;
30	use Message::Util::QName::Filter {
31	DIS => q<http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#>,
32	dis => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis-->,
33	ManakaiDOM => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#>,
34	Markup => q<http://suika.fam.cx/~wakaba/archive/2005/manakai/Markup#>,
35	Util => q<http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/>,
36	};
37
38	=head1 OPTIONS
39
40	=over 4
41
42	=item --enable-assertion / --noenable-assertion (default)
43
44	Whether assertion codes should be outputed or not.
45
46	=item --create-perl-module="I<module-uri> I<ModuleName.pm> [I<for-uri>]" (Zero or more)
47
48	The C<--create-perl-module> option can be used to specify
49	I<--module-uri>, I<--output-file-path>, and I<--for> options
50	once. Its value is a space-separated triplet of "dis" module name URI,
51	Perl module file path (environment dependent), and optional
52	"dis" module "for" URI.
53
54	This option can be specified more than once; it would
55	make multiple Perl module files to be created. If
56	both I<--module-uri> and this options are specified,
57	I<--module-uri>, I<--output-file-path>, and I<--for>
58	options are treated as if there is another I<--create-perl-module>
59	option specified.
60
61	=item --for=I<for-uri> (Optional)
62
63	Specifies the "For" URI reference for which the outputed module is.
64	If this parameter is ommitted, the default "For" URI reference
65	for the module specified by the C<dis:DefaultFor> attribute
66	of the C<dis:Module> element, if any, or C<ManakaiDOM:all> is assumed.
67
68	=item --help
69
70	Shows the help message.
71
72	=item --module-uri=I<module-uri>
73
74	A URI reference that identifies a module from which a Perl
75	module file is generated. This argument is I<required>.
76
77	=item --output-file-path=I<perl-module-file-path> (default: the standard output)
78
79	A platform-dependent file path to which the Perl module
80	is written down.
81
82	=item --verbose / --noverbose (default)
83
84	Whether a verbose message mode should be selected or not.
85
86	=back
87
88	=cut
89
90	use Getopt::Long;
91	use Pod::Usage;
92	my %Opt = (
93	create_module => [],
94	);
95	GetOptions (
96	'create-perl-module=s' => sub {
97	shift;
98	push @{$Opt{create_module}}, [split /\s+/, shift, 3];
99	},
100	'enable-assertion!' => \$Opt{outputAssertion},
101	'for=s' => \$Opt{For},
102	'help' => \$Opt{help},
103	'module-uri=s' => \$Opt{module_uri},
104	'output-file-path=s' => \$Opt{output_file_name},
105	'verbose!' => $Opt{verbose},
106	) or pod2usage (2);
107	pod2usage ({-exitval => 0, -verbose => 1}) if $Opt{help};
108	$Opt{file_name} = shift;
109	pod2usage ({-exitval => 2, -verbose => 0}) unless $Opt{file_name};
110
111	if ($Opt{module_uri}) {
112	push @{$Opt{create_module}},
113	[$Opt{module_uri}, $Opt{output_file_name}, $Opt{For}];
114	}
115
116	pod2usage (2) unless @{$Opt{create_module}};
117
118	sub status_msg ($) {
119	my $s = shift;
120	$s .= "\n" unless $s =~ /\n$/;
121	print STDERR $s;
122	}
123
124	sub status_msg_ ($) {
125	my $s = shift;
126	print STDERR $s;
127	}
128
129	sub verbose_msg ($) {
130	my $s = shift;
131	$s .= "\n" unless $s =~ /\n$/;
132	print STDERR $s if $Opt{verbose};
133	}
134
135	sub verbose_msg_ ($) {
136	my $s = shift;
137	print STDERR $s if $Opt{verbose};
138	}
139
140	## TODO: Assertion control
141
142	use Message::Util::DIS::DNLite;
143
144	my $impl = $Message::DOM::ImplementationRegistry->get_implementation
145	({
146	ExpandedURI q<ManakaiDOM:Minimum> => '3.0',
147	'+' . ExpandedURI q<DIS:Core> => '1.0',
148	'+' . ExpandedURI q<Util:PerlCode> => '1.0',
149	});
150	my $pc = $impl->get_feature (ExpandedURI q<Util:PerlCode> => '1.0');
151	my $di = $impl->get_feature (ExpandedURI q<DIS:Core> => '1.0');
152
153	status_msg_ qq<Loading the database "$Opt{file_name}"...>;
154	my $db = $di->pl_load_dis_database ($Opt{file_name});
155	status_msg q<done>;
156
157	for (@{$Opt{create_module}}) {
158	my ($mod_uri, $out_file_path, $mod_for) = @$_;
159
160	my $mod = $db->get_module ($mod_uri, for_arg => $mod_for);
161	unless ($mod_for) {
162	$mod_for = $mod->get_property_text (ExpandedURI q<dis:DefaultFor>, undef);
163	if (defined $mod_for) {
164	$mod = $db->get_module ($mod_uri, for_arg => $mod_for);
165	}
166	}
167	unless ($mod->is_defined) {
168	die qq<$0: Module <$mod_uri> for <$mod_for> is not defined>;
169	}
170
171	status_msg_ qq<Generating Perl module from <$mod_uri> for <$mod_for>...>;
172	my $pl = $mod->pl_generate_perl_module_file;
173	status_msg qq<done>;
174
175	my $output;
176	defined $out_file_path
177	? (open $output, '>', $out_file_path or die "$0: $out_file_path: $!")
178	: ($output = \*STDOUT);
179
180	status_msg_ sprintf qq<Writing Perl module %s...>,
181	defined $out_file_path
182	? q<">.$out_file_path.q<">
183	: 'to stdout';
184	print $output $pl->stringify;
185	close $output;
186	status_msg q<done>;
187	} # create_module
188
189	status_msg_ "Checking undefined resources...";
190	$db->check_undefined_resource;
191	status_msg q<done>;
192
193	status_msg_ "Closing the database...";
194	$db->free;
195	undef $db;
196	status_msg q<done>;
197
198	=head1 SEE ALSO
199
200	L<lib/Message/Util/DIS.dis> - The <QUOTE::dis> object implementation.
201
202	L<lib/Message/Util/DIS/Perl.dis> - The <QUOTE::dis> object implementation,
203	submodule for Perl modules.
204
205	L<lib/Message/Util/PerlCode.dis> - The Perl code generator.
206
207	L<lib/manakai/DISCore.dis> - The definition for the "dis" format.
208
209	L<lib/manakai/DISPerl.dis> - The definition for the "dis" Perl-specific
210	vocabulary.
211
212	L<bin/dac.pl> - The "dac" database generator.
213
214	=head1 LICENSE
215
216	Copyright 2004-2005 Wakaba <w@suika.fam.cx>. All rights reserved.
217
218	This program is free software; you can redistribute it and/or
219	modify it under the same terms as Perl itself.
220
221	=cut
222
223	1; # $Date: 2005/09/19 16:17:50 $