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	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	wakaba	1.8	perl path/to/dac2pm.pl input.dac \
16			--create-perl-module="module-uri ModuleName.pm [for-uri]" \
17			[--create-perl-module="..." ...]
18	wakaba	1.5	perl path/to/dac2pm.pl --help
19	wakaba	1.1
20			=head1 DESCRIPTION
21
22	wakaba	1.8	The C<dac2pm.pl> script generates Perl modules from a "dac" database file
23			created by C<dac.pl>.
24	wakaba	1.1
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	wakaba	1.8	=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	wakaba	1.1	=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	wakaba	1.5	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	wakaba	1.1
68			=item --help
69
70			Shows the help message.
71
72			=item --module-uri=I<module-uri>
73
74	wakaba	1.5	A URI reference that identifies a module from which a Perl
75			module file is generated. This argument is I<required>.
76	wakaba	1.4
77	wakaba	1.5	=item --output-file-path=I<perl-module-file-path> (default: the standard output)
78	wakaba	1.1
79	wakaba	1.5	A platform-dependent file path to which the Perl module
80			is written down.
81	wakaba	1.1
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	wakaba	1.8	my %Opt = (
93			create_module => [],
94			);
95	wakaba	1.1	GetOptions (
96	wakaba	1.8	'create-perl-module=s' => sub {
97			shift;
98			push @{$Opt{create_module}}, [split /\s+/, shift, 3];
99			},
100	wakaba	1.1	'enable-assertion!' => \$Opt{outputAssertion},
101			'for=s' => \$Opt{For},
102			'help' => \$Opt{help},
103			'module-uri=s' => \$Opt{module_uri},
104	wakaba	1.4	'output-file-path=s' => \$Opt{output_file_name},
105	wakaba	1.1	'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	wakaba	1.8
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	wakaba	1.1
140			## TODO: Assertion control
141
142	wakaba	1.8	use Message::Util::DIS::DNLite;
143	wakaba	1.1
144	wakaba	1.5	my $impl = $Message::DOM::ImplementationRegistry->get_implementation
145	wakaba	1.1	({
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	wakaba	1.8	status_msg_ qq<Loading the database "$Opt{file_name}"...>;
154	wakaba	1.1	my $db = $di->pl_load_dis_database ($Opt{file_name});
155	wakaba	1.8	status_msg q<done>;
156	wakaba	1.1
157	wakaba	1.8	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	wakaba	1.6	}
166	wakaba	1.1	}
167	wakaba	1.8	unless ($mod->is_defined) {
168			die qq<$0: Module <$mod_uri> for <$mod_for> is not defined>;
169			}
170	wakaba	1.1
171	wakaba	1.8	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	wakaba	1.4	: ($output = \*STDOUT);
179	wakaba	1.8
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	wakaba	1.4
189	wakaba	1.8	status_msg_ "Checking undefined resources...";
190	wakaba	1.1	$db->check_undefined_resource;
191	wakaba	1.8	status_msg q<done>;
192	wakaba	1.5
193	wakaba	1.8	status_msg_ "Closing the database...";
194	wakaba	1.5	$db->free;
195	wakaba	1.7	undef $db;
196	wakaba	1.8	status_msg q<done>;
197	wakaba	1.1
198			=head1 SEE ALSO
199
200			L<lib/Message/Util/DIS.dis> - The <QUOTE::dis> object implementation.
201
202	wakaba	1.8	L<lib/Message/Util/DIS/Perl.dis> - The <QUOTE::dis> object implementation,
203			submodule for Perl modules.
204
205	wakaba	1.1	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	wakaba	1.5	L<bin/dac.pl> - The "dac" database generator.
213
214	wakaba	1.1	=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	wakaba	1.8	1; # $Date: 2005/09/19 16:17:50 $