lib/Bio/Tools/Run/EMBOSSacd.pm

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