#!/usr/bin/perl -w
use strict;

use CGI;
# use CGI::Carp qw ( fatalsToBrowser ); 
# must list XML::Structured after other modules or warnings occur
use lib 'lib/';
use XML::Structured;

# use XML::SAX, XML::NamespaceSupport; # not directly but we won't get far without it


# define the dtd for each type of file

# the CAL3D formats aren't strictly valid XML however taken seperately the
# header and content of the file are two seperate valid XML documents
# so we trick the parser into separating them

# header DTD, this describes the header record
my  $dtd_head = [ 'HEADER' => 'MAGIC','VERSION' ];
# xsf file DTD, this describes the various fields of the file
my  $dtd_xsf = [
        'SKELETON' =>
            'NUMBONES',
            'SCENEAMBIENTCOLOR',
            [[ 'BONE' =>
                'NAME',
                'NUMCHILDS',
                'ID',
                [],
                'TRANSLATION',
                'ROTATION',
                'LOCALTRANSLATION',
                'LOCALROTATION',
		'PARENTID',
                [ 'CHILDID' ],
            ]],
    ];

my  $dtd_xaf = [
        'ANIMATION' =>
            'NUMTRACKS',
            'DURATION',
            [[ 'TRACK' =>
                'BONEID',
                'TRANSLATIONREQUIRED',
                'TRANSLATIONISDYNAMIC',
                'HIGHRANGEREQUIRED',
                'NUMKEYFRAMES',
                [[ 'KEYFRAME' =>
                    'TIME',
                    [],
                    'TRANSLATION',
                    'ROTATION'
                ]],
            ]],
    ];

my  $dtd_xmf = [
        'MESH' =>
            'NUMSUBMESH',
            [['SUBMESH' =>
                'NUMVERTICES',
                'NUMFACES',
                'MATERIAL',
                'NUMLODSTEPS',
                'NUMSPRINGS',
                'NUMTEXCOORDS',
                [['vertex' =>
                    'ID',
                    'NUMINFLUENCES',
                    [],
                    'POS',
                    'NORM',
		    'COLOR',
                    'COLLAPSEID',
                    'COLLAPSECOUNT',
                    [ 'TEXCOORD' ],
                    [[ 'INFLUENCE' =>
                        'ID',
                        '_content'
		    ]],
                ]],
                [[ 'FACE' =>
                    'VERTEXID'
                ]],
            ]],
    ];

my  $dtd_xrf = [
        'MATERIAL' =>
           'NUMMAPS',
           [],
           'AMBIENT',
           'DIFFUSE',
           'SPECULAR',
           'SHININESS',
           [[ 'MAP' =>
              'TYPE',
              '_content'
           ]],
        ];  

# combine all the dtds into one super-dtd called 'BORK'

my  $dtd_bork= [ 'BORK' => $dtd_head,$dtd_xsf,$dtd_xaf,$dtd_xmf,$dtd_xrf,'_content'];


# a hash to map the header "magic" field to the appropriate DTD    
my   %dtd_list=('XSF' => $dtd_xsf,
	       'XAF' => $dtd_xaf,
	       'XMF' => $dtd_xmf,
               'XRF' => $dtd_xrf);

# start of cgi code:

# Using the OOP interface to CGI




my $query = new CGI; 

#test if the script was called without parameters
unless ( $query->param())
{
 print $query->header ( ); 
 print $query->start_html(-title=>'File upload test',
                          -author=>'boristheengineer');

 print $query->start_multipart_form();
 print $query->filefield(-name=>'infile',
	                    -default=>'starting value',
	                    -size=>50,
	 		    -maxlength=>80);
 print $query->submit( -label=>'Process file');

 print $query->endform;

 print $query->end_html;
 exit
}
my $filename = $query->param("infile"); 

if ( !$filename ) 
{ 
 print $query->header ( ); 
 print "There was a problem uploading your file (try a smaller file)."; 
 exit; 
} 


my $upload_filehandle = $query->upload("infile"); 

# read XML file using a "slurp" operation

my $rawdata = do { local( $/ ) ; <$upload_filehandle> } or do
{
 print $query->header ( ); 
 print $query->p('There was a problem reading your file');
 print $query->p("Error: $@") if $@;
 exit; 
}; 


my $data = eval { XMLin($dtd_bork,"<BORK>$rawdata</BORK>")} or do
{
 print $query->header ( ); 
 print $query->p('There was a problem parsing your file');
 print $query->p("Error: $@") if $@;
 exit; 
}; 

# at this point we have a hash with two records, one called 'HEADER' and the other
# called either SKELETON, ANIMATION, MESH, MATERIAL
# each record contains a pointer to the specific data

# look up what type of file we have
my $exten=$$data{"HEADER"} -> {"MAGIC"};
my $dtd=$dtd_list{$exten} or die("Bad file type");

$exten=lc($exten);

# print $query->header ( ); 
# print "Got this far... $exten\n"; 
# print "\nFile type: ".$dtd -> [0]."\n";

$rawdata = XMLout($dtd_head, $$data{"HEADER"}).XMLout($dtd, $$data{$dtd->[0]});

# bodge to force data into MSDOS format
$rawdata =~ s/\n/\x0d\x0a/g;
print $query->header (-type=>'text/plain',-attachment=>"file.$exten");

print $rawdata;

# foreach $str (@xrf) {print $str."\x0d\x0a"};