Commits

ph...@9ae0c189-cd1f-4510-a509-f4891f5cf20d  committed 020db57

Modified Files:
xml2pod.pl
o fixed code for better output

  • Participants
  • Parent commits 473abfa

Comments (0)

Files changed (1)

File example/xml2pod.pl

 
 # (c) 2001 christian p. glahn
 
-# This is an example how to use the DOM interface of XML::LibXML
-# The script reads a XML File with a module specification. If the 
-# module contains several classes, the script fetches them and stores
-# the data into different POD Files. 
+# This is an example how to use the DOM interface of XML::LibXML The
+# script reads a XML File with a module specification. If the module
+# contains several classes, the script fetches them and stores the
+# data into different POD Files.
 
-{
-  my $xml_file = "example/libxml.xml";
+my $xml_file = "example/libxml.xml";
 
-  # init the file parser
-  my $parser = XML::LibXML->new();
+# init the file parser
+my $parser = XML::LibXML->new();
 
-  my $target_dir = "XML-LibXML-${XML::LibXML::VERSION}/lib";
-  if ( scalar @ARGV == 1 ){
+my $target_dir = "XML-LibXML-${XML::LibXML::VERSION}/lib";
+if ( scalar @ARGV == 1 ){
     $xml_file = $ARGV[0];
-  }
-  elsif ( @ARGV == 2 ) {
-      $xml_file = $ARGV[0];
-      $target_dir = $ARGV[1];
-  }
+}
+elsif ( @ARGV == 2 ) {
+    $xml_file = $ARGV[0];
+    $target_dir = $ARGV[1];
+}
 
-  # read the DOM
-  my $dom    = $parser->parse_file( $xml_file );
+# read the DOM
+my $dom    = $parser->parse_file( $xml_file );
 
-  # get the ROOT Element of the DOM
-  my $elem   = $dom->getDocumentElement();
+# get the ROOT Element of the DOM
+my $elem   = $dom->getDocumentElement();
 
-  # test if the element has the correct node type ...
-  if ( $elem->getType() == XML_ELEMENT_NODE ) {
+# test if the element has the correct node type ...
+if ( $elem->getType() == XML_ELEMENT_NODE ) {
 
     # ... and the correct name
     if ( $elem->getName() eq "module" ) {
 
-      # find class definitions without XPath :-P
-      foreach my $child ( $elem->getElementsByTagName("class") ) { 
-        handle_class( $child, $target_dir ); # handle the class
-      }
+        # find class definitions without XPath :-P
+        foreach my $class ( $elem->getChildrenByTagName("package") ) {
+            handle_package( $class, $target_dir ); # handle the class
+        }
     }
     else {
-      warn "ERROR> document is not a module! \n";
+        warn "ERROR> document is not a module! \n";
     }
-  }
-  else {
+}
+else {
     warn "ERROR> not an element as root\n";
-  }
 }
 
-sub endl() { "\n"; } # helper for c++ programmer ;)
 
-sub handle_class {
-  my $node = shift; # node to handle (<class ..>)
-  my $target_dir = shift;
-  
-  my $name ="";         # for POD - NAME Section
-  my $description = ""; # for POD - DESCRIPTION and SYNOPSIS Section
-  my $version ="";      # for POD - VERSION Section 
-  my $seealso ="";      # for POD - SEE ALSO Section
+sub endl() { "\n\n"; } # helper for c++ programmer ;)
 
-  # find the information for the different sections
-  my $cld = undef; 
+sub handle_package {
+    my $node = shift; # node to handle (<class ..>)
+    my $target_dir = shift;
 
-  # we'll ignore any other node than Element nodes!
-  ( $cld ) = $node->getElementsByTagName( "short" );
-  if( defined $cld ) {
-    my $data = $cld->getFirstChild();
-    if( $data && $data->getType == XML_TEXT_NODE ) {
-      $name = "=head1 NAME".endl.endl.$node->getAttribute( "name" )." - ";
-      $name .= $data->getData().endl.endl;
+    # open traget file
+    my $fn = $node->getAttribute("name") . ".pod";
+    open(OSTDOUT , ">&STDOUT");
+    open(STDOUT,"> $target_dir/$fn")|| die "cannot create file $fn ($!)";
+
+    print "=head1 NAME" . endl;
+    print $node->getAttribute("name") . " - ";
+    my ( $tnode ) = $node->getChildrenByTagName( "short" );
+    print  $tnode->string_value;
+    my @methods = $node->getElementsByTagName( "method" );
+    if ( scalar @methods ) {
+        print endl . "=head1 synopsis" . endl;
+        print " use XML::LibXML". endl;
+
+        foreach my $m ( @methods ) {
+            print " " . $m->getAttribute( "synopsis" ) . "\n";
+        }
     }
-  }
-  
-  ( $cld ) = $node->getElementsByTagName( "description" );
-  if( defined $cld ) {
-	# collect synopsis and descriptions
-	$description = handle_descr( $cld );
-  }
-  
-  ( $cld ) = $node->getElementsByTagName( "also" );
-  if ( defined $cld  ) {
-	# build the see also list.
-	$seealso = "=head1 SEE ALSO".endl. endl;
-	my $str  = "";
-	foreach my $item ( $cld->getChildnodes() ) {
-	  if ( $item->getType == XML_ELEMENT_NODE && 
-	       $item->getName() eq "item" ) {
-	    $str .=", " if ( length $str );
-	    $str .= $item->getAttribute("name");
-	  }
-	}
-	$seealso .= $str. endl. endl;
-  }
-  ( $cld ) = $node->getElementsByTagName( "version" );
-  if ( defined $cld ) {
-	# handle VERSION information
-	$version = "=head1 VERSION".endl.endl;
-	if ( $cld->getFirstChild() ){
-	  $version .= $cld->getFirstChild()->getData() . endl. endl;
-	}
-  }
-  
-  # print the data to a separated POD File
-  my $filename = $node->getAttribute("name");
-  $filename =~ s/::/\//g;
-  print("writing file: ${target_dir}/${filename}.pod\n");
-  mkpath([dirname("${target_dir}/${filename}.pod")]);
-  open FILE , "> ${target_dir}/${filename}.pod" ||
-    do{
-      warn "cannot open file...\n"; 
-      return ; # don't proceed if there is no open descriptor
-    };
-  
-  print FILE  $name. $description, $seealso, $version;
-  close FILE;
+
+    print endl . "=head1 DESCRIPTION" . endl;
+    my $mflag = 0;
+    my ($dnode) = $node->getChildrenByTagName("description");
+    foreach $tnode ( $dnode->childNodes ) {
+        if ( $tnode->nodeName eq "p" ) {
+            handle_paragraph( $tnode );
+        }
+        if ( $tnode->nodeName eq "example" ) {
+            print $tnode->string_value();
+        }
+        if ( $tnode->nodeName eq "method" ) {
+            unless ( $mflag ) {
+                print endl . "=head2 Methods". endl . "=over 4" .endl;
+                $mflag = 1;
+            }
+            handle_method( $tnode );
+            print endl;
+        }
+        if ( $tnode->nodeName eq "section" ) {
+            handle_section( $tnode );
+        }
+    }
+    print "=back" . endl;
+
+    print "=head1 AUTHOR". endl;
+    print join ", ", map { $_->string_value } ($node->findnodes("/module/authors/author"));
+    print endl;
+
+    my @refs = $node->getElementsByTagName( "item" );
+    if ( scalar @refs ) {
+        print "=head1 SEE ALSO". endl;
+        print join ", ", map { $_->getAttribute("name") } @refs;
+        print endl;
+    }
+
+    print "=head1 VERSION". endl;
+    my ($version) = $node->findnodes( "/module/version" );
+    print $version->string_value . endl;
+    close(STDOUT);
+    *STDOUT = *OSTDOUT;
+    # open(STDOUT, ">&OSTDOUT");
 }
 
-sub handle_descr {
-  my $node = shift;
-  return "" if not $node;
-  my ( @synop, @methods, $description );
-
-  $description ="";
-
-  my $child = $node->getFirstChild();
-  while ( $child ) {
-    if ( $child->getType() == XML_TEXT_NODE ) {
-      my $s = $child->getData();
-      if ( $s !~ /^[\s\n\r]*$/ ){ # if not only whitespaces ...
-	$description .= $s;
-      }
+sub handle_paragraph {
+    my $node = shift;
+    foreach my $e ( $node->childNodes ) {
+        if ( $e->getType == XML_TEXT_NODE ) {
+            my $data;
+            ( $data = $e->string_value() ) =~ s/(\s)\s+/$1/g;
+            print $data;
+        }
+        if ( $e->getType == XML_ELEMENT_NODE ) {
+            if ( $e->nodeName eq "st" ) {
+                print "B<". $e->string_value .">";
+            }
+            elsif ( $e->nodeName eq "em" ) {
+                print "I<". $e->string_value .">";
+            }
+        }
     }
-    elsif( $child->getType == XML_ELEMENT_NODE ) {
-      my $name = $child->getName();
-      # translate bold and italic information for POD
-      if( $name eq "b" || $name eq "i" ) {
-	$description .= uc( $name )."<";
-	$description .= $child->getFirstChild()->getData() . ">" ;
-      }
-      elsif ( $name eq "method" ) {
-	push @synop, $child->getAttribute("synopsis") ;
-	push @methods, $child;
-      }
-    }
-    $child = $child->getNextSibling();
-  }
-
-  # ok, this look not very beautyfull ... :-|
-  my $rv = "=head1 SYNOPSIS".endl. endl;
-  $rv .= "  "."use ".$node->getParentNode()->getAttribute( "name" ) . ";";
-  $rv .= endl. endl;
-  # now print the synopsissies... 
-  foreach ( @synop ) {
-    $rv .= "  ". $_. endl; # print leading whitespace for the correct format in POD
-  }
-  $rv .= endl;
-  
-  $rv .= "=head1 DESCRIPTION". endl. endl;
-  $description =~ s/([\s\n\r])[\s\n\r]*/$1/g;
-  $description =~ s/^\s*//; $description =~ s/\s*$//;
-      
-
-  $rv .= $description. endl. endl;
-  if ( scalar @methods ) { # handle the method list 
-    $rv .= "=head2 Methods". endl.endl;
-    $rv .= "=over 4".endl. endl;
-    foreach my $mn ( @methods ) { 
-      $rv .= handle_method( $mn ); 
-    }
-    $rv .= "=back". endl.endl;
-  }
-  return $rv;
 }
 
 sub handle_method {
-  my $node = shift;
-  return "" unless $node;
+    my $node = shift;
+#    return "" unless $node;
 
-  my $rv = "=item B<".$node->getAttribute("name").">". endl. endl;
-  my $child = $node->getFirstChild();
-  my $str = "";
-  while ( $child ) {
-    if ( $child->getType() == XML_TEXT_NODE &&
-	 $child->getData() !~ /^[\s\n\r]*$/ ) {
-        my $ds = $child->getData();
-	$ds =~ s/([\s\n\r])[\s\n\r]*/$1/g;
-	$ds =~ s/^\s*//; $ds =~ s/\s*$//; 
-	$str .= " " if length $str;
-	$str .= $ds;
+    print "=item B<".$node->getAttribute("name").">". endl;
+    foreach my $tnode ( $node->childNodes ) {
+        if ( $tnode->nodeName eq "p" ) {
+            handle_paragraph( $tnode );
+        }
+        if ( $tnode->nodeName eq "example" ) {
+            print $tnode->string_value();
+        }
     }
-    elsif( $child->getType == XML_ELEMENT_NODE ) {
-      my $n = $child->getName();
-      if( $n eq "b" || $n eq "i" ) {
-	$str .= " " if ( length $str );
-	$str .= uc($n)."<".$child->getFirstChild()->getData().">" ;
-      }
-      elsif ( $n eq "example" ) {
+}
 
-	$rv .= $str .endl. endl;
-	# if we found an example for a method we should display it as CODE! 
-	# but if the CDATA section contains more than a line, this won't work 
-	# anymore :-(
-	$rv .= "  ". $child->getFirstChild()->getData(). endl.endl  ;
-	$str = "";
-      }
+sub handle_section {
+    my $node = shift;
+    print "=head2 ".$node->getAttribute("name"). endl;
+    foreach my $tnode ( $node->childNodes ) {
+        if ( $tnode->nodeName eq "p" ) {
+            handle_paragraph( $tnode );
+        }
+        if ( $tnode->nodeName eq "example" ) {
+            print $tnode->string_value();
+        }
     }
-    $child = $child->getNextSibling();
-  }
-  $rv .= $str .endl. endl if length $str;
-  return $rv;
 }