Bio::Graphics::FeatureDir - A directory of feature files and conf files

 my $fd = Bio::Graphics::FeatureDir->new('/path/to/dir');
 $fd->add_file('tracks.conf');
 $fd->add_file('foo.gff3');
 $fd->add_file('foo.wig');
 $fd->add_fh(\*STDIN);

 my $option   = $fd->setting('EST' => 'bgcolor');
 my @features = $fd->get_features_by_name('M101');

package Bio::Graphics::FeatureDir;
# $Id: FeatureDir.pm,v 1.1 2009-06-04 22:00:49 lstein Exp $

use strict;
use warnings;
use base 'Bio::Graphics::FeatureFile';

use Bio::DB::SeqFeature::Store;
use File::Path;
use File::Spec;
use File::Basename 'basename';
use File::Temp 'tempdir','mktemp';
use Carp 'croak';

sub new {
    my $class = shift;
    my %args;
    if (@_ == 1) {
	%args = (-dir=>shift);
    } else {
	%args  = @_;
    }
    $args{-dir} ||= tempdir(CLEANUP=>1);
    delete $args{-file};
    delete $args{-text};

    my $self         = $class->SUPER::new(%args);
    $self->{dir}     = $args{-dir};
    $self->{verbose} = $args{-verbose};
    $self->_init_featuredb;
    $self->_init_conf;
    return $self;
}

sub _init_featuredb {
    my $self = shift;
    my $dir  = $self->dir;
    my $needs_init = $self->_maybe_create_dir($dir);
    my $index = File::Spec->catfile($dir,"indexes");
    $needs_init++ unless -e $index;

    my @args = (-adaptor => 'berkeleydb',
		-dir     => $dir,
		-write   => 1,
	);
    push @args,(-create   => 1) if $needs_init;
    push @args,(-verbose  => 1) if $self->{verbose};

    $self->{db} = Bio::DB::SeqFeature::Store->new(@args)
	or die "Couldn't initialize database";
    return $self->{db};
}

sub _init_conf {
    my $self        = shift;
    my $dir         = $self->dir;
    my $needs_init  = $self->_maybe_create_dir($dir);
    my $master_conf = File::Spec->catfile($dir,'indexes','master.conf');
    $needs_init++   unless -e $master_conf;
    if ($needs_init) {
	open my $fh,'>',$master_conf or die "$master_conf: $!";
	my $pack = __PACKAGE__;
	print $fh <<END;
[GENERAL]
description = Master configuration file created by $pack.

#include "../*.conf";
END
    close $fh;
    }
    $self->{conf} = Bio::Graphics::FeatureFile->new(-file=>$master_conf);
}

sub _maybe_create_dir {
    my $self = shift;
    my $dir  = shift || $self->{dir};
    unless (-e $dir && -d $dir) {
	mkpath($dir) or die "Couldn't create directory $dir: $!";
	return 1;
    }
    return;
}

sub dir {shift->{dir}}

sub conf {shift->{conf}}

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

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;
}

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;
}

1;