#!/usr/bin/perl -w 
use strict;
use Message::Util::QName::Filter {
  d => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis-->,
  dis2pm => q<http://suika.fam.cx/~wakaba/archive/2004/11/8/dis2pm#>,
  DOMCore => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#>,
  DOMMain => q<http://suika.fam.cx/~wakaba/archive/2004/dom/main#>,
  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#>,
  ManakaiDOM => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#>,
  owl => q<http://www.w3.org/2002/07/owl#>,
  rdf => q<http://www.w3.org/1999/02/22-rdf-syntax-ns#>,
  rdfs => q<http://www.w3.org/2000/01/rdf-schema#>,
};

use Getopt::Long;
use Pod::Usage;
my %Opt;
GetOptions (
  'for=s' => \$Opt{For},
  'help' => \$Opt{help},
  'verbose!' => $Opt{verbose},
) or pod2usage (2);
if ($Opt{help}) {
  pod2usage (0);
  exit;
}
$Opt{file_name} = shift;

BEGIN {
require 'manakai/genlib.pl';
require 'manakai/dis.pl';
}
our $State;
our $result = '';

eval q{
  sub impl_msg ($;%) {
    warn shift () . "\n";
  }
} unless $Opt{verbose};

sub perl_change_package (%) {
  my %opt = @_;
  my $fn = $opt{full_name};
  unless ($fn eq $State->{ExpandedURI q<dis2pm:currentPackage>}) {
    $State->{ExpandedURI q<dis2pm:currentPackage>} = $fn;
    return perl_statement qq<package $fn>;
  } else {
    return '';
  }
} # perl_change_package

$State->{DefaultFor} = $Opt{For};

my $source = dis_load_module_file (module_file_name => $Opt{file_name},
                                   For => $Opt{For},
                                   use_default_for => 1);
$State->{for_def_required}->{$State->{DefaultFor}} ||= 1;

dis_check_undef_type_and_for () unless $Opt{no_undef_check};

if (dis_uri_for_match (ExpandedURI q<ManakaiDOM:Perl>, $State->{DefaultFor})) {
  dis_perl_init ($source, For => $State->{DefaultFor});
}

$State->{ExpandedURI q<dis2pm:currentPackage>} = 'main';
$result .= "#!/usr/bin/perl \n";
$result .= perl_comment q<This file is automatically generated from> . "\n" .
                        q<"> . $Opt{file_name} . q<" at > .
                        rfc3339_date (time) . qq<.\n> .
                        q<Don't edit by hand!>;
$result .= perl_statement q<use strict>;
$result .= perl_change_package
                  (full_name => $State->{Module}->{$State->{module}}
                                      ->{ExpandedURI q<dis2pm:packageName>});
$result .= perl_statement
                 perl_assign
                      perl_var (type => '$', local_name => 'VERSION',
                                scope => 'our')
                   => perl_literal version_date time;

for my $pack (values %{$State->{Module}->{$State->{module}}
                             ->{ExpandedURI q<dis2pm:package>}||{}}) {
  next unless defined $pack->{Name};
  if ({
       ExpandedURI q<ManakaiDOM:Class> => 1,
       ExpandedURI q<ManakaiDOM:IF> => 1,
       ExpandedURI q<ManakaiDOM:ExceptionClass> => 1,
       ExpandedURI q<ManakaiDOM:ExceptionIF> => 1,
       ExpandedURI q<ManakaiDOM:WarningIF> => 1,
      }->{$pack->{ExpandedURI q<dis2pm:type>}}) {
    ## Package name and version
    $result .= perl_change_package
                  (full_name => $pack->{ExpandedURI q<dis2pm:packageName>});
    $result .= perl_statement
                 perl_assign
                      perl_var (type => '$', local_name => 'VERSION',
                                scope => 'our')
                   => perl_literal version_date time;
    ## Inheritance
    my @isa;
    for my $uri (@{$pack->{ISA}||[]}, @{$pack->{Implement}||[]}) {
      my $pack = $State->{Type}->{$uri};
      if (defined $pack->{ExpandedURI q<dis2pm:packageName>}) {
        push @isa, $pack->{ExpandedURI q<dis2pm:packageName>};
      } else {
        impl_msg ("Inheriting package name for <$uri> not defined",
                  node => $pack->{src}) if $Opt{verbose};
      }
    }
    $result .= perl_inherit \@isa;
    ## Members
    if ({
         ExpandedURI q<ManakaiDOM:Class> => 1,
         ExpandedURI q<ManakaiDOM:ExceptionClass> => 1,
         ExpandedURI q<ManakaiDOM:WarningClass> => 1,
        }->{$pack->{ExpandedURI q<dis2pm:type>}}) {
      for my $method (values %{$pack->{ExpandedURI q<dis2pm:method>}}) {
        next unless defined $method->{Name};
        if ($method->{ExpandedURI q<dis2pm:type>} eq
            ExpandedURI q<ManakaiDOM:DOMMethod>) {
          $result .= perl_sub
                       (name => $method->{ExpandedURI q<dis2pm:methodName>},
                        code => '');
        } elsif ($method->{ExpandedURI q<dis2pm:type>} eq
                 ExpandedURI q<ManakaiDOM:DOMAttribute>) {
          $result .= perl_sub
                       (name => $method->{ExpandedURI q<dis2pm:methodName>},
                        'prototype'
                            => (defined $method->{ExpandedURI q<dis2pm:setter>}
                                               ->{Name} ? '$;$' : '$'),
                        code => '');
        }
      } # package method
      ## TODO: Const
    }    
  ## TODO: Const
  } # root object
}

## Export
if (keys %{$State->{perl_primary_module}->{perl_export_ok}||{}}) {
  $result .= perl_change_package
               full_name => $State->{perl_primary_module}->{perl_package_name};
  $result .= perl_statement 'require Exporter';
  $result .= perl_inherit ['Exporter'];
  $result .= perl_statement
               perl_assign
                    perl_var (type => '@', scope => 'our',
                              local_name => 'EXPORT_OK')
                 => '(' . perl_list (keys %{$State->{perl_primary_module}
                                                  ->{perl_export_ok}}) . ')';
  if (keys %{$State->{perl_primary_module}->{perl_export_tags}||{}}) {
    $result .= perl_statement
                 perl_assign
                       perl_var (type => '%', scope => 'our',
                                 local_name => 'EXPORT_TAGS')
                   => '(' . perl_list (map {
                         $_ => [keys %{$State->{perl_primary_module}
                                             ->{perl_export_tags}->{$_}}]
                      } keys %{$State->{perl_primary_module}
                                     ->{perl_export_tags}}) . ')';
  }
}

$result .= perl_statement 1;

output_result $result;

1;