~ubuntu-branches/ubuntu/precise/libxml-libxml-perl/precise-security

« back to all changes in this revision

Viewing changes to example/xml2pod.pl

  • Committer: Bazaar Package Importer
  • Author(s): Ardo van Rangelrooij
  • Date: 2002-02-16 22:33:54 UTC
  • Revision ID: james.westby@ubuntu.com-20020216223354-8zq3wlngmkrdexns
Tags: upstream-1.31
ImportĀ upstreamĀ versionĀ 1.31

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
#!/usr/bin/perl -w
 
2
use XML::LibXML;
 
3
use File::Path;
 
4
use File::Basename;
 
5
 
 
6
# (c) 2001 christian p. glahn
 
7
 
 
8
# This is an example how to use the DOM interface of XML::LibXML
 
9
# The script reads a XML File with a module specification. If the 
 
10
# module contains several classes, the script fetches them and stores
 
11
# the data into different POD Files. 
 
12
 
 
13
{
 
14
  my $xml_file = "example/libxml.xml";
 
15
 
 
16
  # init the file parser
 
17
  my $parser = XML::LibXML->new();
 
18
 
 
19
  my $target_dir = "XML-LibXML-${XML::LibXML::VERSION}/lib";
 
20
  if ( scalar @ARGV == 1 ){
 
21
    $xml_file = $ARGV[0];
 
22
  }
 
23
  elsif ( @ARGV == 2 ) {
 
24
      $xml_file = $ARGV[0];
 
25
      $target_dir = $ARGV[1];
 
26
  }
 
27
 
 
28
  # read the DOM
 
29
  my $dom    = $parser->parse_file( $xml_file );
 
30
 
 
31
  # get the ROOT Element of the DOM
 
32
  my $elem   = $dom->getDocumentElement();
 
33
 
 
34
  # test if the element has the correct node type ...
 
35
  if ( $elem->getType() == XML_ELEMENT_NODE ) {
 
36
 
 
37
    # ... and the correct name
 
38
    if ( $elem->getName() eq "module" ) {
 
39
 
 
40
      # find class definitions without XPath :-P
 
41
      foreach my $child ( $elem->getElementsByTagName("class") ) { 
 
42
        handle_class( $child, $target_dir ); # handle the class
 
43
      }
 
44
    }
 
45
    else {
 
46
      warn "ERROR> document is not a module! \n";
 
47
    }
 
48
  }
 
49
  else {
 
50
    warn "ERROR> not an element as root\n";
 
51
  }
 
52
}
 
53
 
 
54
sub endl() { "\n"; } # helper for c++ programmer ;)
 
55
 
 
56
sub handle_class {
 
57
  my $node = shift; # node to handle (<class ..>)
 
58
  my $target_dir = shift;
 
59
  
 
60
  my $name ="";         # for POD - NAME Section
 
61
  my $description = ""; # for POD - DESCRIPTION and SYNOPSIS Section
 
62
  my $version ="";      # for POD - VERSION Section 
 
63
  my $seealso ="";      # for POD - SEE ALSO Section
 
64
 
 
65
  # find the information for the different sections
 
66
  my $cld = undef; 
 
67
 
 
68
  # we'll ignore any other node than Element nodes!
 
69
  ( $cld ) = $node->getElementsByTagName( "short" );
 
70
  if( defined $cld ) {
 
71
    my $data = $cld->getFirstChild();
 
72
    if( $data && $data->getType == XML_TEXT_NODE ) {
 
73
      $name = "=head1 NAME".endl.endl.$node->getAttribute( "name" )." - ";
 
74
      $name .= $data->getData().endl.endl;
 
75
    }
 
76
  }
 
77
  
 
78
  ( $cld ) = $node->getElementsByTagName( "description" );
 
79
  if( defined $cld ) {
 
80
        # collect synopsis and descriptions
 
81
        $description = handle_descr( $cld );
 
82
  }
 
83
  
 
84
  ( $cld ) = $node->getElementsByTagName( "also" );
 
85
  if ( defined $cld  ) {
 
86
        # build the see also list.
 
87
        $seealso = "=head1 SEE ALSO".endl. endl;
 
88
        my $str  = "";
 
89
        foreach my $item ( $cld->getChildnodes() ) {
 
90
          if ( $item->getType == XML_ELEMENT_NODE && 
 
91
               $item->getName() eq "item" ) {
 
92
            $str .=", " if ( length $str );
 
93
            $str .= $item->getAttribute("name");
 
94
          }
 
95
        }
 
96
        $seealso .= $str. endl. endl;
 
97
  }
 
98
  ( $cld ) = $node->getElementsByTagName( "version" );
 
99
  if ( defined $cld ) {
 
100
        # handle VERSION information
 
101
        $version = "=head1 VERSION".endl.endl;
 
102
        if ( $cld->getFirstChild() ){
 
103
          $version .= $cld->getFirstChild()->getData() . endl. endl;
 
104
        }
 
105
  }
 
106
  
 
107
  # print the data to a separated POD File
 
108
  my $filename = $node->getAttribute("name");
 
109
  $filename =~ s/::/\//g;
 
110
  print("writing file: ${target_dir}/${filename}.pod\n");
 
111
  mkpath([dirname("${target_dir}/${filename}.pod")]);
 
112
  open FILE , "> ${target_dir}/${filename}.pod" ||
 
113
    do{
 
114
      warn "cannot open file...\n"; 
 
115
      return ; # don't proceed if there is no open descriptor
 
116
    };
 
117
  
 
118
  print FILE  $name. $description, $seealso, $version;
 
119
  close FILE;
 
120
}
 
