#!/usr/bin/perl -w use CGI; use XML::Parser; # use Data::Dump qw(dump); use LWP::UserAgent; use HTTP::Request; # use strict; # TBD move it into $schemaInfoRef so it would not be global my $q = new CGI; my $title = $q->param( 'title' ); my $style = $q->param( 'style' ); my $XML = $q->param( 'xml' ); my $schema = $q->param( 'schema' ); my $outline = $q->param( 'outline' ); my $scriptLoc = $q->param( 'generator' ); my $outputType = $q->param( 'outputType' ); my $wordbreak = $q->param( 'wordbreak' ); my $useLabel = !defined( $q->param( 'olderBrowser' )); my $usePopup = defined($q->param( 'popup' )) ? ' target="_blank"' : ''; # my $pathPrefix = 'http://192.168.0.5/'; my $pathPrefix = 'http://www.datamech.com/XMLForm/'; my $actionScript = $pathPrefix . 'formXML0200.pl'; my $dlTag = $useLabel ? ($outline ? 'fieldset' : 'div') : 'dl'; my $dtTag = $useLabel ? 'legend' : 'dt'; my $advanceEdit = $q->param( 'advanceEdit' ); my $dblclick = $advanceEdit ? ' onclick="selectelm(this, event);" ondblclick="selectelm(this, event);"': ''; my $langUsed = uc($ENV{'HTTP_ACCEPT_LANGUAGE'}); $langUsed =~ s/;.*//; my @langPref = split(',', $langUsed); my $userAgent = $ENV{'HTTP_USER_AGENT'}; if ($userAgent =~ m/Opera/) { $userAgent = 'Opera'; } elsif ($userAgent =~ m/MSIE/) { $userAgent = 'MSIE'; } elsif ($userAgent =~ m/Safari/) { $userAgent = 'Safari'; } else { $userAgent = 'Mozilla'; } my $idIndex = 1; my $xmlLoc = ''; print "Content-type: text/html\n\n"; #print '',"\n"; if ($userAgent eq 'MSIE') { print '',"\n"; } else { print '',"\n"; } print "\n
\n"; print '',"\n"; eval { &generateForm(); }; if ($@) { &printError(&stripLineNumber($@)); } #################################################################### # # general utilites # ##################################################################### # '#dt' datatype # '#cm' content model # '#ct' constraint # '#dd' like datatype but annoymous with just documentation # '#lc' list constrain # '#un' union # '#lt' listtype # '#al' all # '#ph' path # '#pt' pattern # '#em' enumeration sub stripLineNumber { $_[0] =~ s/at .*line.*$//; return $_[0]; } sub printError { print "\n"; print "\n"; print '