manakai/bin/dac2test.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#>,
  pc => q<http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/PerlCode#>,
  test => q<http://suika.fam.cx/~wakaba/archive/2004/dis/Test#>,
  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 C<--output-line> / C<--nooutput-line> (default: C<--nooutput-line>)

Whether C<#line> directives should be included to the generated
Perl module files.

=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 (
  'source-module=s' => sub {
    shift;
    push @{$Opt{create_module}}, [split /\s+/, shift, 3];
  },
  'dis-file-suffix=s' => \$Opt{dis_suffix},
  'daem-file-suffix=s' => \$Opt{daem_suffix},
  'debug' => \$Opt{debug},
  '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},
  'output-line' => \$Opt{output_line},
  'search-path|I=s' => sub {
    shift;
    my @value = split /\s+/, shift;
    while (my ($ns, $path) = splice @value, 0, 2, ()) {
      unless (defined $path) {
        die qq[$0: Search-path parameter without path: "$ns"];
      }
      push @{$Opt{input_search_path}->{$ns} ||= []}, $path;
    }
  },
  'search-path-catalog-file-name=s' => sub {
    shift;
    require File::Spec;
    my $path = my $path_base = shift;
    $path_base =~ s#[^/]+$##;
    $Opt{search_path_base} = $path_base;
    open my $file, '<', $path or die "$0: $path: $!";
    while (<$file>) {
      if (s/^\s*\@//) {     ## Processing instruction
        my ($target, $data) = split /\s+/;
        if ($target eq 'base') {
          $Opt{search_path_base} = File::Spec->rel2abs ($data, $path_base);
        } else {
          die "$0: $target: Unknown target";
        }
      } elsif (/^\s*\#/) {  ## Comment
        #
      } elsif (/\S/) {      ## Catalog entry
        s/^\s+//;
        my ($ns, $path) = split /\s+/;
        push @{$Opt{input_search_path}->{$ns} ||= []},
             File::Spec->rel2abs ($path, $Opt{search_path_base});
      }
    }
    ## NOTE: File paths with SPACEs are not supported
    ## NOTE: Future version might use file: URI instead of file path.
  },
  '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};

require Error;
$Error::Debug = 1 if $Opt{debug};
$Message::Util::Error::VERBOSE = 1 if $Opt{verbose};

$Opt{daem_suffix} = '.daem' unless defined $Opt{daem_suffix};
$Opt{dis_suffix} = '.dis' unless defined $Opt{dis_suffix};

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};
}

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

my $start_time;
BEGIN { $start_time = time }

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}, sub ($$) {
    my ($db, $mod) = @_;
    my $ns = $mod->namespace_uri;
    my $ln = $mod->local_name;
    verbose_msg qq<Database module <$ns$ln> is requested>;
    my $name = dac_search_file_path_stem ($ns, $ln, $Opt{daem_suffix});
    if (defined $name) {
      return $name.$Opt{daem_suffix};
    } else {
      return $ln.$Opt{daem_suffix};
    }
  });
  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 test from <$mod_uri> for <$mod_for>...>;

  my $pl = $pc->create_perl_file;
  my $pack = $pl->get_last_package ("Manakai::Test", make_new_package => 1);
  $pack->add_use_perl_module_name ("Message::Util::DIS::Test");
  $pack->add_use_perl_module_name ("Message::Util::Error");
  $pack->add_require_perl_module_name ($mod->pl_fully_qualified_name);

  $pl->source_file ($mod->get_property_text (ExpandedURI q<DIS:sourceFile>, ""));
  $pl->source_module ($mod->name_uri);
  $pl->source_for ($mod->for_uri);
  $pl->license_uri ($mod->get_property_resource (ExpandedURI q<dis:License>)
                        ->uri);

  $pack->append_code
    ($pc->create_perl_statement
       ('my $impl = $Message::DOM::ImplementationRegistry->get_implementation ({
           "http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#Test"
             => "1.0",
         })'));

  $pack->append_code
      (my $num_statement = $pc->create_perl_statement 
                                  ('my $test = $impl->create_test_manager'));

  my $total_tests = 0;
  my %processed;
  for my $res (@{$mod->get_resource_list}) {
    next if $res->owner_module ne $mod or $processed{$res->uri};
    $processed{$res->uri} = 1;

    if ($res->is_type_uri (ExpandedURI q<test:Test>)) {
      $total_tests++;
      $pack->append_code ('$test->start_new_test (');
      $pack->append_new_pc_literal ($res->name_uri || $res->uri);
      $pack->append_code (');');

      $pack->append_code ('try {');

      my $test_pc = $res->pl_code_fragment;
      if (not defined $test_pc) {
        die "Perl test code not defined for <".$res->uri.">";
      }

      $pack->append_code_fragment ($test_pc);

      $pack->append_code ('$test->ok;');

      $pack->append_code ('} catch Message::Util::IF::DTException with {
        ##
      };');
    }
  }
  
  $num_statement->append_code (' (' . $total_tests . ')');
  
  status_msg qq<done>;
  
  my $output;
  defined $out_file_path
      ? (open $output, '>', $out_file_path or die "$0: $out_file_path: $!")
      : ($output = \*STDOUT);

  if ($Opt{output_line}) {
    $pl->owner_document->dom_config->set_parameter (ExpandedURI q<pc:line> => 1);
  }
  
  status_msg_ sprintf qq<Writing Perl test script %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>;

