File Coverage

blib/lib/Bio/Das/Request/Feature2Segments.pm

Criterion	Covered	Total	%
statement	18	50	36.0
branch	0	12	0.0
condition	0	3	0.0
subroutine	6	12	50.0
pod	2	6	33.3
total	26	83	31.3

package Bio::Das::Request::Feature2Segments;
# $Id: Feature2Segments.pm,v 1.1 2004/01/03 21:12:36 lstein Exp $
# this module issues and parses the features command with the feature_id argument

=head1 NAME

Bio::Das::Request::Feature2Segments - Translate feature names into segments

=head1 SYNOPSIS

 my @segments             = $request->results;
 my $das_command          = $request->command;
 my $successful           = $request->is_success;
 my $error_msg            = $request->error;
 my ($username,$password) = $request->auth;

=head1 DESCRIPTION

This is a subclass of L<Bio::Das::Request> specialized for the
"features" command with specialized arguments that allow it to
translate a feature name into a segment of the genome.  It works by
issuing the DAS features command using a type of NULL (which is an
invalid feature type) and a feature_id argument.  It is used to
implement the Bio::Das->get_feature_by_name() method.

The results() method returns a series of L<Bio::Das::Segment> objects.
All other methods are as described in L<Bio::Das::Request>.  .

=head1 AUTHOR

Lincoln Stein <[e-mail]>.

Copyright (c) 2003 Cold Spring Harbor Laboratory

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.  See DISCLAIMER.txt for
disclaimers of warranty.

=head1 SEE ALSO

L<Bio::Das::Request::Features>, L<Bio::Das::Request>,
L<Bio::Das::HTTP::Fetch>, L<Bio::Das::Segment>, L<Bio::Das::Type>,
L<Bio::Das::Stylesheet>, L<Bio::Das::Source>, L<Bio::RangeI>

=cut

use strict;
use Bio::Das::Type;
use Bio::Das::Segment;
use Bio::Das::Request;
use Bio::Das::Util 'rearrange';

use vars '@ISA';
@ISA = 'Bio::Das::Request';

sub new {
  my $pack = shift;
  my ($dsn,$class,$features,$das,$callback) = rearrange([['dsn','dsns'],
							 'class',
							 ['feature','features'],
							 'das',
							 'callback',
							],@_);
  my $qualified_features;
  if ($class && $das) {
    my $typehandler = Bio::Das::TypeHandler->new;
    my $types = $typehandler->parse_types($class);
    for my $a ($das->aggregators) {
      $a->disaggregate($types,$typehandler);
    }
    my $names = ref($features) ? $features : [$features];
    for my $t (@$types) {
      for my $f (@$names) {
	push @$qualified_features,"$t->[0]:$f";
      }
    }
  } else {
    $qualified_features = $features;
  }

  my $self = $pack->SUPER::new(-dsn => $dsn,
			       -callback  => $callback,
			       -args => { feature_id   => $qualified_features,
					  type         => 'NULL',
					} );
  $self->das($das) if defined $das;
  $self;
}

sub command { 'features' }
sub das {
  my $self = shift;
  my $d    = $self->{das};
  $self->{das} = shift if @_;
  $d;
}

sub t_DASGFF {
  my $self = shift;
  my $attrs = shift;
  if ($attrs) {
    $self->clear_results;
  }
  delete $self->{tmp};
}

sub t_GFF {
  # nothing to do here
}

sub t_SEGMENT {
  my $self = shift;
  my $attrs = shift;
  if ($attrs) {    # segment section is starting
    $self->{tmp}{current_segment} = Bio::Das::Segment->new($attrs->{id},$attrs->{start},
							   $attrs->{stop},$attrs->{version},
							   $self->das,$self->dsn
							  );
  } else {
    $self->add_object($self->{tmp}{current_segment});
  }

}

1;