package XML::Generator::FromDTD;
use strict;
use SGML::DTD;

sub makepackage {
    # all of this symbolic referencing makes me nervous. it's like disabling a wood chipper's saftey.
    no strict; 
    *{"$_[0]::new"}= 
    sub  {
        my $proto = shift;
        my $class = ref($proto) || $proto;
        my $self  = {};
        bless ($self, $class);
        return $self;
    } ;
}

sub sub_maker {
    my $s =shift; 
    my $attrlist = join " ",@{+shift};
    sub  {
        my $self = shift;
        my %attrs; 
        my @attrs;
        %attrs = %{+shift}if ref $_[0] eq "HASH" ;
        foreach my $thisattr(keys %attrs){
            # leave it in, so...
            warn "no attribute $thisattr\n" unless $attrlist=~/$thisattr/;
            
            # is there text?
            if ($attrs{$thisattr}) { 
            
                # if so, make foo="bar", 
                push @attrs,"$thisattr=\"". $attrs{$thisattr} ."\""
            } else {
                # otherwise, just add an attribute foo
                push @attrs,"$thisattr"
            }
        }
        # assemble attribute text
        my $attrtext = join (" ",@attrs);
        $attrtext= " ".$attrtext if $attrtext;
        
        # return an empty tag if there's no text to go with it.
        return "<$s$attrtext/>" if (@_ == 0);
        # if there's an arrayref, make a tag for each element
        # yes, anything after $_[0] gets ignored.
        
        if (ref ($_[0]) eq "ARRAY") {
            return join "", map {"<$s$attrtext>$_$s"} @{ $_[0] };
        }
        # otherwise, return the whole length of @_ inside a tag.
        return "<$s$attrtext>@_$s";
    }
}




sub createFromDTD {
    my ($fn, $packagename) = @_;
    my $dtd = new SGML::DTD;
    my %elements;
    open FH, $fn ||die $!;
    $dtd->read_dtd(\*FH) || die $!;
    # now that the file's been read and parsed by SGML::DTD object, 
    # begin the real work
    makepackage ($packagename);
    {
        no strict "refs";
        foreach ($dtd->get_elements()){
            
            # read in the attributes of each element
            my %hr = $dtd->get_elem_attr($_);         
            my @attributes;            
            my $hr;
            @attributes = keys %hr if (defined (%hr));
            
            # make a new sub in the user specified package
            # named after the current element
            *{"$packagename:".":$_"} =sub_maker ($_, $dtd->get_elem_attr, \@attributes);
            
            # create a list of attributes for later use
            # this hash is also used in the 'methods' method, below
            $elements {$_}=\@attributes;
        }    
        
        
        *{"$packagename:".":_methods"} = sub {return keys %{$_[0]->{_elements}} };
        
        *{"$packagename:".":_attributes"} = sub {
            my $self=$_[0];
            print "got $_[1]\n";
            return @{$self->{_elements}{$_[1]}}
        };
    }
    # finish off the newly created package
    my $tmp = new $packagename;
    $$tmp{_elements} = \%elements;
    return $tmp; 
}
return 1;