#!/usr/bin/perl -w use English; open (EMBOSSVERSION, "embossversion -full -auto -filter|") || die "Cannot run embossversion"; while () { if (/BaseDirectory: +(\S+)/) { $basedir = $1 } } close EMBOSSVERSION; open (ACDSTATS, "acdsyntax.acdstats") || die "Cannot open acdsyntax.acdstats"; while () { if (/^(\S+)\s+(\d+)/) { $t=$1; $acdstats{$t} = $2; $acdstatsdefa{$t} = {}; $acdstatsattr{$t} = {}; } elsif (/^\s+[*][*]\s+(\S+)\s+(\d+)/) { $acdstatsdefa{$t}{$1} = $2 } elsif (/^\s+(\S+)\s+(\d+)/) { $acdstatsattr{$t}{$1} = $2 } } close ACDSTATS; open (TABLE, ">test.html"); print TABLE "\n"; open (CONTENTS, ">content.html"); print CONTENTS " EMBOSS: AJAX Command Definition (ACD files)
AJAX Command Definition (ACD files)

 

ACD

"; $contentlevel=0; # read the entrails full output $itable = 0; %section = (); %acdtypes = (); %acdattr = (); %acdcalc = (); %acdqual = (); %acddefdefa = (); %acddefcomm = (); %acddeftype = (); %acdcomm = (); %stages = ( "ACD Types" => "TYPES", "ACD Application Qualifiers" => "QUALS", "ACD Default attributes" => "DEFATTR", "ACD Calculated attributes" => "CALCATTR", "Sequence input formats" => "SEQINPUT", "Sequence output formats" => "SEQOUTPUT", "Sequence types" => "SEQTYPE", "Sequence access methods" => "SEQACCESS", "Database attributes" => "DBATTR", "Resource attributes" => "RESATTR", "Alignment output formats" => "ALIGNOUTPUT", "Report output formats" => "REPORTOUTPUT", "Graphics devices" => "GRAPHDEV", "Other" => "OTHER" ); %sectionnames = ( "simple" => "Simple", "input" => "Input", "selection" => "Selection lists", "output" => "Output", "graph" => "Graphics", "other" => "" ); %typedef = ( "boolean" => "Y/N", ); %seqtype = ( "ANY" => "Nucleotide or protein", "NUC" => "Nucleotide only", "PRO" => "Protein only" ); sub doacdtypes() { my $attr; my $type; my $default; my $section; my $comment; $attr = 0; while ($line) { if ($line =~ /^[\}]/) {return 1} if ($line =~ /^ attributes [\{]$/) {$attr=1} if ($line =~ /^ qualifiers [\{]$/) {$attr=0} if ($line =~ /^ (\S+)\s+(\S+)\s+\"([^\"]*)\"$/) { $acd = $1; $section = $2; $comment = $3; $acdtypes{$acd} = $section; # print "\nacd '$acd' section '$section' comment '$comment'\n"; if (defined($section{$section})) { $section{$section} = "$section{$section} $acd"; } else { $section{$section} = "$acd"; } $acdcomm{$acd} = $comment; } if ($attr && $line =~ /^ (\S+)\s+(\S+)\s+\"([^\"]*)\"\s+\"([^\"]*)\"$/) { $attr = $1; $type = $2; $default = $3; $comment = $4; if ($comment =~ /default:(.+)$/) { $default = $1; $comment = $PREMATCH; } # print "attr '$attr' type '$type' default '$default' comment '$comment'\n"; if (defined($acdattr{$acd})) { $acdattr{$acd} = "$acdattr{$acd} $attr"; } else { $acdattr{$acd} = "$attr"; } $acdattrtype{"$acd\_$attr"} = $type; $acdattrcomm{"$acd\_$attr"} = $comment; $acdattrdefa{"$acd\_$attr"} = $default; } if (!$attr && $line =~ /^ (\S+)\s+(\S+)\s+\"([^\"]*)\"\s+\"([^\"]*)\"$/) { $qual = $1; $type = $2; $default = $3; $comment = $4; # print "qual '$qual' type '$type' default '$default' comment '$comment'\n"; if (defined($acdqual{$acd})) { $acdqual{$acd} = "$acdqual{$acd} $qual"; } else { $acdqual{$acd} = "$qual"; } $acdqualtype{"$acd\_$qual"} = $type; $acdqualcomm{"$acd\_$qual"} = $comment; $acdqualdefa{"$acd\_$qual"} = $default; } $line = <> ; } } sub doacddefattr() { my $attr; my $type; my $default; my $comment; while ($line) { if ($line =~ /^$/) {return 1} if ($line =~ /^ (\S+)\s+(\S+)\s+\"([^\"]*)\"\s+\"([^\"]*)\"$/) { $attr = $1; $type = $2; $default = $3; $comment = $4; # print "\ndefattr '$attr' type $type default '$default' comment '$comment'\n"; $acddeftype{$attr} = "$type"; $acddefdefa{$attr} = "$default"; $acddefcomm{$attr} = "$comment"; } $line = <> ; } } sub doacdcalcattr() { my $acd; my $attr; my $type; my $default; my $comment; while ($line) { if ($line =~ /^$/) {return 1} if ($line =~ /^ (\S+)$/) { $acd = $1; # print "\ncalcattr '$acd'\n"; } if ($line =~ /^ (\S+)\s+(\S+)\s+\"([^\"]*)\"\s+\"([^\"]*)\"$/) { $attr = $1; $type = $2; $default = $3; $comment = $4; # print "\ncalcattr '$acd' attr '$attr' type $type default '$default' comment '$comment'\n"; if (defined($acdcalc{$acd})) { $acdcalc{$acd} = "$acdcalc{$acd} $attr"; } else { $acdcalc{$acd} = "$attr"; } $acdcalctype{"$acd\_$attr"} = "$type"; $acdcalcdefa{"$acd\_$attr"} = "$default"; $acdcalccomm{"$acd\_$attr"} = "$comment"; } $line = <> ; } } sub doseqtypes() { my $attr; my $type; my $default; my $section; my $comment; my $cnt = 0; $attr = 0; while ($line) { if ($line =~ /^[\}]/) {return 1} if ($line =~ /^ (\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+\"([^\"]*)\"\s+\"([^\"]*)\"\s+\"([^\"]*)\"$/) { $type = $1; $gap = $2; $ambig = $3; $nucprot = $4; $from = $5; $to = $6; $comment = $7; push @seqtype, $type; $seqgap{$type} = $gap; $seqambig{$type} = $ambig; $seqnucprot{$type} = $nucprot; $seqfrom{$type} = $from; $seqto{$type} = $to; $seqcomm{$type} = $comment; } $line = <> ; } } sub doacdquals() { my $attr; my $type; my $default; my $section; my $comment; my $cnt = 0; $attr = 0; while ($line) { if ($line =~ /^$/) {return 1} if ($line =~ /^(\S+)\s+(\S+)\s+\"([^\"]*)\"\s+\"([^\"]*)\"$/) { $qual = $1; $type = $2; $default = $3; $comment = $4; push @qual, $qual; $qualtype{$qual} = $type; $qualdefa{$qual} = $default; $qualcomm{$qual} = $comment; } $line = <> ; } } sub dotabletypes($) { my ($title) = @_; $itable++; print TABLE " "; print TABLE " "; print TABLE " "; ### The default attributes section print TABLE " "; print TABLE " "; print TABLE " "; print TABLE " "; ### The sections, in order foreach $s ("simple", "input", "selection", "output", "graph", "other") { if (!defined($section{$s})) {next} print TABLE " "; foreach $a (split(" ", $section{$s})) { $comm = $acdcomm{$a}; print TABLE " "; ### Calculated attributes print TABLE " "; ### Specific attributes print TABLE " "; ### Associated qualifiers print TABLE " "; } print TABLE " "; } print TABLE "

