view release on metacpan or  search on metacpan

lib/Bio/Graphics/FeatureDir.pm  view on Meta::CPAN

sub db {
    my $self = shift;
    return $self->{db} ||= Bio::DB::SeqFeature::Store->new(
	-adaptor => 'berkeleydb',
	-dir     => $self->dir,
	-write   => 1);
}

=item $db->add_file($file)

Add the file to the directory. Can add files of type .fa, .gff, .gff3,
.conf and .ff.

=cut

sub add_file {
    my $self = shift;
    my $file = shift;
    my $basename = basename $file;
    open my $fh,$file or croak "Couldn't open $file: $!";
    $self->add_fh($fh,$basename);
    close $fh;
}

=item $db->add_fh(\*FILEHANDLE [,'name'])

Add the contents of the indicated filehandle to repository.  Name is
optional; if provided it will be used as the base for all files
created.

=cut

sub add_fh {
    my $self       = shift;
    my ($fh,$name) = @_;
    $name   =~ s/\.\w+$//; # get rid of extensions
    $name ||=  mktemp('XXXXXXXX');

    # status == unknown
    #           config
    #           gff3
    #           gff2
    #           ff
    #           wiggle
    #           fasta
    my ($status,$new_status);
    my $dir = $self->dir;
    my %splitter;
    
    while (<$fh>) {
	# figure out transitions
	$new_status = /^\#\#gff-version\s+3/i ? 'gff3'
	             :/^\#\#gff/i             ? 'gff2'
	             : /^track/i              ? 'wig'
		     : /^\[(.+)\]/i             ? 'conf'
		     : /^>\w+/i               ? 'fa'
		     : /^reference/i          ? 'ff'
		     : undef;

	unless ($status || $new_status) {  # guess what it is
	    my @tokens = split /\s+/;
	    $new_status = 'gff3' if @tokens >= 9 && $tokens[8] =~ /=/;
	    $new_status = 'ff'   if $tokens[2] =~ /\d+(\.\.|-)\d+/;
	}

	

	if ($new_status) {
	    # this will create a new conf file for each section
	    if ($new_status eq 'conf') {
		$splitter{conf} = Bio::Graphics::FileSplitter->new(
		    File::Spec->catfile($dir,"${name}.$1.${new_status}"));
	    }
	    else {
		$splitter{$new_status} ||= Bio::Graphics::FileSplitter->new(
		    File::Spec->catfile($dir,"${name}.${new_status}"));
	    }

	    $status = $new_status;
	}

	next unless $splitter{$status};
	$splitter{$status}->write($_);
    }
    undef %splitter;
    $self->db->auto_reindex($dir);
    $self->_init_conf;
}

package Bio::Graphics::FileSplitter;

sub new {
    my $class = shift;
    my $path  = shift;
    open my $fh,'>',$path or die "Could not open $path for writing: $!";
    return bless {fh=>$fh},ref $class || $class;
}
sub write {
    my $self = shift;
    $self->{fh}->print($_) foreach @_;
}
sub DESTROY {
    my $fh = shift->{fh};
    close $fh if $fh;
}

=cut

=head1 SEE ALSO

L<Bio::Graphics::Feature>,
L<Bio::Graphics::FeatureFile>

=head1 AUTHOR

Lincoln Stein E<lt>lincoln.stein@gmail.comE<gt>.

Copyright (c) 2009 Ontario Institute for Cancer Research

This package and its accompanying libraries is free software; you can