manakai/bin/dac.pl

#!/usr/bin/perl -w 
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#>,
  swcfg21 => q<http://suika.fam.cx/~wakaba/archive/2005/swcfg21#>,
};

use Getopt::Long;
use Pod::Usage;
my %Opt = ();
GetOptions (
  'db-base-directory-path=s' => \$Opt{db_base_path},
  'debug' => \$Opt{debug},
  'dis-file-suffix=s' => \$Opt{dis_suffix},
  'daem-file-suffix=s' => \$Opt{daem_suffix},
  'for=s' => \$Opt{For},
  'help' => \$Opt{help},
  'input-db-file-name=s' => \$Opt{input_file_name},
  'output-file-name=s' => \$Opt{output_file_name},
  '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.
  },
  'undef-check!' => \$Opt{no_undef_check},
  'update!' => \$Opt{update},
  '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 ({-exitval => 2, -verbose => 0}) unless $Opt{output_file_name};
$Opt{no_undef_check} = defined $Opt{no_undef_check}
                         ? $Opt{no_undef_check} ? 0 : 1 : 0;
$Opt{dis_suffix} = '.dis' unless defined $Opt{dis_suffix};
$Opt{daem_suffix} = '.daem' unless defined $Opt{daem_suffix};
$Message::DOM::DOMFeature::DEBUG = 1 if $Opt{debug};
require Error;
$Error::Debug = 1 if $Opt{debug};
$Message::Util::Error::VERBOSE = 1 if $Opt{verbose};

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

my $start_time;
BEGIN { $start_time = time }

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

my $limpl = $Message::DOM::ImplementationRegistry->get_implementation
                           ({ExpandedURI q<ManakaiDOM:Minimum> => '3.0',
                             '+' . ExpandedURI q<DIS:DNLite> => '1.0'});
my $impl = $limpl->get_feature (ExpandedURI q<DIS:Core> => '1.0');
my $parser = $impl->create_dis_parser;
our $DNi = $impl->get_feature (ExpandedURI q<DIS:DNLite> => '1.0');

my $db;

if (defined $Opt{input_file_name}) {
  status_msg_ qq<Loading database "$Opt{input_file_name}"...>;
  $db = $impl->pl_load_dis_database ($Opt{input_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 undef;
    }
  });
  status_msg qq<done>;
} else {  ## New database
  $db = $impl->create_dis_database;
}

require Cwd;
my $file_name = Cwd::abs_path ($Opt{file_name});
$Opt{db_base_path} = Cwd::abs_path ($Opt{db_base_path})
  if length $Opt{db_base_path};
my $doc = dac_load_module_file ($db, $parser, $file_name, $Opt{db_base_path});

my $for = $Opt{For};
$for = $doc->module_element->default_for_uri unless length $for;
$db->get_for ($for)->is_referred ($doc);
status_msg qq<Loading module in file "$file_name" for <$for>...>;

my $srinfo = {};
if ($Opt{update}) {
  my $mod_uri = $doc->module_element
                    ->get_attribute_ns (ExpandedURI q<dis:>, 'QName')
                    ->qname_value_uri;
  for my $mod (@{$db->get_module_resource_list}) {
    if ($mod_uri eq $mod->name_uri) {
      status_msg_ qq[Removing module <$mod_uri> for <@{[$mod->for_uri]}>...];
      $srinfo = $db->unload_module ($mod, srinfo => $srinfo);
      status_msg q<done>;
    }
  }
}

my $ResourceCount = 0;
$db->load_module ($doc, sub ($$$$$$) {
  my ($self, $db, $uri, $ns, $ln, $for) = @_;
  status_msg '';
  status_msg qq<Loading module "$ln" for <$for>...>;
  $ResourceCount = 0;

  ## -- Already in database
  my $doc = $db->get_source_file ($ns.$ln);
  return $doc if $doc;
  
  ## -- Finds the source file
  my $name = dac_search_file_path_stem ($ns, $ln, $Opt{dis_suffix});
  if (defined $name) {
    return dac_load_module_file
             ($db, $parser, $name.$Opt{dis_suffix}, $Opt{db_base_path});
  }

  ## -- Not found
  return undef;
}, for_arg => $for, on_resource_read => sub ($$) {
  if ((++$ResourceCount % 10) == 0) {
    status_msg_ "*";
    status_msg_ " " if ($ResourceCount % (10 * 10)) == 0;
    status_msg '' if ($ResourceCount % (10 * 50)) == 0;
  }
}, srinfo => $srinfo);


