--- messaging/manakai/bin/daf.pl	2006/02/25 16:49:55	1.1
+++ messaging/manakai/bin/daf.pl	2006/08/15 10:59:24	1.16
@@ -1,31 +1,56 @@
 #!/usr/bin/perl -w 
 use strict;
 use Message::Util::QName::Filter {
+  c => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#>,
   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-->,
   dp => q<http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#Perl/>,
   fe => q<http://suika.fam.cx/www/2006/feature/>,
   ManakaiDOM => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#>,
+  pc => q<http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/PerlCode#>,
   swcfg21 => q<http://suika.fam.cx/~wakaba/archive/2005/swcfg21#>,
   Util => q<http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/>,
 };
 
+our$VERSION=do{my @r=(q$Revision: 1.16 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
 use Cwd;
 use Getopt::Long;
 use Pod::Usage;
-my %Opt = (create_module => []);
+our %Opt = (create_module => []);
+my @target_modules;
 GetOptions (
+  'create-dtd-modules=s' => sub {
+    shift;
+    my $i = [split /\s+/, shift, 3];
+    $i->[3] = 'dtd-modules';
+    push @{$Opt{create_module}}, $i;
+  },
   'create-perl-module=s' => sub {
     shift;
     my $i = [split /\s+/, shift, 3];
-    $i->[3] = 'pm';
+    $i->[3] = 'perl-pm';
     push @{$Opt{create_module}}, $i;
+    push @target_modules, [$i->[0], $i->[2]];
+  },
+  'create-perl-test=s' => sub {
+    shift;
+    my $i = [split /\s+/, shift, 3];
+    $i->[3] = 'perl-t';
+    push @{$Opt{create_module}}, $i;
+    push @target_modules, [$i->[0], $i->[2]];
   },
   'debug' => \$Opt{debug},
   'dis-file-suffix=s' => \$Opt{dis_suffix},
   'daem-file-suffix=s' => \$Opt{daem_suffix},
+  'dafs-file-suffix=s' => \$Opt{dafs_suffix},
   'dafx-file-suffix=s' => \$Opt{dafx_suffix},
   'help' => \$Opt{help},
+  'load-module=s' => sub {
+    shift;
+    my $i = [split /\s+/, shift, 2];
+    push @target_modules, [$i->[0], $i->[1]];
+  },
+  'mod-file-suffix=s' => \$Opt{mod_suffix},
   'search-path|I=s' => sub {
     shift;
     my @value = split /\s+/, shift;
@@ -72,6 +97,8 @@
 $Opt{dis_suffix} = '.dis' unless defined $Opt{dis_suffix};
 $Opt{daem_suffix} = '.dafm' unless defined $Opt{daem_suffix};
 $Opt{dafx_suffix} = '.dafx' unless defined $Opt{dafx_suffix};
+$Opt{dafs_suffix} = '.dafs' unless defined $Opt{dafs_suffix};
+$Opt{mod_suffix} = '.mod' unless defined $Opt{mod_suffix};
 $Message::DOM::DOMFeature::DEBUG = 1 if $Opt{debug};
 require Error;
 $Error::Debug = 1 if $Opt{debug};
@@ -99,27 +126,50 @@
   print STDERR $s if $Opt{verbose};
 }
 
+## ---- The MAIN Program
+
 my $start_time;
 BEGIN { $start_time = time }
 
 use Message::Util::DIS::DNLite;
-use Message::Util::PerlCode;
 
-my $limpl = $Message::DOM::ImplementationRegistry->get_implementation
+my %feature;
+
+for (@{$Opt{create_module}}) {
+  my (undef, undef, undef, $out_type) = @$_;
+
+  if ($out_type eq 'perl-pm') {
+    require 'manakai/daf-perl-pm.pl';
+    $feature{'+' . ExpandedURI q<Util:PerlCode>} = '1.0';
+  } elsif ($out_type eq 'perl-t') {
+    require 'manakai/daf-perl-t.pl';
+    $feature{ExpandedURI q<fe:GenericLS>} = '3.0';
+    $feature{'+' . ExpandedURI q<DIS:TDT>} = '1.0';
+    $feature{'+' . ExpandedURI q<Util:PerlCode>} = '1.0';
+  } elsif ($out_type eq 'dtd-modules') {
+    require 'manakai/daf-dtd-modules.pl';
+    $feature{ExpandedURI q<fe:GenericLS>} = '3.0';
+    $feature{'+' . ExpandedURI q<fe:XDP>} = '3.0';
+  }
+}
+
+our $limpl = $Message::DOM::ImplementationRegistry->get_implementation
                            ({ExpandedURI q<fe:Min> => '3.0',
                              '+' . ExpandedURI q<DIS:DNLite> => '1.0',
                              '+' . ExpandedURI q<DIS:Core> => '1.0',
-                             '+' . ExpandedURI q<Util:PerlCode> => '1.0',
+                             %feature,
                            });
-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');
+our $impl = $limpl->get_feature (ExpandedURI q<DIS:Core> => '1.0');
+
+## --- Loading and Updating the Database
 
 my $HasError;
-my $db = $impl->create_dis_database;
+our $db = $impl->create_dis_database;
 $db->pl_database_module_resolver (\&daf_db_module_resolver);
 $db->dom_config->set_parameter ('error-handler' => \&daf_on_error);
 
+my $parser = $impl->create_dis_parser;
+my $DNi = $impl->get_feature (ExpandedURI q<DIS:DNLite> => '1.0');
 my %ModuleSourceDISDocument;
 my %ModuleSourceDNLDocument;
 my %ModuleNameNamespaceBinding = (
@@ -129,12 +179,6 @@
     ## property.
 );
 
-my @target_modules;
-for (@{$Opt{create_module}}) {
-  my ($mod_uri, $out_path, $mod_for, $out_type) = @$_;
-  push @target_modules, [$mod_uri, $mod_for];
-}
-
 my $ResourceCount = 0;
 $db->pl_update_module (\@target_modules,
 get_module_index_file_name => sub {
@@ -189,7 +233,6 @@
     unless (defined $ModuleSourceDISDocument{$module_uri}) {
       daf_open_source_dis_document ($module_uri);
     }
-    daf_convert_dis_document_to_dnl_document ();
   }
   return daf_get_referring_module_uri_list ($module_uri);
 },
@@ -219,7 +262,7 @@
     status_msg_ " " if ($ResourceCount % (10 * 10)) == 0;
     status_msg '' if ($ResourceCount % (10 * 50)) == 0;
   }
-});
+}, implementation => $impl);
 status_msg '';
 status_msg "done";
 