Data type / Object

Description

Calculated Attributes

Specific Attributes

Command Line Qualifiers

All data types

 

All data types

 

"; foreach $x (sort(keys(%acddefdefa))) { $defa = $acddefdefa{$x}; $comm = $acddefcomm{$x}; if ($defa =~ /[(](.*)[)]/) {$defa = "$1"} else {$defa = "\"$defa\""} print TABLE "$x: $defa
\n"; } print TABLE "

 

$sectionnames{$s} types

$a

$comm

"; if (defined($acdcalc{$a})) { foreach $y (split(" ", $acdcalc{$a})) { $defa = $acdcalcdefa{"$a\_$y"}; $type = $acdcalctype{"$a\_$y"}; $comm = $acdcalccomm{"$a\_$y"}; print TABLE "$y ($type)
\n"; } } else {print TABLE " \n";} print TABLE "

"; if (defined($acdattr{$a})) { foreach $y (split(" ", $acdattr{$a})) { $defa = $acdattrdefa{"$a\_$y"}; $comm = $acdattrcomm{"$a\_$y"}; $type = $acdattrtype{"$a\_$y"}; if ($defa =~ /[(](.*)[)]/) {$defa = "$defa"} elsif ($type eq "string") {$defa = "\"$defa\""} print TABLE "$y: $defa
\n"; } } else {print TABLE " \n";} print TABLE "

