2020-04-13 17:55:45 +02:00
|
|
|
# /usr/bin/perl
|
2003-01-15 00:19:34 +01:00
|
|
|
|
2010-09-20 22:08:53 +02:00
|
|
|
# doc/src/sgml/mk_feature_tables.pl
|
2006-03-11 05:38:42 +01:00
|
|
|
|
2016-12-04 18:00:00 +01:00
|
|
|
use strict;
|
2020-04-13 17:55:45 +02:00
|
|
|
use warnings;
|
2016-12-04 18:00:00 +01:00
|
|
|
|
2003-01-15 00:19:34 +01:00
|
|
|
my $yesno = $ARGV[0];
|
|
|
|
|
2017-03-27 04:24:13 +02:00
|
|
|
open my $pack, '<', $ARGV[1] or die;
|
2003-01-15 00:19:34 +01:00
|
|
|
|
|
|
|
my %feature_packages;
|
|
|
|
|
2017-03-27 04:24:13 +02:00
|
|
|
while (<$pack>)
|
2012-07-05 03:47:49 +02:00
|
|
|
{
|
|
|
|
chomp;
|
|
|
|
my ($fid, $pname) = split /\t/;
|
|
|
|
if ($feature_packages{$fid})
|
|
|
|
{
|
|
|
|
$feature_packages{$fid} .= ", $pname";
|
|
|
|
}
|
|
|
|
else
|
|
|
|
{
|
|
|
|
$feature_packages{$fid} = $pname;
|
|
|
|
}
|
2003-01-15 00:19:34 +01:00
|
|
|
}
|
|
|
|
|
2017-03-27 04:24:13 +02:00
|
|
|
close $pack;
|
2003-01-15 00:19:34 +01:00
|
|
|
|
2017-03-27 04:24:13 +02:00
|
|
|
open my $feat, '<', $ARGV[2] or die;
|
2003-01-15 00:19:34 +01:00
|
|
|
|
|
|
|
print "<tbody>\n";
|
|
|
|
|
2017-03-27 04:24:13 +02:00
|
|
|
while (<$feat>)
|
2012-07-05 03:47:49 +02:00
|
|
|
{
|
|
|
|
chomp;
|
2023-05-19 23:24:48 +02:00
|
|
|
my ($feature_id, $feature_name, $subfeature_id,
|
2012-07-05 03:47:49 +02:00
|
|
|
$subfeature_name, $is_supported, $comments) = split /\t/;
|
|
|
|
|
|
|
|
$is_supported eq $yesno || next;
|
|
|
|
|
|
|
|
$feature_name =~ s/</</g;
|
|
|
|
$feature_name =~ s/>/>/g;
|
|
|
|
$subfeature_name =~ s/</</g;
|
|
|
|
$subfeature_name =~ s/>/>/g;
|
|
|
|
|
|
|
|
print " <row>\n";
|
|
|
|
|
|
|
|
if ($subfeature_id)
|
|
|
|
{
|
|
|
|
print " <entry>$feature_id-$subfeature_id</entry>\n";
|
|
|
|
}
|
|
|
|
else
|
|
|
|
{
|
|
|
|
print " <entry>$feature_id</entry>\n";
|
|
|
|
}
|
2020-04-14 01:54:09 +02:00
|
|
|
print " <entry>",
|
|
|
|
defined($feature_packages{$feature_id})
|
|
|
|
? $feature_packages{$feature_id}
|
|
|
|
: "",
|
|
|
|
"</entry>\n";
|
2012-07-05 03:47:49 +02:00
|
|
|
if ($subfeature_id)
|
|
|
|
{
|
|
|
|
print " <entry>$subfeature_name</entry>\n";
|
|
|
|
}
|
|
|
|
else
|
|
|
|
{
|
|
|
|
print " <entry>$feature_name</entry>\n";
|
|
|
|
}
|
|
|
|
print " <entry>$comments</entry>\n";
|
|
|
|
|
|
|
|
print " </row>\n";
|
2003-01-15 00:19:34 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
print "</tbody>\n";
|
|
|
|
|
2017-03-27 04:24:13 +02:00
|
|
|
close $feat;
|