@@ -253,44 +296,35 @@
 
 daf_check_undefined ();
 
+undef $DNi;
+undef %ModuleSourceDNLDocument;
+exit $HasError if $HasError;
+
+## --- Creating Files
+
 for (@{$Opt{create_module}}) {
   my ($mod_uri, $out_file_path, $mod_for, $out_type) = @$_;
-  unless (defined $mod_for) {
-    $mod_for = $db->get_module ($mod_uri)
-                  ->get_property_text (ExpandedURI q<dis:DefaultFor>,
-                                       ExpandedURI q<ManakaiDOM:all>);
-  }
-  my $mod = $db->get_module ($mod_uri, for_arg => $mod_for);
-
-  if ($out_type eq 'pm') {
-    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>;
+
+  if ($out_type eq 'perl-pm') {
+    daf_perl_pm ($mod_uri, $out_file_path, $mod_for);
+  } elsif ($out_type eq 'perl-t') {
+    daf_perl_t ($mod_uri, $out_file_path, $mod_for);
+  } elsif ($out_type eq 'dtd-modules') {
+    daf_dtd_modules ($mod_uri, $out_file_path, $mod_for);
   }
 }
 
 daf_check_undefined ();
 
+## --- The END
+
 status_msg_ "Closing the database...";
 $db->free;
 undef $db;
-undef %ModuleSourceDNLDocument;
 status_msg "done";
 
-undef $DNi;
+undef $limpl;
+undef $impl;
 
 {
   use integer;
@@ -303,6 +337,8 @@
   $db->free if $db;
 }
 
+## ---- Subroutines
+
 sub daf_open_source_dis_document ($) {
   my ($module_uri) = @_;
 
@@ -428,7 +464,7 @@
 sub dac_search_file_path_stem ($$$) {
   my ($ns, $ln, $suffix) = @_;
   require File::Spec;
-  for my $dir ('.', @{$Opt{input_search_path}->{$ns}||[]}) {
+  for my $dir (@{$Opt{input_search_path}->{$ns}||[]}) {
     my $name = Cwd::abs_path
         (File::Spec->canonpath
          (File::Spec->catfile ($dir, $ln)));
@@ -487,8 +523,11 @@
   my ($db, $mod, $type) = @_;
   my $ns = $mod->namespace_uri;
   my $ln = $mod->local_name;
-  my $suffix = $type eq ExpandedURI q<dp:ModuleIndexFile>
-                 ? $Opt{dafx_suffix} : $Opt{daem_suffix};
+  my $suffix = {
+    ExpandedURI q<dp:ModuleIndexFile> => $Opt{dafx_suffix},
+    ExpandedURI q<dp:ModuleResourceFile> => $Opt{daem_suffix},
+    ExpandedURI q<dp:ModuleNodeStorageFile> => $Opt{dafs_suffix},
+  }->{$type} or die "Unsupported type: <$type>";
   verbose_msg qq<Database module <$ns$ln> is requested>;
   my $name = dac_search_file_path_stem ($ns, $ln, $suffix);
   if (defined $name) {
@@ -571,22 +610,16 @@
 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.
+Copyright 2004-2006 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.