Bio-Cluster

 view release on metacpan or  search on metacpan

lib/Bio/Cluster/ClusterFactory.pm  view on Meta::CPAN

# POD documentation - main docs before the code

=head1 NAME

Bio::Cluster::ClusterFactory - Instantiates a new Bio::ClusterI (or derived class) through a factory

=head1 SYNOPSIS

    use Bio::Cluster::ClusterFactory;
    # if you don't provide a default type, the factory will try
    # some guesswork based on display_id and namespace
    my $factory = Bio::Cluster::ClusterFactory->new(-type => 'Bio::Cluster::UniGene');
    my $clu = $factory->create_object(-description => 'NAT',
                                      -display_id  => 'Hs.2');


=head1 DESCRIPTION

This object will build L<Bio::ClusterI> objects generically.

=head1 FEEDBACK

lib/Bio/Cluster/ClusterFactory.pm  view on Meta::CPAN

use base qw(Bio::Factory::ObjectFactory);

=head2 new

 Title   : new
 Usage   : my $obj = Bio::Cluster::ClusterFactory->new();
 Function: Builds a new Bio::Cluster::ClusterFactory object
 Returns : Bio::Cluster::ClusterFactory
 Args    : -type => string, name of a ClusterI derived class.
                    If not provided, the factory will have to guess
                    from ID and namespace, which may or may not be
                    successful.

=cut

sub new {
    my($class,@args) = @_;

    my $self = $class->SUPER::new(@args);

lib/Bio/Cluster/ClusterFactory.pm  view on Meta::CPAN

           -description => description of the cluster
           -members     => arrayref, members of the cluster

=cut

sub create_object {
   my ($self,@args) = @_;

   my $type = $self->type();
   if(! $type) {
       # we need to guess this
       $type = $self->_guess_type(@args);
       $self->throw("No cluster type set and unable to guess.") unless $type;
       $self->type($type);
   }
   return $type->new(-verbose => $self->verbose, @args);
}

=head2 _guess_type

 Title   : _guess_type
 Usage   :
 Function: Guesses the right type of L<Bio::ClusterI> implementation
           based on initialization parameters for the prospective
           object.
 Example :
 Returns : the type (a string, the module name)
 Args    : initialization parameters to be passed to the prospective
           cluster object


=cut

sub _guess_type{
    my ($self,@args) = @_;
    my $type;

    # we can only guess from a certain number of arguments
    my ($dispid, $ns, $members) =
	$self->_rearrange([qw(DISPLAY_ID
			      NAMESPACE
			      MEMBERS
			      )], @args);
    # Unigene namespace or ID?
    if($ns && (lc($ns) eq "unigene")) {
	$type = 'Bio::Cluster::UniGene';
    } elsif($dispid && ($dispid =~ /^Hs\.[0-9]/)) {
	$type = 'Bio::Cluster::UniGene';

lib/Bio/ClusterIO.pm  view on Meta::CPAN

    # object?
    if( $class =~ /Bio::ClusterIO::(\S+)/ ) {
	my ($self) = $class->SUPER::new(@args);	
	$self->_initialize(@args);
	return $self;
    } else { 

	my %param = @args;
	@param{ map { lc $_ } keys %param } = values %param; # lowercase keys
	my $format = $param{'-format'} || 
	    $class->_guess_format( $param{-file} || $ARGV[0] );
	$format = "\L$format";	# normalize capitalization to lower case

	return unless( $class->_load_format_module($format) );
	return "Bio::ClusterIO::$format"->new(@args);
    }
}

=head2 format

 Title   : format

lib/Bio/ClusterIO.pm  view on Meta::CPAN

  if ( $@ ) {
    print STDERR <<END;
$self: could not load $format - for more details on supported formats please see the ClusterIO docs
Exception $@
END
  ;
  }
  return $ok;
}

=head2 _guess_format

 Title   : _guess_format
 Usage   : $obj->_guess_format($filename)
 Function: guess format based on file suffix
 Example :
 Returns : guessed format of filename (lower case)
 Args    :
 Notes   : formats that _filehandle() will guess include unigene and dbsnp

=cut

sub _guess_format {
   my $class = shift;
   return unless $_ = shift;
   return 'unigene'   if /\.(data)$/i;
   return 'dbsnp'     if /\.(xml)$/i;
}

sub DESTROY {
    my $self = shift;

    $self->close();