END {
  use integer;
  my $time = time - $start_time;
  status_msg sprintf qq<%d'%02d''>, $time / 60, $time % 60;
}
exit;

sub dac_search_file_path_stem ($$$) {
  my ($ns, $ln, $suffix) = @_;
  require Cwd;
  require File::Spec;
  for my $dir ('.', @{$Opt{input_search_path}->{$ns}||[]}) {
    my $name = Cwd::abs_path
        (File::Spec->canonpath
         (File::Spec->catfile ($dir, $ln)));
    if (-f $name.$suffix) {
      return $name;
    }
  }
  return undef;
} # dac_search_file_path_stem;

=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/11/16 10:07:11 $
1	wakaba	1.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			pc => q<http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/PerlCode#>,
36			test => q<http://suika.fam.cx/~wakaba/archive/2004/dis/Test#>,
37			Util => q<http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/>,
38			};
39
40			=head1 OPTIONS
41
42			=over 4
43
44			=item --enable-assertion / --noenable-assertion (default)
45
46			Whether assertion codes should be outputed or not.
47
48			=item --create-perl-module="I<module-uri> I<ModuleName.pm> [I<for-uri>]" (Zero or more)
49
50			The C<--create-perl-module> option can be used to specify
51			I<--module-uri>, I<--output-file-path>, and I<--for> options
52			once. Its value is a space-separated triplet of "dis" module name URI,
53			Perl module file path (environment dependent), and optional
54			"dis" module "for" URI.
55
56			This option can be specified more than once; it would
57			make multiple Perl module files to be created. If
58			both I<--module-uri> and this options are specified,
59			I<--module-uri>, I<--output-file-path>, and I<--for>
60			options are treated as if there is another I<--create-perl-module>
61			option specified.
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			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
70			=item --help
71
72			Shows the help message.
73
74			=item --module-uri=I<module-uri>
75
76			A URI reference that identifies a module from which a Perl
77			module file is generated. This argument is I<required>.
78
79			=item --output-file-path=I<perl-module-file-path> (default: the standard output)
80
81			A platform-dependent file path to which the Perl module
82			is written down.
83
84			=item C<--output-line> / C<--nooutput-line> (default: C<--nooutput-line>)
85
86			Whether C<#line> directives should be included to the generated
87			Perl module files.
88
89			=item --verbose / --noverbose (default)
90
91			Whether a verbose message mode should be selected or not.
92
93			=back
94
95			=cut
96
97			use Getopt::Long;
98			use Pod::Usage;
99			my %Opt = (
100			create_module => [],
101			);
102			GetOptions (
103			'source-module=s' => sub {
104			shift;
105			push @{$Opt{create_module}}, [split /\s+/, shift, 3];
106			},
107			'dis-file-suffix=s' => \$Opt{dis_suffix},
108			'daem-file-suffix=s' => \$Opt{daem_suffix},
109			'debug' => \$Opt{debug},
110			'enable-assertion!' => \$Opt{outputAssertion},
111			'for=s' => \$Opt{For},
112			'help' => \$Opt{help},
113			'module-uri=s' => \$Opt{module_uri},
114			'output-file-path=s' => \$Opt{output_file_name},
115			'output-line' => \$Opt{output_line},
116			'search-path\|I=s' => sub {
117			shift;
118			my @value = split /\s+/, shift;
119			while (my ($ns, $path) = splice @value, 0, 2, ()) {
120			unless (defined $path) {
121			die qq[$0: Search-path parameter without path: "$ns"];
122			}
123			push @{$Opt{input_search_path}->{$ns} \|\|= []}, $path;
124			}
125			},
126			'search-path-catalog-file-name=s' => sub {
127			shift;
128			require File::Spec;
129			my $path = my $path_base = shift;
130			$path_base =~ s#[^/]+$##;
131			$Opt{search_path_base} = $path_base;
132			open my $file, '<', $path or die "$0: $path: $!";
133			while (<$file>) {
134			if (s/^\s*\@//) { ## Processing instruction
135			my ($target, $data) = split /\s+/;
136			if ($target eq 'base') {
137			$Opt{search_path_base} = File::Spec->rel2abs ($data, $path_base);
138			} else {
139			die "$0: $target: Unknown target";
140			}
141			} elsif (/^\s*\#/) { ## Comment
142			#
143			} elsif (/\S/) { ## Catalog entry
144			s/^\s+//;
145			my ($ns, $path) = split /\s+/;
146			push @{$Opt{input_search_path}->{$ns} \|\|= []},
147			File::Spec->rel2abs ($path, $Opt{search_path_base});
148			}
149			}
150			## NOTE: File paths with SPACEs are not supported
151			## NOTE: Future version might use file: URI instead of file path.
152			},
153			'verbose!' => \$Opt{verbose},
154			) or pod2usage (2);
155			pod2usage ({-exitval => 0, -verbose => 1}) if $Opt{help};
156			$Opt{file_name} = shift;
157			pod2usage ({-exitval => 2, -verbose => 0}) unless $Opt{file_name};
158	wakaba	1.4
159			require Error;
160			$Error::Debug = 1 if $Opt{debug};
161			$Message::Util::Error::VERBOSE = 1 if $Opt{verbose};
162
163	wakaba	1.1	$Opt{daem_suffix} = '.daem' unless defined $Opt{daem_suffix};
164			$Opt{dis_suffix} = '.dis' unless defined $Opt{dis_suffix};
165
166			if ($Opt{module_uri}) {
167			push @{$Opt{create_module}},
168			[$Opt{module_uri}, $Opt{output_file_name}, $Opt{For}];
169			}
170
171			pod2usage (2) unless @{$Opt{create_module}};
172
173			sub status_msg ($) {
174			my $s = shift;
175			$s .= "\n" unless $s =~ /\n$/;
176			print STDERR $s;
177			}
178
179			sub status_msg_ ($) {
180			my $s = shift;
181			print STDERR $s;
182			}
183
184			sub verbose_msg ($) {
185			my $s = shift;
186			$s .= "\n" unless $s =~ /\n$/;
187			print STDERR $s if $Opt{verbose};
188			}
189
190			sub verbose_msg_ ($) {
191			my $s = shift;
192			print STDERR $s if $Opt{verbose};
193			}
194
195			use Message::Util::DIS::DNLite;
196
197			my $start_time;
198			BEGIN { $start_time = time }
199
200			my $impl = $Message::DOM::ImplementationRegistry->get_implementation
201			({
202			ExpandedURI q<ManakaiDOM:Minimum> => '3.0',
203			'+' . ExpandedURI q<DIS:Core> => '1.0',
204			'+' . ExpandedURI q<Util:PerlCode> => '1.0',
205			});
206			my $pc = $impl->get_feature (ExpandedURI q<Util:PerlCode> => '1.0');
207			my $di = $impl->get_feature (ExpandedURI q<DIS:Core> => '1.0');
208
209			status_msg_ qq<Loading the database "$Opt{file_name}"...>;
210			my $db = $di->pl_load_dis_database ($Opt{file_name}, sub ($$) {
211			my ($db, $mod) = @_;
212			my $ns = $mod->namespace_uri;
213			my $ln = $mod->local_name;
214			verbose_msg qq<Database module <$ns$ln> is requested>;
215			my $name = dac_search_file_path_stem ($ns, $ln, $Opt{daem_suffix});
216			if (defined $name) {
217			return $name.$Opt{daem_suffix};
218			} else {
219			return $ln.$Opt{daem_suffix};
220			}
221			});
222			status_msg q<done>;
223
224			for (@{$Opt{create_module}}) {
225			my ($mod_uri, $out_file_path, $mod_for) = @$_;
226
227			my $mod = $db->get_module ($mod_uri, for_arg => $mod_for);
228			unless ($mod_for) {
229			$mod_for = $mod->get_property_text (ExpandedURI q<dis:DefaultFor>, undef);
230			if (defined $mod_for) {
231			$mod = $db->get_module ($mod_uri, for_arg => $mod_for);
232			}
233			}
234			unless ($mod->is_defined) {
235			die qq<$0: Module <$mod_uri> for <$mod_for> is not defined>;
236			}
237
238			status_msg_ qq<Generating Perl test from <$mod_uri> for <$mod_for>...>;
239
240			my $pl = $pc->create_perl_file;
241			my $pack = $pl->get_last_package ("Manakai::Test", make_new_package => 1);
242			$pack->add_use_perl_module_name ("Message::Util::DIS::Test");
243			$pack->add_use_perl_module_name ("Message::Util::Error");
244	wakaba	1.2	$pack->add_require_perl_module_name ($mod->pl_fully_qualified_name);
245	wakaba	1.1
246			$pl->source_file ($mod->get_property_text (ExpandedURI q<DIS:sourceFile>, ""));
247			$pl->source_module ($mod->name_uri);
248			$pl->source_for ($mod->for_uri);
249			$pl->license_uri ($mod->get_property_resource (ExpandedURI q<dis:License>)
250			->uri);
251
252			$pack->append_code
253			($pc->create_perl_statement
254			('my $impl = $Message::DOM::ImplementationRegistry->get_implementation ({
255			"http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#Test"
256			=> "1.0",
257			})'));
258
259			$pack->append_code
260			(my $num_statement = $pc->create_perl_statement
261			('my $test = $impl->create_test_manager'));
262
263			my $total_tests = 0;
264			my %processed;
265			for my $res (@{$mod->get_resource_list}) {
266			next if $res->owner_module ne $mod or $processed{$res->uri};
267			$processed{$res->uri} = 1;
268
269			if ($res->is_type_uri (ExpandedURI q<test:Test>)) {
270			$total_tests++;
271			$pack->append_code ('$test->start_new_test (');
272			$pack->append_new_pc_literal ($res->name_uri \|\| $res->uri);
273			$pack->append_code (');');
274
275			$pack->append_code ('try {');
276
277			my $test_pc = $res->pl_code_fragment;
278	wakaba	1.3	if (not defined $test_pc) {
279			die "Perl test code not defined for <".$res->uri.">";
280			}
281	wakaba	1.1
282			$pack->append_code_fragment ($test_pc);
283
284			$pack->append_code ('$test->ok;');
285
286			$pack->append_code ('} catch Message::Util::IF::DTException with {
287			##
288			};');
289			}
290			}
291
292			$num_statement->append_code (' (' . $total_tests . ')');
293
294			status_msg qq<done>;
295
296			my $output;
297			defined $out_file_path
298			? (open $output, '>', $out_file_path or die "$0: $out_file_path: $!")
299			: ($output = \*STDOUT);
300
301			if ($Opt{output_line}) {
302			$pl->owner_document->dom_config->set_parameter (ExpandedURI q<pc:line> => 1);
303			}
304
305			status_msg_ sprintf qq<Writing Perl test script %s...>,
306			defined $out_file_path
307			? q<">.$out_file_path.q<">
308			: 'to stdout';
309			print $output $pl->stringify;
310			close $output;
311			status_msg q<done>;
312			} # create_module
313
314			status_msg_ "Checking undefined resources...";
315			$db->check_undefined_resource;
316			status_msg q<done>;
317
318			status_msg_ "Closing the database...";
319			$db->free;
320			undef $db;
321			status_msg q<done>;
322
323			END {
324			use integer;
325			my $time = time - $start_time;
326			status_msg sprintf qq<%d'%02d''>, $time / 60, $time % 60;
327			}
328			exit;
329
330			sub dac_search_file_path_stem ($$$) {
331			my ($ns, $ln, $suffix) = @_;
332			require Cwd;
333			require File::Spec;
334			for my $dir ('.', @{$Opt{input_search_path}->{$ns}\|\|[]}) {
335			my $name = Cwd::abs_path
336			(File::Spec->canonpath
337			(File::Spec->catfile ($dir, $ln)));
338			if (-f $name.$suffix) {
339			return $name;
340			}
341			}
342			return undef;
343			} # dac_search_file_path_stem;
344
345			=head1 SEE ALSO
346
347			L<lib/Message/Util/DIS.dis> - The <QUOTE::dis> object implementation.
348
349			L<lib/Message/Util/DIS/Perl.dis> - The <QUOTE::dis> object implementation,
350			submodule for Perl modules.
351
352			L<lib/Message/Util/PerlCode.dis> - The Perl code generator.
353
354			L<lib/manakai/DISCore.dis> - The definition for the "dis" format.
355
356			L<lib/manakai/DISPerl.dis> - The definition for the "dis" Perl-specific
357			vocabulary.
358
359			L<bin/dac.pl> - The "dac" database generator.
360
361			=head1 LICENSE
362
363			Copyright 2004-2005 Wakaba <w@suika.fam.cx>. All rights reserved.
364
365			This program is free software; you can redistribute it and/or
366			modify it under the same terms as Perl itself.
367
368			=cut
369
370	wakaba	1.4	1; # $Date: 2005/11/16 10:07:11 $