121
 
 
122
sub handle_descr {
 
123
  my $node = shift;
 
124
  return "" if not $node;
 
125
  my ( @synop, @methods, $description );
 
126
 
 
127
  $description ="";
 
128
 
 
129
  my $child = $node->getFirstChild();
 
130
  while ( $child ) {
 
131
    if ( $child->getType() == XML_TEXT_NODE ) {
 
132
      my $s = $child->getData();
 
133
      if ( $s !~ /^[\s\n\r]*$/ ){ # if not only whitespaces ...
 
134
        $description .= $s;
 
135
      }
 
136
    }
 
137
    elsif( $child->getType == XML_ELEMENT_NODE ) {
 
138
      my $name = $child->getName();
 
139
      # translate bold and italic information for POD
 
140
      if( $name eq "b" || $name eq "i" ) {
 
141
        $description .= uc( $name )."<";
 
142
        $description .= $child->getFirstChild()->getData() . ">" ;
 
143
      }
 
144
      elsif ( $name eq "method" ) {
 
145
        push @synop, $child->getAttribute("synopsis") ;
 
146
        push @methods, $child;
 
147
      }
 
148
    }
 
149
    $child = $child->getNextSibling();
 
150
  }
 
151
 
 
152
  # ok, this look not very beautyfull ... :-|
 
153
  my $rv = "=head1 SYNOPSIS".endl. endl;
 
154
  $rv .= "  "."use ".$node->getParentNode()->getAttribute( "name" ) . ";";
 
155
  $rv .= endl. endl;
 
156
  # now print the synopsissies... 
 
157
  foreach ( @synop ) {
 
158
    $rv .= "  ". $_. endl; # print leading whitespace for the correct format in POD
 
159
  }
 
160
  $rv .= endl;
 
161
  
 
162
  $rv .= "=head1 DESCRIPTION". endl. endl;
 
163
  $description =~ s/([\s\n\r])[\s\n\r]*/$1/g;
 
164
  $description =~ s/^\s*//; $description =~ s/\s*$//;
 
165
      
 
166
 
 
167
  $rv .= $description. endl. endl;
 
168
  if ( scalar @methods ) { # handle the method list 
 
169
    $rv .= "=head2 Methods". endl.endl;
 
170
    $rv .= "=over 4".endl. endl;
 
171
    foreach my $mn ( @methods ) { 
 
172
      $rv .= handle_method( $mn ); 
 
173
    }
 
174
    $rv .= "=back". endl.endl;
 
175
  }
 
176
  return $rv;
 
177
}
 
178
 
 
179
sub handle_method {
 
180
  my $node = shift;
 
181
  return "" unless $node;
 
182
 
 
183
  my $rv = "=item B<".$node->getAttribute("name").">". endl. endl;
 
184
  my $child = $node->getFirstChild();
 
185
  my $str = "";
 
186
  while ( $child ) {
 
187
    if ( $child->getType() == XML_TEXT_NODE &&
 
188
         $child->getData() !~ /^[\s\n\r]*$/ ) {
 
189
        my $ds = $child->getData();
 
190
        $ds =~ s/([\s\n\r])[\s\n\r]*/$1/g;
 
191
        $ds =~ s/^\s*//; $ds =~ s/\s*$//; 
 
192
        $str .= " " if length $str;
 
193
        $str .= $ds;
 
194
    }
 
195
    elsif( $child->getType == XML_ELEMENT_NODE ) {
 
196
      my $n = $child->getName();
 
197
      if( $n eq "b" || $n eq "i" ) {
 
198
        $str .= " " if ( length $str );
 
199
        $str .= uc($n)."<".$child->getFirstChild()->getData().">" ;
 
200
      }
 
201
      elsif ( $n eq "example" ) {
 
202
 
 
203
        $rv .= $str .endl. endl;
 
204
        # if we found an example for a method we should display it as CODE! 
 
205
        # but if the CDATA section contains more than a line, this won't work 
 
206
        # anymore :-(
 
207
        $rv .= "  ". $child->getFirstChild()->getData(). endl.endl  ;
 
208
        $str = "";
 
209
      }
 
210
    }
 
211
    $child = $child->getNextSibling();
 
212
  }
 
213
  $rv .= $str .endl. endl if length $str;
 
214
  return $rv;
 
215
}