#!/usr/bin/perl #use File::ShareDir; #use File::Spec; use File::Basename; use IO::File; use IO::Dir; use XML::GDOME; use Getopt::Long; use Xmldoom::Definition; use Xmldoom::Definition::PerlModuleParser; use Xmldoom::Definition::SAXHandler qw( $OBJECT_NS $OBJECT_PERL_NS ); use Xmldoom::ORB::Definition; use Xmldoom; use strict; # for debugging use Data::Dumper; use Carp; $SIG{__DIE__} = sub { Carp::confess(@_); #Carp::confess; }; #sub get_template #{ # my $tpl_name = shift; # # # TODO: find a better way to do this! # if ( -e "share/tpl/$tpl_name.tpl" ) # { # return File::Spec->rel2abs("share/tpl/$tpl_name.tpl"); # } # # return File::ShareDir::dist_file('Xmldoom', "tpl/$tpl_name.tpl"); #} my $XMLDOOM_VERSION = $Xmldoom::VERSION; sub main_javascript { my $database_xml; my $objects_xml; my $prefix; my $output; GetOptions( 'database-xml|D:s' => \$database_xml, 'objects-xml|X:s' => \$objects_xml, 'namespace-prefix|N:s' => \$prefix, 'output|o:s' => \$output ); if ( not defined $database_xml or not defined $objects_xml ) { die "Must set both -D database.xml and -X objects.xml"; } if ( defined $output and not defined $prefix ) { die "Must define a namespace prefix with -N Namespace.Prefix when writting -o file.js"; } if ( defined $prefix and not defined $output ) { print "WARING: -N Namespace.Prefix option is ignored when not writting -o file.js\n"; } # load the Xmldoom data my $database = Xmldoom::Definition::parse_database_uri($database_xml); $database->parse_object_uri( $objects_xml ); my $json_def = Xmldoom::ORB::Definition::generate($database, 'json'); if ( defined $output ) { my ($basename, $tmp, $tmp) = fileparse( $output, qr/\.[^.]*/ ); my $header_text = << "EOF"; // // This file was automatically generated by xmldoom-generate $XMLDOOM_VERSION ! // dojo.provide('$prefix.$basename'); // // A JSON dump of the object definitions. // EOF my $fd = IO::File->new($output, 'w'); $fd->write($header_text); $fd->write("$prefix.$basename = '$json_def';\n\n"); $fd->close(); } else { print $json_def; } } sub main_object_xml { my $root_dir; my $output; GetOptions( 'root|recursive|r:s' => \$root_dir, 'output|o:s' => \$output ); if ( not defined $root_dir ) { $root_dir = "."; } my $comment = << "EOF"; EOF # create the main document my $initial_xml = "$comment"; my $doc = XML::GDOME->createDocFromString( $initial_xml ); my $root_node = $doc->getDocumentElement(); # pull all the object nodes recursively from perl modules in # the root directory. my @stack = ( [ $root_dir, IO::Dir->new($root_dir) ] ); while ( scalar @stack > 0 ) { my ($dirname, $dir) = @{pop @stack}; while ( my $fn = $dir->read() ) { if ( $fn eq '.' or $fn eq '..' ) { next; } elsif ( -d "$dirname/$fn" ) { # push the current what-not onto the stack push @stack, [ $dirname, $dir ]; # and descend into the next directory $dirname = "$dirname/$fn"; $dir = IO::Dir->new( $dirname ); } elsif ( $fn =~ /\.pm$/ ) { my $pm = Xmldoom::Definition::PerlModuleParser->new( "$dirname/$fn" ); # parse into an actual XML document $pm->create_documents(); # attach the object nodes to our master document foreach my $object_node ( @{$pm->get_object_nodes()} ) { $root_node->appendChild( $doc->importNode($object_node, 1) ); } } } } # make into a string #my $result_xml = $doc->toString(); my $result_xml = $doc->toString( GDOME_SAVE_LIBXML_INDENT ); # and then do something with it if ( defined $output ) { my $output_fd = IO::File->new( $output, 'w' ); $output_fd->write( $result_xml ); $output_fd->close(); } else { print $result_xml; } } sub main { my $mode = shift @ARGV; if ( $mode eq 'javascript' ) { main_javascript; } elsif ( $mode eq 'object-xml' ) { main_object_xml; } else { die "Unsupported mode: " . $mode; } } main;