← Back to branch summary

~ubuntu-branches/ubuntu/trusty/bioperl/trusty

« back to all changes in this revision

Viewing changes to Bio/DB/Query/HIVQuery.pm

  • Committer: Package Import Robot
  • Author(s): Charles Plessy
  • Date: 2013-09-22 13:39:48 UTC
  • mfrom: (3.1.11 sid)
  • Revision ID: package-import@ubuntu.com-20130922133948-c6z62zegjyp7ztou
Tags: 1.6.922-1
http://bugs.debian.org/722910
* New upstream release.
* Replaces and Breaks grinder (<< 0.5.3-3~) because of overlaping contents.
  Closes: #722910
* Stop Replacing and Breaking bioperl ( << 1.6.9 ): not needed anymore. 

Show diffs side-by-side

added added

removed removed

Lines of Context:
Bio/DB/Query/HIVQuery.pm
108
108
remember. Aliases are specified in an XML file (C<lanl-schema.xml>) that is part
109
109
of the distribution. Custom field aliases can be set up by modifying this file.
110
110
 
111
 
An HTML cheatsheet with valid field names, aliases, and match data can
112
 
be generated from the XML by using
113
 
C<hiv_object-E<gt>help('help.html')>. A query can also be validated
114
 
locally before it is unleashed on the server; see below.
 
111
An HTML cheatsheet with valid field names, aliases, and match data can be
 
112
generated from the XML by using C<hiv_object-E<gt>help('help.html')>. A query
 
113
can also be validated locally before it is unleashed on the server; see below.
115
114
 
116
115
=head2 Annotations
117
116
 
402
401
   my ($self, $fname) = @_;
403
402
   my (@ret, @tok);
404
403
   my $schema = $self->_schema;
405
 
   my $h = new CGI;
 
404
   my $h = CGI->new();
406
405
 
407
406
   my (@tbls, @flds, @als, @opts, $fh);
408
407
   if ($fname) {
429
428
       @flds = grep /^$tbl/, $schema->fields;
430
429
       @flds = grep !/_id/, @flds;
431
430
       print $fh (
432
 
           $h->start_Tr({-style=>"background-color: lightblue;"}), 
433
 
           $h->td([$h->a({-id=>$tbl},$tbl), $h->span({-style=>"font-style:italic"},"fields"), $h->span({-style=>"font-style:italic"}, "aliases")]),
434
 
           $h->end_Tr
435
 
           );
 
431
           $h->start_Tr({-style=>"background-color: lightblue;"}), 
 
432
           $h->td([$h->a({-id=>$tbl},$tbl), $h->span({-style=>"font-style:italic"},"fields"), $h->span({-style=>"font-style:italic"}, "aliases")]),
 
433
           $h->end_Tr
 
434
       );