"; if (defined($acdqual{$a})) { foreach $y (split(" ", $acdqual{$a})) { $defa = $acdqualdefa{"$a\_$y"}; $comm = $acdqualcomm{"$a\_$y"}; if ($defa =~ /[(](.*)[)]/) {$defa = "$1"} else {$defa = "\"$defa\""} print TABLE "$y: $defa
\n"; } } else {print TABLE " \n";} print TABLE "

 

Table $itable. $title

"; } sub dotabletypeattr($$) { my ($section,$title) = @_; my $a; $isubtable++; print TABLE " "; print TABLE " "; foreach $t (split(" ", $section{$s})) { $typename = $t; if (defined($acdattr{$t})) { foreach $a (split(" ", $acdattr{$t})) { $defa = $acdattrdefa{"$t\_$a"}; $comm = $acdattrcomm{"$t\_$a"}; $type = $acdattrtype{"$t\_$a"}; if (defined($typedef{$type})) { $typestring = "$typedef{$type}"; } else { $typestring = "$type"; } if ($defa =~ /[(](.*)[)]/) {$defa = "$defa"} elsif ($type eq "string") {$defa = "\"$defa\""} print TABLE " "; $typename = " "; } } } print TABLE "

Data type

Attribute definition

Description

$typename

$a: $typestring

$comm
Default: $defa
 

Table $itable\.$isubtable. $title

"; } sub dotablecalc($) { my ($title) = @_; my $a; $itable++; print TABLE " "; print TABLE " "; foreach $t (sort(keys(%acdattr))) { $typename = $t; if (defined($acdcalc{$t})) { foreach $a (split(" ", $acdcalc{$t})) { $defa = $acdcalcdefa{"$t\_$a"}; $comm = $acdcalccomm{"$t\_$a"}; $type = $acdcalctype{"$t\_$a"}; if (defined($typedef{$type})) { $typestring = "$typedef{$type}"; } else { $typestring = "$type"; } if ($defa =~ /[(](.*)[)]/) {$defa = "$defa"} elsif ($type eq "string") {$defa = "\"$defa\""} print TABLE " "; $typename = " "; } } } print TABLE "

Data type

Calculated attributes

Description

$typename

$a: $typestring

$comm
Default: $defa
 

Table $itable. $title

"; } sub dotableattrqual($$) { my ($s,$title) = @_; my $a; my $havequal; if (!defined($section{$s})) {return 0} $havequal = 0; foreach $t (split(" ", $section{$s})) { $typename = $t; if (defined($acdqual{$t})) { $havequal = 1; } } if (!$havequal) {return 0} $isubtable++; print TABLE " "; print TABLE " "; foreach $t (split(" ", $section{$s})) { $typename = $t; if (defined($acdqual{$t})) { foreach $q (split(" ", $acdqual{$t})) { $type = $acdqualtype{"$t\_$q"}; $comm = $acdqualcomm{"$t\_$q"}; $defa = $acdqualdefa{"$t\_$q"}; if (defined($typedef{$type})) { $typestring = "$typedef{$type}"; } else { $typestring = "$type"; } if ($defa =~ /[(](.*)[)]/) {$defa = "$defa"} elsif ($type eq "string") {$defa = "\"$defa\""} print TABLE " "; $typename = " "; } } } print TABLE "

Data type

Qualifier definition

