doc/src/sgml/mk_feature_tables.pl

   1 # /usr/bin/perl
   2
   3 # doc/src/sgml/mk_feature_tables.pl
   4
   5 use strict;
   6 use warnings FATAL => 'all';
   7
   8 my $yesno = $ARGV[0];
   9
  10 open my $pack, '<', $ARGV[1] or die;
  11
  12 my %feature_packages;
  13
  14 while (<$pack>)
  15 {
  16         chomp;
  17         my ($fid, $pname) = split /\t/;
  18         if ($feature_packages{$fid})
  19         {
  20                 $feature_packages{$fid} .= ", $pname";
  21         }
  22         else
  23         {
  24                 $feature_packages{$fid} = $pname;
  25         }
  26 }
  27
  28 close $pack;
  29
  30 open my $feat, '<', $ARGV[2] or die;
  31
  32 print "<tbody>\n";
  33
  34 while (<$feat>)
  35 {
  36         chomp;
  37         my ($feature_id, $feature_name, $subfeature_id,
  38                 $subfeature_name, $is_supported, $comments) = split /\t/;
  39
  40         $is_supported eq $yesno || next;
  41
  42         $feature_name =~ s/</&lt;/g;
  43         $feature_name =~ s/>/&gt;/g;
  44         $subfeature_name =~ s/</&lt;/g;
  45         $subfeature_name =~ s/>/&gt;/g;
  46
  47         print " <row>\n";
  48
  49         if ($subfeature_id)
  50         {
  51                 print "  <entry>$feature_id-$subfeature_id</entry>\n";
  52         }
  53         else
  54         {
  55                 print "  <entry>$feature_id</entry>\n";
  56         }
  57         print "  <entry>",
  58           defined($feature_packages{$feature_id})
  59           ? $feature_packages{$feature_id}
  60           : "",
  61           "</entry>\n";
  62         if ($subfeature_id)
  63         {
  64                 print "  <entry>$subfeature_name</entry>\n";
  65         }
  66         else
  67         {
  68                 print "  <entry>$feature_name</entry>\n";
  69         }
  70         print "  <entry>$comments</entry>\n";
  71
  72         print " </row>\n";
  73 }
  74
  75 print "</tbody>\n";
  76
  77 close $feat;