view release on metacpan or  search on metacpan

lib/Bio/Tools/Run/EMBOSSacd.pm  view on Meta::CPAN

use Bio::Root::Root;

@ISA = qw(Bio::Root::Root);

BEGIN {

    %QUALIFIER_CATEGORIES =
	(
	 'Mandatory qualifiers'            => 'mandatory',
	 'Standard (Mandatory) qualifiers' => 'mandatory',
	 'Optional qualifiers'             => 'optional',
	 'Additional (Optional) qualifiers'=> 'optional',
	 'Advanced qualifiers'             => 'advanced',
	 'Advanced (Unprompted) qualifiers'=> 'advanced',
	 'Associated qualifiers'           => 'associated',
	 'General qualifiers'              => 'general',
	);
    $QUAL;			# qualifier category

}


=head2 new

 Title   : new
 Usage   : $emboss_prog->acd($prog_name);
 Function: Constructor for the class.
           Calls EMBOSS program 'acdc', converts the
           HTML output into XML and uses XML::Twig XML
           parser to write out a hash of qualifiers which is
           then blessed.
 Throws  : without program name
 Returns : new object
 Args    : EMBOSS program name

=cut


sub new {
    my($class, $prog) = @_;

    eval {require XML::Twig;};
    Bio::Root::Root->warn("You need XML::Twig for EMBOSS ACD parsing")
	    and return undef if $@;

    Bio::Root::Root->throw("Need EMBOSSprogram name as an argument")
	     unless $prog;
    # reset global hash
    %OPT = ();

    my $version = `embossversion -auto`;
    my $file;
    if ($version lt "2.8.0") {
	# reading from EMBOSS program acdc stdout (prior to version 2.8.0)
	$file = `acdc $prog -help -verbose -acdtable 2>&1`;
    } else {
	# reading from EMBOSS program acdtable stdout (version 2.8.0 or greater)
	$file = `acdtable $prog -help -verbose 2>&1`;
    }

    # converting HTML -> XHTML for XML parsing
    $file =~ s/border/border="1"/;
    $file =~ s/=(\d+)/="$1"/g;
    $file =~ s/<br>/<br><\/br>/g;
    $file =~ s/&nbsp;//g;

    my $t = XML::Twig->new( TwigHandlers =>
			   {
			       '/table/tr' => \&_row  }
			   );

    $t->safe_parse( $file);

    #Bio::Root::Root->throw("XML parsing error: $@");

    my %acd = %OPT; # copy to a private hash
    $acd{'_name'} = $prog;
    bless \%acd, $class;
}

sub _row {
    my ($t, $row)= @_;

    return if $row->text eq "(none)"; #  no qualifiers in this category

    my $name = $row->first_child; # qualifier name

    my $namet = $name->text;
    if ($namet =~ /qualifiers$/) { # set category
	$QUAL = $QUALIFIER_CATEGORIES{$namet};
	if( ! defined $QUAL ) {
	    warn("-- namet is $namet\n");
	}
	return;
    }
    my $unnamed = 0;
    if ($namet =~ /\(Parameter (\d+)\)/) { # unnamed parameter
	$unnamed = $1;
	$namet =~ s/\(Parameter (\d+)\)//;
	$namet =~ s/[\[\]]//g ; # name is in brackets
    }

    my $desc = $name->next_sibling;
    my $values = $desc->next_sibling;
    my $default = $values->next_sibling;

    $OPT{$namet}{'unnamed'} = $unnamed;
    $OPT{$namet}{'category'} = $QUAL;
    $OPT{$namet}{'descr'} = $desc->text;
    $OPT{$namet}{'values'} = $values->text;
    $OPT{$namet}{'default'} = $default->text;

    $t->purge;			# to reduce memory requirements
}

=head2 name

 Title   : name
 Usage   : $embossacd->name
 Function: sets/gets the name of the EMBOSS program
           Setting is done by the EMBOSSApplication object,