Description

$typename

-$q: $typestring

$comm
Default: $defa
 

Table $itable\.$isubtable. $title

"; } sub dotableseq($) { my ($title) = @_; my $a; $itable++; print TABLE " "; print TABLE " "; foreach $t (@seqtype) { $gap = $seqgap{$t}; $ambig = $seqambig{$t}; $nucprot = $seqnucprot{$t}; $from = $seqfrom{$t}; $to = $seqto{$t}; $comm = $seqcomm{"$t"}; if ($gap eq "Yes") {$gaptext = "Kept"} else {$gaptext = "Removed"} $converttext = " "; if ($from ne "") { $converttext = ""; @convfrom = split(//, $from); @convto = split(//, $to); while ($cf = shift(@convfrom)) { $ct = shift(@convto); if ($cf !~ /[a-z]/) { if ($converttext ne "") {$converttext .= "
"} $converttext .= " '$cf'=>'$ct'"; } } } if (defined($seqtype{$nucprot})) {$nucprot = $seqtype{$nucprot}}; print TABLE " "; } print TABLE "

Value

Type(s)

Gaps

Ambiguity codes

Conversions

Description

$t

$nucprot

$gaptext

$ambig

$converttext

$comm
 

Table $itable. $title

"; } sub dotablegroups($) { my ($title) = @_; my $a; $itable++; print TABLE " "; print TABLE " "; foreach $g (sort (keys ( %groups ) ) ) { $grouplist = $groups{"$g"}; if ($grouplist eq "") { # top level group $comm = $groupcomm{"$g"}; print TABLE " "; } else { # second level group list $gtop = $g; foreach $gg (split(" ", $groups{"$g"})) { $comm = $groupcomm{"$g:$gg"}; print TABLE " "; $gtop = " "; } } } print TABLE "

Top Level

Second Level

Description

$g

 

$comm

$gtop

$gg

$comm
 

Table $itable. $title

"; } sub dotablequals($) { my ($title) = @_; my $a; $itable++; print TABLE " "; print TABLE " "; foreach $q (@qual) { $defa = $qualdefa{"$q"}; $comm = $qualcomm{"$q"}; $type = $qualtype{"$q"}; if (defined($typedef{$type})) { $typestring = "$typedef{$type}"; } else { $typestring = "$type"; } if ($defa =~ /[(](.*)[)]/) {$defa = "$defa"} elsif ($type eq "string") {$defa = "\"$defa\""} print TABLE " "; } print TABLE "

Qualifier definition

Description

-$q $typestring

$comm
Default: $defa
 

Table $itable. $title

"; } sub dotablequalvars($) { my ($title) = @_; my $a; $itable++; print TABLE " "; print TABLE " "; foreach $q (@qual) { $uqual = uc($q); $defa = $qualdefa{"$q"}; $comm = $qualcomm{"$q"}; $type = $qualtype{"$q"}; if (defined($typedef{$type})) { $typestring = "$typedef{$type}"; } else { $typestring = "$type"; } if ($defa =~ /[(](.*)[)]/) {$defa = "$defa"} elsif ($type eq "string") {$defa = "\"$defa\""} print TABLE " "; } print TABLE "

Environment variable

Global qualifier

Description

EMBOSS_$uqual

-$q

$comm
Default: $defa
 

Table $itable. $title

"; } sub dotableothervars($) { my ($title) = @_; my $a; $itable++; print TABLE " "; print TABLE " "; foreach $q (@qual) { $uqual = uc($q); $getvalue{$uqual} = "ACD"; } foreach $v (sort(keys(%getvalue))) { if ($getvalue{$v} eq "ACD") { $uv = lc($v); $comm = $qualcomm{$uv}; $type = $qualtype{$uv}; $defa = $qualdefa{$uv}; } else { $comm = $valuecomm{$v}; $type = $valuetype{$v}; $defa = $valuedefa{$v}; } if (!defined($type)) { print STDERR "Variable EMBOSS_$v undocumented in variables.standard\n"; $type = "unknown"; } if (!defined($defa)) {$defa = "unknown"} if (!defined($comm)) {$comm = "undocumented"} if (defined($typedef{$type})) { $typestring = "$typedef{$type}"; } else { $typestring = "$type"; } if ($defa =~ /[(](.*)[)]/) {$defa = "$defa"} elsif ($type eq "string") {$defa = "\"$defa\""} print TABLE " "; } print TABLE "

