1# 2# BioPerl module for Bio::Tools::Run::EMBOSSacd 3# 4# 5# Please direct questions and support issues to <bioperl-l@bioperl.org> 6# 7# Cared for by Heikki Lehvaslaiho <heikki-at-bioperl-dot-org> 8# 9# Copyright Heikki Lehvaslaiho 10# 11# You may distribute this module under the same terms as perl itself 12 13# POD documentation - main docs before the code 14 15=head1 NAME 16 17Bio::Tools::Run::EMBOSSacd - class for EMBOSS Application qualifiers 18 19=head1 SYNOPSIS 20 21 # Get an EMBOSS factory 22 use Bio::Factory::EMBOSS; 23 $f = Bio::Factory::EMBOSS -> new(); 24 # Get an EMBOSS application object from the factory 25 $water = $f->program('water') || die "Program not found!\n"; 26 27 # Here is an example of running the application - water can 28 # compare 1 sequence against 1 or more sequences using Smith-Waterman. 29 # Pass a Sequence object and a reference to an array of objects. 30 31 my $wateroutfile = 'out.water'; 32 $water->run({-asequence => $seq_object, 33 -bsequence => \@seq_objects, 34 -gapopen => '10.0', 35 -gapextend => '0.5', 36 -outfile => $wateroutfile}); 37 38 # Now you might want to get the alignment 39 use Bio::AlignIO; 40 my $alnin = Bio::AlignIO->new(-format => 'emboss', 41 -file => $wateroutfile); 42 43 while ( my $aln = $alnin->next_aln ) { 44 # process the alignment -- these will be Bio::SimpleAlign objects 45 } 46 47=head1 DESCRIPTION 48 49The EMBOSSacd represents all the possible command line arguments that 50can be given to an EMBOSS application. 51 52Do not create this object directly. It will be created and attached to 53its corresponding Bio::Tools::Run::EMBOSSApplication if you set 54 55 $application->verbose > 0 56 57Call 58 59 $application->acd 60 61to retrive the Bio::Tools::Run::EMBOSSApplication::EMBOSSacd object. 62 63See also L<Bio::Tools::Run::EMBOSSApplication> and L<Bio::Factory::EMBOSS>. 64 65=head1 FEEDBACK 66 67=head2 Mailing Lists 68 69User feedback is an integral part of the evolution of this and other 70Bioperl modules. Send your comments and suggestions preferably to the 71Bioperl mailing lists Your participation is much appreciated. 72 73 bioperl-l@bioperl.org - General discussion 74 http://bioperl.org/wiki/Mailing_lists - About the mailing lists 75 76=head2 Support 77 78Please direct usage questions or support issues to the mailing list: 79 80I<bioperl-l@bioperl.org> 81 82rather than to the module maintainer directly. Many experienced and 83reponsive experts will be able look at the problem and quickly 84address it. Please include a thorough description of the problem 85with code and data examples if at all possible. 86 87=head2 Reporting Bugs 88 89report bugs to the Bioperl bug tracking system to help us keep track 90the bugs and their resolution. Bug reports can be submitted via the 91web: 92 93 http://redmine.open-bio.org/projects/bioperl/ 94 95=head1 AUTHOR - Heikki Lehvaslaiho 96 97Email: heikki-at-bioperl-dot-org 98Address: 99 100 EMBL Outstation, European Bioinformatics Institute 101 Wellcome Trust Genome Campus, Hinxton 102 Cambs. CB10 1SD, United Kingdom 103 104=head1 APPENDIX 105 106The rest of the documentation details each of the object 107methods. Internal methods are usually preceded with a _ 108 109=cut 110 111# Let the code begin... 112 113package Bio::Tools::Run::EMBOSSacd; 114use vars qw(@ISA %QUALIFIER_CATEGORIES $QUAL %OPT); 115 116use strict; 117use Data::Dumper; 118use Bio::Root::Root; 119 120@ISA = qw(Bio::Root::Root); 121 122BEGIN { 123 124 %QUALIFIER_CATEGORIES = 125 ( 126 'Mandatory qualifiers' => 'mandatory', 127 'Standard (Mandatory) qualifiers' => 'mandatory', 128 'Optional qualifiers' => 'optional', 129 'Additional (Optional) qualifiers'=> 'optional', 130 'Advanced qualifiers' => 'advanced', 131 'Advanced (Unprompted) qualifiers'=> 'advanced', 132 'Associated qualifiers' => 'associated', 133 'General qualifiers' => 'general', 134 ); 135 $QUAL; # qualifier category 136 137} 138 139 140=head2 new 141 142 Title : new 143 Usage : $emboss_prog->acd($prog_name); 144 Function: Constructor for the class. 145 Calls EMBOSS program 'acdc', converts the 146 HTML output into XML and uses XML::Twig XML 147 parser to write out a hash of qualifiers which is 148 then blessed. 149 Throws : without program name 150 Returns : new object 151 Args : EMBOSS program name 152 153=cut 154 155 156sub new { 157 my($class, $prog) = @_; 158 159 eval {require XML::Twig;}; 160 Bio::Root::Root->warn("You need XML::Twig for EMBOSS ACD parsing") 161 and return undef if $@; 162 163 Bio::Root::Root->throw("Need EMBOSSprogram name as an argument") 164 unless $prog; 165 # reset global hash 166 %OPT = (); 167 168 my $version = `embossversion -auto`; 169 my $file; 170 if ($version lt "2.8.0") { 171 # reading from EMBOSS program acdc stdout (prior to version 2.8.0) 172 $file = `acdc $prog -help -verbose -acdtable 2>&1`; 173 } else { 174 # reading from EMBOSS program acdtable stdout (version 2.8.0 or greater) 175 $file = `acdtable $prog -help -verbose 2>&1`; 176 } 177 178 # converting HTML -> XHTML for XML parsing 179 $file =~ s/border/border="1"/; 180 $file =~ s/=(\d+)/="$1"/g; 181 $file =~ s/<br>/<br><\/br>/g; 182 $file =~ s/ //g; 183 184 my $t = XML::Twig->new( TwigHandlers => 185 { 186 '/table/tr' => \&_row } 187 ); 188 189 $t->safe_parse( $file); 190 191 #Bio::Root::Root->throw("XML parsing error: $@"); 192 193 my %acd = %OPT; # copy to a private hash 194 $acd{'_name'} = $prog; 195 bless \%acd, $class; 196} 197 198sub _row { 199 my ($t, $row)= @_; 200 201 return if $row->text eq "(none)"; # no qualifiers in this category 202 203 my $name = $row->first_child; # qualifier name 204 205 my $namet = $name->text; 206 if ($namet =~ /qualifiers$/) { # set category 207 $QUAL = $QUALIFIER_CATEGORIES{$namet}; 208 if( ! defined $QUAL ) { 209 warn("-- namet is $namet\n"); 210 } 211 return; 212 } 213 my $unnamed = 0; 214 if ($namet =~ /\(Parameter (\d+)\)/) { # unnamed parameter 215 $unnamed = $1; 216 $namet =~ s/\(Parameter (\d+)\)//; 217 $namet =~ s/[\[\]]//g ; # name is in brackets 218 } 219 220 my $desc = $name->next_sibling; 221 my $values = $desc->next_sibling; 222 my $default = $values->next_sibling; 223 224 $OPT{$namet}{'unnamed'} = $unnamed; 225 $OPT{$namet}{'category'} = $QUAL; 226 $OPT{$namet}{'descr'} = $desc->text; 227 $OPT{$namet}{'values'} = $values->text; 228 $OPT{$namet}{'default'} = $default->text; 229 230 $t->purge; # to reduce memory requirements 231} 232 233=head2 name 234 235 Title : name 236 Usage : $embossacd->name 237 Function: sets/gets the name of the EMBOSS program 238 Setting is done by the EMBOSSApplication object, 239 you should only get it. 240 Throws : 241 Returns : name string 242 Args : None 243 244=cut 245 246sub name { 247 my ($self,$value) = @_; 248 if (defined $value) { 249 $self->{'_name'} = $value; 250 } 251 return $self->{'_name'}; 252} 253 254 255=head2 print 256 257 Title : print 258 Usage : $embossacd->print; $embossacd->print('-word'); 259 Function: Print out the qualifiers. 260 Uses Data::Dumper to print the qualifiers into STDOUT. 261 A valid qualifier name given as an argment limits the output. 262 Throws : 263 Returns : print string 264 Args : optional qualifier name 265 266=cut 267 268sub print { 269 my ($self, $value) = @_; 270 if ($value and $self->{$value}) { 271 print Dumper $self->{$value}; 272 } else { 273 print Dumper $self; 274 } 275} 276 277=head2 mandatory 278 279 Title : mandatory 280 Usage : $acd->mandatory 281 Function: gets a mandatory subset of qualifiers 282 Throws : 283 Returns : Bio::Tools::Run::EMBOSSacd object 284 Args : none 285 286=cut 287 288sub mandatory { 289 my ($self) = @_; 290 my %mand; 291 foreach my $key (keys %{$self}) { 292 next unless $key =~ /^-/; #ignore other attributes 293 294 $mand{$key} = $self->{$key} 295 if $self->{$key}{category} eq 'mandatory'; 296 } 297 bless \%mand; 298} 299 300=head2 Qualifier queries 301 302These methods can be used test qualifier names and read values. 303 304=cut 305 306=head2 qualifier 307 308 Title : qualifier 309 Usage : $acd->qualifier($string) 310 Function: tests for the existence of the qualifier 311 Throws : 312 Returns : boolean 313 Args : string, name of the qualifier 314 315=cut 316 317sub qualifier { 318 my ($self, $value) = @_; 319 320 $self->throw("Qualifier has to start with '-'") 321 unless $value =~ /^-/; 322 $self->{$value} ? 1 : 0 323} 324 325=head2 category 326 327 Title : category 328 Usage : $acd->category($qual_name) 329 Function: Return the category of the qualifier 330 Throws : 331 Returns : 'mandatory' or 'optional' or 'advanced' or 332 'associated' or 'general' 333 Args : string, name of the qualifier 334 335=cut 336 337sub category { 338 my ($self, $value) = @_; 339 340 $self->throw("Not a valid qualifier name [$value]") 341 unless $self->qualifier($value); 342 $self->{$value}->{'category'}; 343} 344 345=head2 values 346 347 Title : values 348 Usage : $acd->values($qual_name) 349 Function: Return the possible values for the qualifier 350 Throws : 351 Returns : string 352 Args : string, name of the qualifier 353 354=cut 355 356sub values { 357 my ($self, $value) = @_; 358 359 $self->throw("Not a valid qualifier name [$value]") 360 unless $self->qualifier($value); 361 $self->{$value}->{'values'}; 362 363} 364 365=head2 descr 366 367 Title : descr 368 Usage : $acd->descr($qual_name) 369 Function: Return the description of the qualifier 370 Throws : 371 Returns : boolean 372 Args : string, name of the qualifier 373 374=cut 375 376sub descr { 377 my ($self, $value) = @_; 378 379 $self->throw("Not a valid qualifier name [$value]") 380 unless $self->qualifier($value); 381 $self->{$value}->{'descr'}; 382 383} 384 385=head2 unnamed 386 387 Title : unnamed 388 Usage : $acd->unnamed($qual_name) 389 Function: Find if the qualifier can be left unnamed 390 Throws : 391 Returns : 0 if needs to be named, order number otherwise 392 Args : string, name of the qualifier 393 394=cut 395 396sub unnamed { 397 my ($self, $value) = @_; 398 399 $self->throw("Not a valid qualifier name [$value]") 400 unless $self->qualifier($value); 401 $self->{$value}->{'unnamed'}; 402 403} 404 405=head2 default 406 407 Title : default 408 Usage : $acd->default($qual_name) 409 Function: Return the default value for the qualifier 410 Throws : 411 Returns : scalar 412 Args : string, name of the qualifier 413 414=cut 415 416sub default { 417 my ($self, $value) = @_; 418 419 $self->throw("Not a valid qualifier name [$value]") 420 unless $self->qualifier($value); 421 $self->{$value}->{'default'}; 422} 423 424 4251; 426