/[suikacvs]/messaging/manakai/bin/dac2pm.pl
Suika

Diff of /messaging/manakai/bin/dac2pm.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.7 by wakaba, Mon Sep 19 16:17:50 2005 UTC revision 1.8 by wakaba, Thu Sep 22 11:02:31 2005 UTC
# Line 12  dac2pm - Generating Perl Module from "da Line 12  dac2pm - Generating Perl Module from "da
12    perl path/to/dac2pm.pl input.dac \    perl path/to/dac2pm.pl input.dac \
13              --module-uri=module-uri [--for=for-uri] [options] \              --module-uri=module-uri [--for=for-uri] [options] \
14              --output-file-path=ModuleName.pm              --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    perl path/to/dac2pm.pl --help
19    
20  =head1 DESCRIPTION  =head1 DESCRIPTION
21    
22  The C<dac2pm> script generates a Perl module from a "dac" file.  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.  This script is part of manakai.
26    
27  =cut  =cut
28    
29  use strict;  use strict;
 use Message::Util::DIS;  
30  use Message::Util::QName::Filter {  use Message::Util::QName::Filter {
31    DIS => q<http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#>,    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-->,    dis => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis-->,
   dis2pm => q<http://suika.fam.cx/~wakaba/archive/2004/11/8/dis2pm#>,  
   DISCore => q<http://suika.fam.cx/~wakaba/archive/2004/dis/Core#>,  
   DISLang => q<http://suika.fam.cx/~wakaba/archive/2004/dis/Lang#>,  
   DISPerl => q<http://suika.fam.cx/~wakaba/archive/2004/dis/Perl#>,  
   disPerl => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--Perl-->,  
   DOMCore => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#>,  
   DOMEvents => q<http://suika.fam.cx/~wakaba/archive/2004/dom/events#>,  
   DOMMain => q<http://suika.fam.cx/~wakaba/archive/2004/dom/main#>,  
   DOMXML => q<http://suika.fam.cx/~wakaba/archive/2004/dom/xml#>,  
   DX => q<http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#>,  
   lang => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#>,  
   Perl => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#Perl-->,  
   license => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/license#>,  
33    ManakaiDOM => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#>,    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#>,    Markup => q<http://suika.fam.cx/~wakaba/archive/2005/manakai/Markup#>,
   MDOMX => q<http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#>,  
   owl => q<http://www.w3.org/2002/07/owl#>,  
   pc => q<http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/PerlCode#>,  
   rdf => q<http://www.w3.org/1999/02/22-rdf-syntax-ns#>,  
   rdfs => q<http://www.w3.org/2000/01/rdf-schema#>,  
   swcfg21 => q<http://suika.fam.cx/~wakaba/archive/2005/swcfg21#>,  
   TreeCore => q<>,  
35    Util => q<http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/>,    Util => q<http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/>,
36  };  };
37    
# Line 60  use Message::Util::QName::Filter { Line 43  use Message::Util::QName::Filter {
43    
44  Whether assertion codes should be outputed or not.  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)  =item --for=I<for-uri> (Optional)
62    
63  Specifies the "For" URI reference for which the outputed module is.  Specifies the "For" URI reference for which the outputed module is.
# Line 91  Whether a verbose message mode should be Line 89  Whether a verbose message mode should be
89    
90  use Getopt::Long;  use Getopt::Long;
91  use Pod::Usage;  use Pod::Usage;
92  my %Opt;  my %Opt = (
93      create_module => [],
94    );
95  GetOptions (  GetOptions (
96      'create-perl-module=s' => sub {
97        shift;
98        push @{$Opt{create_module}}, [split /\s+/, shift, 3];
99      },
100    'enable-assertion!' => \$Opt{outputAssertion},    'enable-assertion!' => \$Opt{outputAssertion},
101    'for=s' => \$Opt{For},    'for=s' => \$Opt{For},
102    'help' => \$Opt{help},    'help' => \$Opt{help},
# Line 103  GetOptions ( Line 107  GetOptions (
107  pod2usage ({-exitval => 0, -verbose => 1}) if $Opt{help};  pod2usage ({-exitval => 0, -verbose => 1}) if $Opt{help};
108  $Opt{file_name} = shift;  $Opt{file_name} = shift;
109  pod2usage ({-exitval => 2, -verbose => 0}) unless $Opt{file_name};  pod2usage ({-exitval => 2, -verbose => 0}) unless $Opt{file_name};
110  pod2usage (2) unless $Opt{module_uri};  
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  ## TODO: Assertion control
141    
142  ## TODO: Verbose mode  use Message::Util::DIS::DNLite;
143    
144  my $impl = $Message::DOM::ImplementationRegistry->get_implementation  my $impl = $Message::DOM::ImplementationRegistry->get_implementation
145                 ({                 ({
# Line 118  my $impl = $Message::DOM::Implementation Line 150  my $impl = $Message::DOM::Implementation
150  my $pc = $impl->get_feature (ExpandedURI q<Util:PerlCode> => '1.0');  my $pc = $impl->get_feature (ExpandedURI q<Util:PerlCode> => '1.0');
151  my $di = $impl->get_feature (ExpandedURI q<DIS:Core> => '1.0');  my $di = $impl->get_feature (ExpandedURI q<DIS:Core> => '1.0');
152    
153  print STDERR qq<Loading the database "$Opt{file_name}"...>;  status_msg_ qq<Loading the database "$Opt{file_name}"...>;
154  my $db = $di->pl_load_dis_database ($Opt{file_name});  my $db = $di->pl_load_dis_database ($Opt{file_name});
155  print STDERR "done\n";  status_msg q<done>;
156    
157  my $mod = $db->get_module ($Opt{module_uri}, for_arg => $Opt{For});  for (@{$Opt{create_module}}) {
158  unless ($Opt{For}) {    my ($mod_uri, $out_file_path, $mod_for) = @$_;
159    $Opt{For} = $mod->get_property_text (ExpandedURI q<dis:DefaultFor>, undef);    
160    if (defined $Opt{For}) {    my $mod = $db->get_module ($mod_uri, for_arg => $mod_for);
161      $mod = $db->get_module ($Opt{module_uri}, for_arg => $Opt{For});    unless ($mod_for) {
162    } else {      $mod_for = $mod->get_property_text (ExpandedURI q<dis:DefaultFor>, undef);
163      my $el = $mod->source_element;      if (defined $mod_for) {
164      if ($el) {        $mod = $db->get_module ($mod_uri, for_arg => $mod_for);
       $Opt{For} = $el->default_for_uri;  
       $mod = $db->get_module ($Opt{module_uri}, for_arg => $Opt{For});  
165      }      }
166    }    }
167  }    unless ($mod->is_defined) {
168  unless ($mod->is_defined) {      die qq<$0: Module <$mod_uri> for <$mod_for> is not defined>;
169    die qq<$0: Module <$Opt{module_uri}> for <$Opt{For}> is not defined>;    }
 }  
   
 my $pl = $mod->pl_generate_perl_module_file;  
170    
171  my $output;    status_msg_ qq<Generating Perl module from <$mod_uri> for <$mod_for>...>;
172  defined $Opt{output_file_name}    my $pl = $mod->pl_generate_perl_module_file;
173        ? (open $output, '>', $Opt{output_file_name}    status_msg qq<done>;
174             or die "$0: $Opt{output_file_name}: $!")    
175      my $output;
176      defined $out_file_path
177          ? (open $output, '>', $out_file_path or die "$0: $out_file_path: $!")
178        : ($output = \*STDOUT);        : ($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  printf STDERR qq<Writing file "%s"...>,  status_msg_ "Checking undefined resources...";
   defined $Opt{output_file_name} ? $Opt{output_file_name} : '';  
 print $output $pl->stringify;  
 close $output;  
 print STDERR "done\n";  
   
 print STDERR "Checking undefined resources...";  
190  $db->check_undefined_resource;  $db->check_undefined_resource;
191  print STDERR "done\n";  status_msg q<done>;
192    
193  print STDERR "Closing the database...";  status_msg_ "Closing the database...";
194  $db->free;  $db->free;
195  undef $db;  undef $db;
196  print STDERR "done\n";  status_msg q<done>;
197    
198  =head1 SEE ALSO  =head1 SEE ALSO
199    
200  L<lib/Message/Util/DIS.dis> - The <QUOTE::dis> object implementation.  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.  L<lib/Message/Util/PerlCode.dis> - The Perl code generator.
206    
207  L<lib/manakai/DISCore.dis> - The definition for the "dis" format.  L<lib/manakai/DISCore.dis> - The definition for the "dis" format.
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.8
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24