tests/examples/manual/extract.pl

   1 #!/usr/bin/perl
   2
   3 # extract code fragments from xml program listings
   4 # first argument: source code file to find
   5 # second argument: xml files to extract code from
   6
   7 # main
   8
   9 # decodes xml by translating &amp; &lt; &gt; back to what they should be
  10 # and also ignore
  11 # <![CDATA[ and ]]> and <!-- and -->
  12 sub
  13 xml_decode ($)
  14 {
  15   my $input = shift;
  16
  17   $input =~ s/\&amp;/&/g;
  18   $input =~ s/&lt;/</g;
  19   $input =~ s/&gt;/>/g;
  20
  21   if ($input =~ /<!\[CDATA\[/) { $input = ""; }
  22   if ($input =~ /]]>/) { $input = ""; }
  23   if ($input =~ /<!--/) { $input = ""; }
  24   if ($input =~ /-->/) { $input = ""; }
  25
  26   #print "Returning line $input";
  27   return $input;
  28 }
  29
  30 # main
  31 my $output = shift @ARGV;
  32 my $outputname;
  33
  34 # strip path parts
  35 if ($output =~ m/.*\/(.*)$/)
  36 {
  37   $outputname = $1;
  38 }
  39 else
  40 {
  41   $outputname = $output;
  42 }
  43
  44 $found = 0;
  45 %blocks = ();
  46
  47 foreach $file (@ARGV)
  48 {
  49   open FILE, $file or die "Cannot open file $file";
  50
  51   while ($line = <FILE>)
  52   {
  53     if ($line =~ /<!-- example-begin $outputname (.*?)-->/)
  54     {
  55       $found = 1;
  56       $block_id = $1;
  57       $block = "\n/*** block $block_id from $file ***/\n";
  58
  59       print "Extracting $outputname block $block_id from $file\n";
  60
  61       while ($line = <FILE>)
  62       {
  63         if ($line =~ /<!-- example-end $outputname (.*?)-->/)
  64         {
  65           last;
  66         }
  67         $block .= xml_decode ($line);
  68       }
  69       $blocks{$block_id} = $block;
  70     }
  71   }
  72 }
  73
  74
  75 if (!$found)
  76 {
  77   print "Could not find $outputname example !\n";
  78   exit(1);
  79 }
  80
  81 # now output all the blocks in the right order
  82 open OUTPUT, ">$output";
  83 @block_ids = keys %blocks;
  84 foreach $block_id (sort @block_ids)
  85 {
  86   print "Writing $output block $block_id\n";
  87   print OUTPUT $blocks{$block_id};
  88 }
  89 close OUTPUT;