Environment variable

Type

Description

EMBOSS_$v

$type

$comm
Default: $defa
 

Table $itable. $title

"; } sub attrnumerically { $acdstatsattr{$t}{$b} <=> $acdstatsattr{$t}{$a} } sub defanumerically { $acdstatsdefa{$t}{$b} <=> $acdstatsdefa{$t}{$a} } ############################################## # Main body ############################################## $stage = ""; while ($line = <>) { chomp $line; $stage = ""; if ($line =~ /^\#\s*(\S.*)/) { if ($stages{$1}) { $stage = $stages{$1}; } else { $stage = "OTHER"; } while ($line =~ /^\#/) { $line = <>; } print "Reading $stage\n"; } if ($stage eq "TYPES") {doacdtypes();print "doacdtypes done\n"} if ($stage eq "DEFATTR") {doacddefattr();print "doacddefattr done\n"} if ($stage eq "CALCATTR") {doacdcalcattr();print "doacdcalcattr done\n"} if ($stage eq "SEQTYPE") {doseqtypes();print "doseqtypes done\n"} if ($stage eq "QUALS") {doacdquals();print "doacdquals done\n"} } open (GETVAL, "acdsyntax.getvalue") || die "Cannot open acdsyntax.getvalue"; while () { if (/^(\S+).*ajNamGetValue[CS]\s*[\(]\"([^\"]+)\"/) { $name=uc($2); $file = $1; $file =~ /\/([^\/.]+)[.]c:/; $module = $1; $getvalue{$name} = $module; } } close GETVAL; open (GETVALDEF, "$basedir/emboss/acd/variables.standard") || die "Cannot open $basedir/emboss/acd/variables.standard"; while () { if (/^(\S+)\s+(\S+)\s+\"([^\"]*)\"\s+\"([^\"]*)\"/) { $name=uc($1); $type = $2; $default = $3; $comment = $4; $valuetype{$name} = $type; $valuedefa{$name} = $default; $valuecomm{$name} = $comment; } } close GETVALDEF; open (GETGROUPS, "$basedir/emboss/acd/groups.standard") || die "Cannot open $basedir/emboss/acd/groups.standard"; while () { if (/^[\#]/) {next} if (/^(\S+)\s+(\S+)\s+(.*)/) { # $gterm=$1; $group=$2; $comment = $3; if ($group =~ /([^:]+):(.*)/) { $gtop = $1; $gname = $2; if (defined($groups{$gtop})) {$groups{$gtop} .= " $gname"} else {$groups{$gtop} = "$gname"} } else {$groups{$group} = ""} $groupcomm{$group} = $comment; } } close GETGROUPS; #foreach $x (sort(keys(%section))) { # print "Section $x $section{$x}\n"; #} #foreach $x (sort(keys(%acddefdefa))) { # print "Default $x $acddeftype{$x} $acddefdefa{$x} $acddefcomm{$x}\n"; #} #foreach $x (sort(keys(%acdattr))) { # print "ACD $x\n"; # if (defined($acdcalc{$x})) { # print " calc $acdcalc{$x}\n"; # } # if (defined($acdattr{$x})) { # print " attributes:\n"; # foreach $y (split(" ", $acdattr{$x})) { # $type = $acdattrtype{"$x\_$y"}; # $defa = $acdattrdefa{"$x\_$y"}; # $comm = $acdattrcomm{"$x\_$y"}; # print " $y $type $defa $comm\n"; # } # } # if (defined($acdqual{$x})) { # print " qualifiers:\n"; # foreach $y (split(" ", $acdqual{$x})) { # $type = $acdqualtype{"$x\_$y"}; # $defa = $acdqualdefa{"$x\_$y"}; # $comm = $acdqualcomm{"$x\_$y"}; # print " $y $type $defa $comm\n"; # } # } #} open (TEMPLATE, "$basedir/doc/manuals/acdsyntax-template.html") || die "Cannot open $basedir/doc/manuals/acdsyntax-template.html"; $lcnt=0; while (