## Removes reference from document to database
our @Document;
for my $dis (@Document) {
  $dis->unlink_from_document;
  $dis->dis_database (undef);
}

status_msg '';

status_msg qq<Reading properties...>;
$ResourceCount = 0;
$db->read_properties (on_resource_read => sub ($$) {
  if ((++$ResourceCount % 10) == 0) {
    status_msg_ "*";
    status_msg_ " " if ($ResourceCount % (10 * 10)) == 0;
    status_msg '' if ($ResourceCount % (10 * 50)) == 0;
  }
});
status_msg '';
status_msg "done";

status_msg_ qq<Writing file "$Opt{output_file_name}"...>;
$db->pl_store ($Opt{output_file_name}, sub ($$) {
  my ($db, $mod) = @_;
  my $ns = $mod->namespace_uri;
  my $ln = $mod->local_name;
  my $name = dac_search_file_path_stem ($ns, $ln, $Opt{daem_suffix});
  if (defined $name) {
    $name .= $Opt{daem_suffix};
  } elsif (defined ($name = dac_search_file_path_stem
                              ($ns, $ln, $Opt{dis_suffix}))) {
    $name .= $Opt{daem_suffix};
  } else {
    $name = Cwd::abs_path
              (File::Spec->canonpath
                 (File::Spec->catfile
                    (defined $Opt{input_search_path}->{$ns}->[0]
                       ? $Opt{input_search_path}->{$ns}->[0] : '.',
                     $ln.$Opt{daem_suffix})));
  }
  verbose_msg qq<Database module <$ns$ln> is written to "$name">;
  return $name;
});
status_msg "done";

unless ($Opt{no_undef_check}) {
  status_msg_ "Checking undefined resources...";
  $db->check_undefined_resource;
  print STDERR "done\n";
}

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

undef $DNi;

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

END {
  $db->free if $db;
}

## (db, parser, abs file path, abs base path) -> dis doc obj
sub dac_load_module_file ($$$;$) {
  my ($db, $parser, $file_name, $base_path) = @_;
  require URI::file;
  my $base_uri = length $base_path ? URI::file->new ($base_path.'/')
                                   : 'http://dummy.invalid/';
  my $file_uri = URI::file->new ($file_name)->rel ($base_uri);
  my $dis = $db->get_source_file ($file_uri);
  unless ($dis) {
    status_msg_ qq<Opening source file <$file_uri>...>;
    open my $file, '<', $file_name or die "$0: $file_name: $!";
    $dis = $parser->parse ({character_stream => $file});
    $dis->flag (ExpandedURI q<swcfg21:fileName> => $file_uri);
    $dis->dis_database ($db);

    my $mod = $dis->module_element;
    if ($mod) {
      my $qn = $mod->get_attribute_ns (ExpandedURI q<dis:>, 'QName');
      if ($qn) {
        my $prefix = $qn->value;
        $prefix =~ s/^[^:|]*[:|]\s*//;
        $prefix =~ s/\s+$//;
        unless (defined $dis->lookup_namespace_uri ($prefix)) {
          $dis->add_namespace_binding ($prefix => $mod->defining_namespace_uri);
        }
      }
    }

    my $old_dis = $dis;
    status_msg_ qq<...>;
    $dis = $DNi->convert_dis_document_to_dnl_document
      ($old_dis, database_arg => $db);
    push @Document, $dis;
    $old_dis->free;

    $db->set_source_file ($file_uri => $dis);
    status_msg qq<done>;
  }
  $dis;
}