436
435
       foreach my $fld (@flds) {
437
 
           @als = reverse $schema->aliases($fld);
438
 
           print $fh (
439
 
               $h->Tr( $h->td( ["", $h->a({-href=>"#opt$fld"}, shift @als), $h->code(join(',',@als))] ))
440
 
               );
441
 
       my @tmp = grep {$_} $schema->options($fld);
442
 
           @tmp = sort {(($a =~ /^[0-9]+$/) && $b =~ /^[0-9]+$/) ? $a<=>$b : $a cmp $b} @tmp;
443
 
           if (grep /Any/,@tmp) {
444
 
               @tmp = grep !/Any/, @tmp;
445
 
               unshift @tmp, 'Any';
446
 
           }
447
 
       #print STDERR join(', ',@tmp)."\n";
448
 
           push @opts, $h->div(
449
 
               {-style=>"font-family:sans-serif;font-size:small"},
450
 
               $h->hr,
451
 
               $h->a(
452
 
                   {-id=>"opt$fld"},
453
 
                   "<i>Valid options for</i> <b>$fld</b>: "),
454
 
               $h->blockquote(
455
 
                   @tmp ? $h->code(join(", ", @tmp)) : $h->i("free text")
456
 
               ),
457
 
               $h->span(
458
 
                   "<i>Other aliases</i>: "),
459
 
               $h->blockquote(
460
 
                   @als ? $h->code(join(",",@als)) : "<i>none</i>"
461
 
               ),
462
 
               " ", 
463
 
               $h->table( $h->Tr( 
464
 
                              $h->td([
465
 
                                  $h->a({-href=>"#$tbl"}, $h->small('BACK')), 
466
 
                                  $h->a({-href=>"#TOP"}, $h->small('TOP'))
467
 
                                     ]) ) )
468
 
               );
469
 
           
 
436
           @als = reverse $schema->aliases($fld);
 
437
           print $fh (
 
438
               # note that aliases can sometimes be empty
 
439
               $h->Tr( $h->td( ["", $h->a({-href=>"#opt$fld"}, shift @als || '???'), $h->code(join(',',@als))] ))
 
440
           );
 
441
           my @tmp = grep {$_} $schema->options($fld);
 
442
           @tmp = sort {(($a =~ /^[0-9]+$/) && $b =~ /^[0-9]+$/) ? $a<=>$b : $a cmp $b} @tmp;
 
443
           if (grep /Any/,@tmp) {
 
444
               @tmp = grep !/Any/, @tmp;
 
445
               unshift @tmp, 'Any';
 
446
           }
 
447
           #print STDERR join(', ',@tmp)."\n";
 
448
           push @opts, $h->div(
 
449
               {-style=>"font-family:sans-serif;font-size:small"},
 
450
               $h->hr,
 
451
               $h->a(
 
452
                   {-id=>"opt$fld"},
 
453
                   "<i>Valid options for</i> <b>$fld</b>: "
 
454
               ),
 
455
               $h->blockquote(
 
456
                   @tmp ? $h->code(join(", ", @tmp)) : $h->i("free text")
 
457
               ),
 
458
               $h->span(
 
459
                   "<i>Other aliases</i>: "
 
460
               ),
 
461
               $h->blockquote(
 
462
                   @als ? $h->code(join(",",@als)) : "<i>none</i>"
 
463
               ),
 
464
               " ", 
 
465
               $h->table(
 
466
                   $h->Tr(
 
467
                       $h->td([
 
468
                           $h->a({-href=>"#$tbl"}, $h->small('BACK')), 
 
469
                           $h->a({-href=>"#TOP"}, $h->small('TOP'))
 
470
                       ])
 
471
                   )
 
472
               )
 
473
           );
 
474
   
470
475
       }
471
476
   }
472
477
   print $fh $h->end_table;
526
531
    my $self = shift;
527
532
    my ($id, $ac) = @_;
528
533
    $id = "" unless defined $id; # avoid warnings
529
 
    $ac = new Bio::Annotation::Collection unless defined $ac;
 
534
    $ac = Bio::Annotation::Collection->new() unless defined $ac;
530
535
    $self->throw(-class=>'Bio::Root::BadParameter'
531
536
                 -text=>'Bio::Annotation::Collection required at arg 2',
532
537
                 -value=>"") unless ref($ac) eq 'Bio::Annotation::Collection';
1340
1345
        eval { # encapsulate communication errors here, defer biothrows...
1341
1346
        
1342
1347
        #mark the useragent should be setable from outside (so we can modify timeouts, etc)
1343
 
            my $ua = new Bio::WebAgent($self->_ua_hash);
 
1348
            my $ua = Bio::WebAgent->new($self->_ua_hash);
1344
1349
            my $idPing = $ua->get($self->_map_db_uri);
1345
1350
            $idPing->is_success || do {
1346
1351
                $response=$idPing; 
1479
1484
            @rec{@cols} = split /\t/;
1480
1485
            my $id = $rec{'se_id'};
1481
1486
            $self->add_id($id);
1482
 
            $ac = new Bio::Annotation::Collection();
 
1487
            $ac = Bio::Annotation::Collection->new();
1483
1488
            #create annotations
1484
1489
            foreach (@cols) {
1485
1490
                next if $_ eq '#';