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 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 objects. All other methods are as described in L. . =head1 AUTHOR Lincoln Stein . 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, L, L, L, L, L, L, L =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;