sub dac_search_file_path_stem ($$$) {
  my ($ns, $ln, $suffix) = @_;
  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;

__END__

=head1 NAME

dac.pl - Creating "dac" Database File from "dis" Source Files

=head1 SYNOPSIS

  perl path/to/dac.pl [--input-db-file-name=input.dac] \
                      --output-file-name=out.dac [options...] \
                      input.dis
  perl path/to/dac.pl --help

=head1 DESCRIPTION

This script, C<dac.pl>, compiles "dis" source files into "dac"
database file.  The generated database file can be used
in turn to generate Perl module file, for example, by another
script C<dac2pm.pl> or can be used to create larger database
by specifying its file name as the C<--input-db-file-name>
argument of another C<dac.pl> execution.

This script is part of manakai.

=head1 OPTIONS

=over 4

=item I<input.dis> (Required)

The unnamed option specifies a file name path of the source "dis" file
from which a database is created.  This option is required.

=item C<--input-db-file-name=I<file-name>> (Default: none)

A file path of the base database.  This option is optional; if this
option is specified, the database file is loaded first
and then I<input.dis> file is loaded in the context of it.
Otherwise, a new database is created.

=item C<--output-file-name=I<file-name>> (Required)

The 

=back

=head1 SEE ALSO

L<bin/dac2pm.pl> - Generating Perl module from "dac" file.

L<lib/Message/Util/DIS.dis> - The actual implementation
of the "dis" interpretation.

=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	wakaba	1.1	#!/usr/bin/perl -w
2			use strict;
3			use Message::Util::QName::Filter {
4			DIS => q<http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#>,
5			dis => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis-->,
6			ManakaiDOM => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#>,
7	wakaba	1.3	swcfg21 => q<http://suika.fam.cx/~wakaba/archive/2005/swcfg21#>,
8	wakaba	1.1	};
9
10			use Getopt::Long;
11			use Pod::Usage;
12	wakaba	1.4	my %Opt = ();
13	wakaba	1.1	GetOptions (
14			'db-base-directory-path=s' => \$Opt{db_base_path},
15	wakaba	1.11	'debug' => \$Opt{debug},
16	wakaba	1.13	'dis-file-suffix=s' => \$Opt{dis_suffix},
17			'daem-file-suffix=s' => \$Opt{daem_suffix},
18	wakaba	1.1	'for=s' => \$Opt{For},
19			'help' => \$Opt{help},
20	wakaba	1.4	'input-db-file-name=s' => \$Opt{input_file_name},
21	wakaba	1.1	'output-file-name=s' => \$Opt{output_file_name},
22	wakaba	1.2	'search-path\|I=s' => sub {
23			shift;
24			my @value = split /\s+/, shift;
25			while (my ($ns, $path) = splice @value, 0, 2, ()) {
26	wakaba	1.4	unless (defined $path) {
27			die qq[$0: Search-path parameter without path: "$ns"];
28			}
29	wakaba	1.2	push @{$Opt{input_search_path}->{$ns} \|\|= []}, $path;
30			}
31			},
32	wakaba	1.4	'search-path-catalog-file-name=s' => sub {
33			shift;
34			require File::Spec;
35			my $path = my $path_base = shift;
36			$path_base =~ s#[^/]+$##;
37			$Opt{search_path_base} = $path_base;
38			open my $file, '<', $path or die "$0: $path: $!";
39			while (<$file>) {
40			if (s/^\s*\@//) { ## Processing instruction
41			my ($target, $data) = split /\s+/;
42			if ($target eq 'base') {
43			$Opt{search_path_base} = File::Spec->rel2abs ($data, $path_base);
44			} else {
45			die "$0: $target: Unknown target";
46			}
47			} elsif (/^\s*\#/) { ## Comment
48			#
49			} elsif (/\S/) { ## Catalog entry
50			s/^\s+//;
51			my ($ns, $path) = split /\s+/;
52			push @{$Opt{input_search_path}->{$ns} \|\|= []},
53			File::Spec->rel2abs ($path, $Opt{search_path_base});
54			}
55			}
56			## NOTE: File paths with SPACEs are not supported
57			## NOTE: Future version might use file: URI instead of file path.
58			},
59	wakaba	1.1	'undef-check!' => \$Opt{no_undef_check},
60	wakaba	1.15	'update!' => \$Opt{update},
61	wakaba	1.13	'verbose!' => \$Opt{verbose},
62	wakaba	1.1	) or pod2usage (2);
63			pod2usage ({-exitval => 0, -verbose => 1}) if $Opt{help};
64			$Opt{file_name} = shift;
65			pod2usage ({-exitval => 2, -verbose => 0}) unless $Opt{file_name};
66			pod2usage ({-exitval => 2, -verbose => 0}) unless $Opt{output_file_name};
67			$Opt{no_undef_check} = defined $Opt{no_undef_check}
68			? $Opt{no_undef_check} ? 0 : 1 : 0;
69	wakaba	1.13	$Opt{dis_suffix} = '.dis' unless defined $Opt{dis_suffix};
70			$Opt{daem_suffix} = '.daem' unless defined $Opt{daem_suffix};
71	wakaba	1.11	$Message::DOM::DOMFeature::DEBUG = 1 if $Opt{debug};
72	wakaba	1.14	require Error;
73			$Error::Debug = 1 if $Opt{debug};
74			$Message::Util::Error::VERBOSE = 1 if $Opt{verbose};
75	wakaba	1.1
76	wakaba	1.13	sub status_msg ($) {
77			my $s = shift;
78			$s .= "\n" unless $s =~ /\n$/;
79			print STDERR $s;
80			}
81
82			sub status_msg_ ($) {
83			my $s = shift;
84			print STDERR $s;
85			}
86
87			sub verbose_msg ($) {
88			my $s = shift;
89			$s .= "\n" unless $s =~ /\n$/;
90			print STDERR $s if $Opt{verbose};
91			}
92
93			sub verbose_msg_ ($) {
94			my $s = shift;
95			print STDERR $s if $Opt{verbose};
96			}
97
98	wakaba	1.10	my $start_time;
99			BEGIN { $start_time = time }
100
101			use Message::Util::DIS::DNLite;
102	wakaba	1.5
103	wakaba	1.11	my $limpl = $Message::DOM::ImplementationRegistry->get_implementation
104	wakaba	1.1	({ExpandedURI q<ManakaiDOM:Minimum> => '3.0',
105	wakaba	1.11	'+' . ExpandedURI q<DIS:DNLite> => '1.0'});
106			my $impl = $limpl->get_feature (ExpandedURI q<DIS:Core> => '1.0');
107	wakaba	1.1	my $parser = $impl->create_dis_parser;
108	wakaba	1.10	our $DNi = $impl->get_feature (ExpandedURI q<DIS:DNLite> => '1.0');
109	wakaba	1.1
110			my $db;
111
112			if (defined $Opt{input_file_name}) {
113	wakaba	1.13	status_msg_ qq<Loading database "$Opt{input_file_name}"...>;
114			$db = $impl->pl_load_dis_database ($Opt{input_file_name}, sub ($$) {
115			my ($db, $mod) = @_;
116			my $ns = $mod->namespace_uri;
117			my $ln = $mod->local_name;
118			verbose_msg qq<Database module <$ns$ln> is requested>;
119			my $name = dac_search_file_path_stem ($ns, $ln, $Opt{daem_suffix});
120			if (defined $name) {
121			return $name.$Opt{daem_suffix};
122			} else {
123			return undef;
124			}
125			});
126			status_msg qq<done>;
127	wakaba	1.1	} else { ## New database
128			$db = $impl->create_dis_database;
129			}
130
131			require Cwd;
132			my $file_name = Cwd::abs_path ($Opt{file_name});
133	wakaba	1.13	$Opt{db_base_path} = Cwd::abs_path ($Opt{db_base_path})
134			if length $Opt{db_base_path};
135			my $doc = dac_load_module_file ($db, $parser, $file_name, $Opt{db_base_path});
136	wakaba	1.1
137	wakaba	1.7	my $for = $Opt{For};
138	wakaba	1.1	$for = $doc->module_element->default_for_uri unless length $for;
139	wakaba	1.3	$db->get_for ($for)->is_referred ($doc);
140	wakaba	1.11	status_msg qq<Loading module in file "$file_name" for <$for>...>;
141	wakaba	1.1
142	wakaba	1.15	my $srinfo = {};
143			if ($Opt{update}) {
144			my $mod_uri = $doc->module_element
145			->get_attribute_ns (ExpandedURI q<dis:>, 'QName')
146			->qname_value_uri;
147			for my $mod (@{$db->get_module_resource_list}) {
148			if ($mod_uri eq $mod->name_uri) {
149			status_msg_ qq[Removing module <$mod_uri> for <@{[$mod->for_uri]}>...];
150			$srinfo = $db->unload_module ($mod, srinfo => $srinfo);
151			status_msg q<done>;
152			}
153			}
154			}
155
156	wakaba	1.6	my $ResourceCount = 0;
157	wakaba	1.1	$db->load_module ($doc, sub ($$$$$$) {
158			my ($self, $db, $uri, $ns, $ln, $for) = @_;
159	wakaba	1.10	status_msg '';
160	wakaba	1.11	status_msg qq<Loading module "$ln" for <$for>...>;
161	wakaba	1.6	$ResourceCount = 0;
162	wakaba	1.2
163			## -- Already in database
164	wakaba	1.1	my $doc = $db->get_source_file ($ns.$ln);
165	wakaba	1.2	return $doc if $doc;
166	wakaba	1.1
167	wakaba	1.2	## -- Finds the source file
168	wakaba	1.13	my $name = dac_search_file_path_stem ($ns, $ln, $Opt{dis_suffix});
169			if (defined $name) {
170			return dac_load_module_file
171			($db, $parser, $name.$Opt{dis_suffix}, $Opt{db_base_path});
172	wakaba	1.2	}
173
174			## -- Not found
175			return undef;
176	wakaba	1.6	}, for_arg => $for, on_resource_read => sub ($$) {
177			if ((++$ResourceCount % 10) == 0) {
178	wakaba	1.10	status_msg_ "*";
179			status_msg_ " " if ($ResourceCount % (10 * 10)) == 0;
180			status_msg '' if ($ResourceCount % (10 * 50)) == 0;
181	wakaba	1.6	}
182	wakaba	1.15	}, srinfo => $srinfo);
183	wakaba	1.1
184	wakaba	1.3
185	wakaba	1.10	## Removes reference from document to database
186			our @Document;
187			for my $dis (@Document) {
188			$dis->unlink_from_document;
189			$dis->dis_database (undef);
190			}
191
192			status_msg '';
193	wakaba	1.9
194	wakaba	1.10	status_msg qq<Reading properties...>;
195	wakaba	1.9	$ResourceCount = 0;
196			$db->read_properties (on_resource_read => sub ($$) {
197			if ((++$ResourceCount % 10) == 0) {
198	wakaba	1.10	status_msg_ "*";
199			status_msg_ " " if ($ResourceCount % (10 * 10)) == 0;
200			status_msg '' if ($ResourceCount % (10 * 50)) == 0;
201	wakaba	1.9	}
202			});
203	wakaba	1.10	status_msg '';
204			status_msg "done";
205	wakaba	1.9
206	wakaba	1.10	status_msg_ qq<Writing file "$Opt{output_file_name}"...>;
207	wakaba	1.13	$db->pl_store ($Opt{output_file_name}, sub ($$) {
208			my ($db, $mod) = @_;
209			my $ns = $mod->namespace_uri;
210			my $ln = $mod->local_name;
211			my $name = dac_search_file_path_stem ($ns, $ln, $Opt{daem_suffix});
212			if (defined $name) {
213			$name .= $Opt{daem_suffix};
214			} elsif (defined ($name = dac_search_file_path_stem
215			($ns, $ln, $Opt{dis_suffix}))) {
216			$name .= $Opt{daem_suffix};
217			} else {
218			$name = Cwd::abs_path
219			(File::Spec->canonpath
220			(File::Spec->catfile
221			(defined $Opt{input_search_path}->{$ns}->[0]
222			? $Opt{input_search_path}->{$ns}->[0] : '.',
223			$ln.$Opt{daem_suffix})));
224			}
225			verbose_msg qq<Database module <$ns$ln> is written to "$name">;
226			return $name;
227			});
228	wakaba	1.10	status_msg "done";
229	wakaba	1.9
230	wakaba	1.8	unless ($Opt{no_undef_check}) {
231	wakaba	1.10	status_msg_ "Checking undefined resources...";
232	wakaba	1.8	$db->check_undefined_resource;
233			print STDERR "done\n";
234			}
235
236	wakaba	1.10	status_msg_ "Closing the database...";
237	wakaba	1.8	$db->free;
238			undef $db;
239	wakaba	1.10	status_msg "done";
240
241			undef $DNi;
242	wakaba	1.8
243	wakaba	1.10	{
244			use integer;
245			my $time = time - $start_time;
246	wakaba	1.11	status_msg sprintf qq<%d'%02d''>, $time / 60, $time % 60;
247	wakaba	1.10	}
248	wakaba	1.1	exit;
249
250	wakaba	1.8	END {
251			$db->free if $db;
252			}
253
254	wakaba	1.1	## (db, parser, abs file path, abs base path) -> dis doc obj
255			sub dac_load_module_file ($$$;$) {
256			my ($db, $parser, $file_name, $base_path) = @_;
257			require URI::file;
258			my $base_uri = length $base_path ? URI::file->new ($base_path.'/')
259			: 'http://dummy.invalid/';
260			my $file_uri = URI::file->new ($file_name)->rel ($base_uri);
261			my $dis = $db->get_source_file ($file_uri);
262			unless ($dis) {
263	wakaba	1.13	status_msg_ qq<Opening source file <$file_uri>...>;
264	wakaba	1.1	open my $file, '<', $file_name or die "$0: $file_name: $!";
265			$dis = $parser->parse ({character_stream => $file});
266	wakaba	1.10	$dis->flag (ExpandedURI q<swcfg21:fileName> => $file_uri);
267			$dis->dis_database ($db);
268
269			my $mod = $dis->module_element;
270			if ($mod) {
271			my $qn = $mod->get_attribute_ns (ExpandedURI q<dis:>, 'QName');
272			if ($qn) {
273			my $prefix = $qn->value;
274	wakaba	1.12	$prefix =~ s/^[^:\|][:\|]\s//;
275			$prefix =~ s/\s+$//;
276	wakaba	1.10	unless (defined $dis->lookup_namespace_uri ($prefix)) {
277			$dis->add_namespace_binding ($prefix => $mod->defining_namespace_uri);
278			}
279			}
280			}
281
282	wakaba	1.11	my $old_dis = $dis;
283	wakaba	1.10	status_msg_ qq<...>;
284			$dis = $DNi->convert_dis_document_to_dnl_document
285	wakaba	1.11	($old_dis, database_arg => $db);
286	wakaba	1.10	push @Document, $dis;
287	wakaba	1.11	$old_dis->free;
288	wakaba	1.10
289	wakaba	1.1	$db->set_source_file ($file_uri => $dis);
290	wakaba	1.10	status_msg qq<done>;
291	wakaba	1.1	}
292			$dis;
293			}
294	wakaba	1.13
295			sub dac_search_file_path_stem ($$$) {
296			my ($ns, $ln, $suffix) = @_;
297			require File::Spec;
298			for my $dir ('.', @{$Opt{input_search_path}->{$ns}\|\|[]}) {
299			my $name = Cwd::abs_path
300			(File::Spec->canonpath
301			(File::Spec->catfile ($dir, $ln)));
302			if (-f $name.$suffix) {
303			return $name;
304			}
305			}
306			return undef;
307			} # dac_search_file_path_stem;
308	wakaba	1.1
309			__END__
310
311			=head1 NAME
312
313	wakaba	1.10	dac.pl - Creating "dac" Database File from "dis" Source Files
314	wakaba	1.8
315			=head1 SYNOPSIS
316
317	wakaba	1.10	perl path/to/dac.pl [--input-db-file-name=input.dac] \
318			--output-file-name=out.dac [options...] \
319			input.dis
320	wakaba	1.8	perl path/to/dac.pl --help
321
322			=head1 DESCRIPTION
323
324	wakaba	1.10	This script, C<dac.pl>, compiles "dis" source files into "dac"
325			database file. The generated database file can be used
326			in turn to generate Perl module file, for example, by another
327			script C<dac2pm.pl> or can be used to create larger database
328			by specifying its file name as the C<--input-db-file-name>
329			argument of another C<dac.pl> execution.
330	wakaba	1.8
331			This script is part of manakai.
332	wakaba	1.1
333			=head1 OPTIONS
334
335	wakaba	1.10	=over 4
336
337			=item I<input.dis> (Required)
338
339			The unnamed option specifies a file name path of the source "dis" file
340			from which a database is created. This option is required.
341
342			=item C<--input-db-file-name=I<file-name>> (Default: none)
343
344			A file path of the base database. This option is optional; if this
345			option is specified, the database file is loaded first
346			and then I<input.dis> file is loaded in the context of it.
347			Otherwise, a new database is created.
348
349			=item C<--output-file-name=I<file-name>> (Required)
350
351			The
352
353			=back
354	wakaba	1.8
355			=head1 SEE ALSO
356
357			L<bin/dac2pm.pl> - Generating Perl module from "dac" file.
358
359			L<lib/Message/Util/DIS.dis> - The actual implementation
360			of the "dis" interpretation.
361
362			=head1 LICENSE
363
364			Copyright 2004-2005 Wakaba <w@suika.fam.cx>. All rights reserved.
365
366			This program is free software; you can redistribute it and/or
367			modify it under the same terms as Perl itself.
368	wakaba	1.2
369			=cut