File Coverage

lib/Bio/Graphics/FeatureFile.pm

Criterion	Covered	Total	%
statement	139	656	21.1
branch	38	410	9.2
condition	9	199	4.5
subroutine	28	94	29.7
pod	38	66	57.5
total	252	1425	17.6

package Bio::Graphics::FeatureFile;

# This package parses and renders a simple tab-delimited format for features.
# It is simpler than GFF, but still has a lot of expressive power.
# See __END__ for the file format

=head1 NAME

Bio::Graphics::FeatureFile -- A set of Bio::Graphics features, stored in a file

=head1 SYNOPSIS

 use Bio::Graphics::FeatureFile;
 my $data  = Bio::Graphics::FeatureFile->new(-file => 'features.txt');


 # create a new panel and render contents of the file onto it
 my $panel = $data->new_panel;
 my $tracks_rendered = $data->render($panel);

 # or do it all in one step
 my ($tracks_rendered,$panel) = $data->render;

 # for more control, render tracks individually
 my @feature_types = $data->types;
 for my $type (@feature_types) {
    my $features = $data->features($type);
    my %options  = $data->style($type);
    $panel->add_track($features,%options);  # assuming we have a Bio::Graphics::Panel
 }

 # get individual settings
 my $est_fg_color = $data->setting(EST => 'fgcolor');

 # or create the FeatureFile by hand

 # add a type
 $data->add_type(EST => {fgcolor=>'blue',height=>12});

 # add a feature
 my $feature = Bio::Graphics::Feature->new(
                                             # params
                                          ); # or some other SeqI
 $data->add_feature($feature=>'EST');

=head1 DESCRIPTION

The Bio::Graphics::FeatureFile module reads and parses files that
describe sequence features and their renderings.  It accepts both GFF
format and a more human-friendly file format described below.  Once a
FeatureFile object has been initialized, you can interrogate it for
its consistuent features and their settings, or render the entire file
onto a Bio::Graphics::Panel.

This module is a precursor of Jason Stajich's
Bio::Annotation::Collection class, and fulfills a similar function of
storing a collection of sequence features.  However, it also stores
rendering information about the features, and does not currently
follow the CollectionI interface.

=head1 The File Format

There are two types of entry in the file format: feature entries, and
formatting entries.  They can occur in any order.  See the Appendix
for a full example.

=head2 Formatting Entries

Formatting entries are in the form:

 [Stanza Name]
 option1 = value1
 option2 = value2
 option3 = value3

 [Stanza Name 2]
 option1 = value1
 option2 = value2
 ...

There can be zero or more stanzas, each with a unique name. The names
can contain any character except the [] characters. Each stanza
consists of one or more option = value pairs, where the option and the
value are separated by an "=" sign and optional whitespace. Values can
be continued across multiple lines by indenting the continuation lines
by one or more spaces, as in:

 [Named Genes]
 feature = gene
 glyph   = transcript2
 description = These are genes that have been named
   by the international commission on gene naming
   (The Hague).

Typically configuration stanzas will consist of several Bio::Graphics
formatting options. A -option=>$value pair passed to
Bio::Graphics::Panel->add_track() becomes a "option=value" pair in the
feature file.

=head2 Feature Entries

Feature entries can take several forms.  At their simplest, they look
like this:

 Gene	B0511.1	Chr1:516..11208

This means that a feature of type "Gene" and name "B0511.1" occupies
the range between bases 516 and 11208 on a sequence entry named
Chr1. Columns are separated using whitespace (tabs or spaces).
Embedded whitespace can be escaped using quote marks or backslashes:

 Gene "My Favorite Gene" Chr1:516..11208

=head2 Specifying Positions and Ranges

A feature position is specified using a sequence ID (a genbank
accession number, a chromosome name, a contig, or any other meaningful
reference system, followed by a colon and a position range. Ranges are
two integers separated by double dots or the hyphen. Examples:
"Chr1:516..11208", "ctgA:1-5000". Negative coordinates are allowed, as
in "Chr1:-187..1000".

A discontinuous range ("split location") uses commas to separate the
ranges.  For example:

 Gene B0511.1  Chr1:516..619,3185..3294,10946..11208

In the case of a split location, the sequence id only has to appear in
front of the first range.

Alternatively, a split location can be indicated by repeating the
features type and name on multiple adjacent lines:

 Gene	B0511.1	Chr1:516..619
 Gene	B0511.1	Chr1:3185..3294
 Gene	B0511.1	Chr1:10946..11208

If all the locations are on the same reference sequence, you can
specify a default chromosome using a "reference=<seqid>":

 reference=Chr1
 Gene	B0511.1	516..619
 Gene	B0511.1	3185..3294
 Gene	B0511.1	10946..11208

The default seqid is in effect until the next "reference" line
appears.

=head2 Feature Tags

Tags can be added to features by adding a fourth column consisting of
"tag=value" pairs:

 Gene  B0511.1  Chr1:516..619,3185..3294 Note="Putative primase"

Tags and their values take any form you want, and multiple tags can be
separated by semicolons. You can also repeat tags multiple times:

 Gene  B0511.1  Chr1:516..619,3185..3294 GO_Term=GO:100;GO_Term=GO:2087

Several tags have special meanings:

 Tag     Meaning
 ---     -------

 Type    The primary tag for a subfeature.
 Score   The score of a feature or subfeature.
 Phase   The phase of a feature or subfeature.
 URL     A URL to link to (via the Bio::Graphics library).
 Note    A note to attach to the feature for display by the Bio::Graphics library.

For example, in the common case of an mRNA, you can use the "Type" tag
to distinguish the parts of the mRNA into UTR and CDS:

 mRNA B0511.1 Chr1:1..100 Type=UTR
 mRNA B0511.1 Chr1:101..200,300..400,500..800 Type=CDS
 mRNA B0511.1 Chr1:801..1000 Type=UTR

The top level feature's primary tag will be "mRNA", and its subparts
will have types UTR and CDS as indicated. Additional tags that are
placed in the first line of the feature will be applied to the top
level. In this example, the note "Putative primase" will be applied to
the mRNA at the top level of the feature:

 mRNA B0511.1 Chr1:1..100 Type=UTR;Note="Putative primase"
 mRNA B0511.1 Chr1:101..200,300..400,500..800 Type=CDS
 mRNA B0511.1 Chr1:801..1000 Type=UTR

=head2 Feature Groups

Features can be grouped so that they are rendered by the "group"
glyph.  To start a group, create a two-column feature entry showing
the group type and a name for the group.  Follow this with a list of
feature entries with a blank type.  For example:

 EST	yk53c10
 	yk53c10.3	15000-15500,15700-15800
 	yk53c10.5	18892-19154

This example is declaring that the ESTs named yk53c10.3 and yk53c10.5
belong to the same group named yk53c10.

=head2 Comments

Lines that begin with the # sign are treated as comments and
ignored. When a # sign appears within a line, everything to the right
of the symbol is also ignored, unless it looks like an HTML fragment or
an HTML color, e.g.:

 # this is ignored
 [Example]
 glyph   = generic   # this comment is ignored
 bgcolor = #FF0000
 link    = http://www.google.com/search?q=$name#results

Be careful, because the processing of # signs uses a regexp heuristic. To be safe,
always put a space after the # sign to make sure it is treated as a comment.

=head2 The #include and #exec Directives

The special comment "#include 'filename'" acts like the C preprocessor
directive and will insert the comments of a named file into the
position at which it occurs. Relative paths will be treated relative
to the file in which the #include occurs. Nested #include directives
(a #include located in a file that is itself an include file) are
#allowed. You may also use one of the shell wildcard characters * and
#? to include all matching files in a directory.

The following are examples of valid #include directives:

 #include "/usr/local/share/my_directives.txt"
 #include 'my_directives.txt'
 #include chromosome3_features.gff3
 #include gff.d/*.conf

You can enclose the file path in single or double quotes as shown
above. If there are no spaces in the filename the quotes are optional.
The #include directive is case insensitive, allowing you to use
#INCLUDE or #Include if you prefer.

Include file processing is not very smart and will not catch all
circular #include references. You have been warned!

The special comment "#exec 'command'" will spawn a shell and
incorporate the output of the command into the configuration
file. This command will be executed quite frequently, so it is
suggested that any time-consuming processing that does not need to be
performed on the fly each time should be cached in a local file.

=cut

use strict;
use Bio::Graphics::Feature;
use Bio::DB::GFF::Util::Rearrange;
use Carp 'cluck','carp','croak';
use IO::File;
use File::Glob ':glob';
use Text::ParseWords 'shellwords';
use Bio::DB::SeqFeature::Store;
use File::Basename 'dirname';
use File::Spec;
use Cwd 'getcwd';

# default colors for unconfigured features
my @COLORS = qw(cyan blue red yellow green wheat turquoise orange);

# package variable which holds the limited set of libraries accessible
# from within the Safe::World container (please see the description of
# the -safe_world option).
# my $SAFE_LIB;

use constant WIDTH => 600;
use constant MAX_REMAP => 100;

=head2 METHODS

=over 4

=item $version = Bio::Graphics::FeatureFile-E<gt>version

Return the version number -- needed for API checking by GBrowse

=cut

sub version { return 2 }

=item $features = Bio::Graphics::FeatureFile-E<gt>new(@args)

Create a new Bio::Graphics::FeatureFile using @args to initialize the
object.  Arguments are -name=E<gt>value pairs:

  Argument         Value
  --------         -----

   -file           Read data from a file path or filehandle.  Use
                   "-" to read from standard input.

   -text           Read data from a text scalar.

   -allow_whitespace If true, relax GFF2 and GFF3 parsing rules to allow
                   columns to be delimited by whitespace rather than
                   tabs.

   -map_coords     Coderef containing a subroutine to use for remapping
                   all coordinates.

   -smart_features Flag indicating that the features created by this
                   module should be made aware of the FeatureFile
		   object by calling their configurator() method.

   -safe           Indicates that the contents of this file is trusted.
                   Any option value that begins with the string "sub {"
                   or \&subname will be evaluated as a code reference.

   -safe_world     If the -safe option is not set, and -safe_world
                   is set to a true value, then Bio::Graphics::FeatureFile
                   will evalute "sub {}" options in a L<Safe::World>
                   environment with minimum permissions. Subroutines
                   will be able to access and interrogate
                   Bio::DB::SeqFeature objects and perform basic Perl
                   operations, but will have no ability to load or
                   access other modules, to access the file system,
                   or to make system calls. This feature depends on
                   availability of the CPAN-installable L<Safe::World>
                   module.

The -file and -text arguments are mutually exclusive, and -file will
supersede the other if both are present.

-map_coords points to a coderef with the following signature:

  ($newref,[$start1,$end1],[$start2,$end2]....)
            = coderef($ref,[$start1,$end1],[$start2,$end2]...)

See the Bio::Graphics::Browser (part of the generic genome browser
package) for an illustration of how to use this to do wonderful stuff.

The -smart_features flag is used by the generic genome browser to
provide features with a way to access the link-generation code.  See
gbrowse for how this works.

If the file is trusted, and there is an option named "init_code" in
the [GENERAL] section of the file, it will be evaluated as perl code
immediately after parsing.  You can use this to declare global
variables and subroutines for use in option values.

=cut

# args array:
# -file => parse from a file (- allowed for ARGV)
# -text => parse from a text scalar
# -map_coords => code ref to do coordinate mapping
#                called with ($ref,[$start1,$stop1],[$start2,$stop2]...)
#                returns     ($newref,$new_coord1,$new_coord2...)

sub new {
    shift->_new(@_);
}

sub _new {
  my $class = shift;
  my %args  = @_;
  my $self = bless {
		    config   => {},
		    features => {},
		    seenit   => {},
		    types    => [],
		    max      => undef,
		    min      => undef,
		    stat     => [],
		    refs     => {},
                    safe     => undef,
		    safe_world => undef,
		   },$class;
  $self->{coordinate_mapper} = $args{-map_coords}
    if exists $args{-map_coords} && ref($args{-map_coords}) eq 'CODE';

  $self->smart_features($args{-smart_features})   if exists $args{-smart_features};
  $self->{safe}              = $args{-safe}       if exists $args{-safe};
  $self->safe_world(1)                            if $args{-safe_world};
  $self->allow_whitespace(1)                      if $args{-allow_whitespace};

  $self->init_parse();

  # call with
  #   -file
  #   -text
  if (my $file = $args{-file}) {
    no strict 'refs';
    if (defined fileno($file)) { # a filehandle
	$self->parse_fh($file);
    } elsif ($file eq '-') {
	$self->parse_argv();
    } else {
	$self->parse_file($file);
    }
  } elsif (my $text = $args{-text}) {
      $self->parse_text($text);
  }

  $self->finish_parse();
  return $self;
}

=item $features = Bio::Graphics::FeatureFile-E<gt>new_from_cache(@args)

Like new() but caches the parsed file in /tmp/bio_graphics_ff_cache_*
(where * is the UID of the current user). This can speed up parsing
tremendously for files that have many includes.

Note that the presence of an #exec statement always invalidates the
cache and causes a full parse.

=cut

sub new_from_cache {
    my $self = shift;
    my %args = @_;
    my $has_libs;

    unless ($has_libs = defined &nfreeze) {
	$has_libs = eval <<END;
use Storable 'lock_store','lock_retrieve';
use File::Path 'mkpath';
1;
END
    warn "You need Storable to use new_from_cache(); returning uncached data" unless $has_libs;
    }

    $Storable::Deparse = 1;
    $Storable::Eval    = 1;

    my $file      = $has_libs && $args{-file} or return $self->_new(@_);
    (my $name     = $args{-file}) =~ s!/!_!g;
    my $cachefile = $self->cachefile($name);
    if (-e $cachefile && (stat(_))[9] >= $self->file_mtime($args{-file})) { # cache is valid
#    if (-e $cachefile && -M $cachefile < 0) { # cache is valid
	my $parsed_file = lock_retrieve($cachefile);
	$parsed_file->initialize_code if $parsed_file->safe;
	return $parsed_file;
    } else {
	mkpath(dirname($cachefile));
	my $parsed = $self->_new(@_);
	$parsed->initialize_code();
	eval {lock_store($parsed,$cachefile)};
	warn $@ if $@;
	return $parsed;
    }

}

sub cachedir {
    my $self = shift;
    my $uid       = $<;
    return File::Spec->catfile(File::Spec->tmpdir,"bio_graphics_ff_cache_${uid}");
}

sub cachefile {
    my $self = shift;
    my $name = shift;
    return File::Spec->catfile($self->cachedir,$name);
}

=item $mtime = Bio::Graphics::FeatureFile->file_mtime($path)

Return the modification time of the indicated feature file without performing a full parse. This
takes into account the various #include and #exec directives and returns the maximum mtime of
any of the included files. Any #exec directive will return the current time. This is
useful for caching the parsed data structure.

=back

=cut

sub file_mtime {
    my $self = shift;

    my $file  = shift;
    my $mtime = 0;

    for my $f (glob($file)) {
	my $m  = (stat($f))[9] or next;
	$mtime = $m if $mtime < $m;
	open my $fh,'<',$file or next;
	my $cwd = getcwd();
	chdir(dirname($file));

        local $_;
	while (<$fh>) {
	    if (/^\#exec/) {
		return time();  # now!
	    }
	    if (/^\#include\s+(.+)/i) {  # #include directive
		my ($include_file) = shellwords($1);
		my $m  = $self->file_mtime($include_file);
		$mtime = $m if $mtime < $m;
	    }
	}
	chdir($cwd);
    }

    return $mtime;
}

sub file_list {
    my $self = shift;
    my @list = ();
    my $file  = shift;

    for my $f (glob($file)) {
        open my $fh,'<',$file or next;
        my $cwd = getcwd();
        chdir(dirname($file));


        while (<$fh>) {
            if (/^\#include\s+(.+)/i) {  # #include directive
                my ($include_file) = shellwords($1);
                my @files = glob($include_file);
                @files ? @list = (@list,@files) : push(@list,$include_file);
            }
        }
        chdir($cwd);
    }

    return \@list;
}

# render our features onto a panel using configuration data
# return the number of tracks inserted

=over 4

=item ($rendered,$panel,$tracks) = $features-E<gt>render([$panel, $position_to_insert, $options, $max_bump, $max_label, $selector])

Render features in the data set onto the indicated
Bio::Graphics::Panel.  If no panel is specified, creates one.

All arguments are optional.

$panel is a Bio::Graphics::Panel that has previously been created and
configured.

$position_to_insert indicates the position at which to start inserting
new tracks. The last current track on the panel is assumed.

$options is a scalar used to control automatic expansion of the
tracks. 0=auto, 1=compact, 2=expanded, 3=expand and label,
4=hyperexpand, 5=hyperexpand and label.

$max_bump and $max_label indicate the maximum number of features
before bumping and labeling are turned off.

$selector is a code ref that can be used to filter which features to
render. It receives a feature and should return true to include the
feature and false to exclude it.

In a scalar context returns the number of tracks rendered.  In a list
context, returns a three-element list containing the number of
features rendered, the created panel, and an array ref of all the
track objects created.

Instead of a Bio::Graphics::Panel object, you can provide a hash
reference containing the arguments that you would pass to
Bio::Graphics::Panel->new(). For example, to render an SVG image, you
could do this:

  my ($tracks_rendered,$panel) = $data->render({-image_class=>'GD::SVG'});
  print $panel->svg;

=back

=cut

#"

sub render {
  my $self  = shift;
  my $panel = shift;         # 8 arguments
  my ($position_to_insert,
      $options,
      $max_bump,
      $max_label,
      $selector,
      $range,
      $override_options
      ) = @_;
  my %seenit;

  unless ($panel && UNIVERSAL::isa($panel,'Bio::Graphics::Panel')) {
      $panel = $self->new_panel($panel);
  }

  # count up number of tracks inserted
  my @tracks;
  my $color;
  my @labels             = $self->labels;

  # we need to add a dummy section for each type that isn't
  # specifically configured
  my %types   = map {$_=>1
  } map {
      shellwords ($self->setting($_=>'feature')||$_) } @labels;
  my %lc_types = map {lc($_)}%types;

  my @unconfigured_types = sort grep {!exists $lc_types{lc $_} &&
					  !exists $lc_types{lc $_->method}
  }         $self->types;

  my @configured_types   = keys %types;

  my @labels_to_render = (@labels,@unconfigured_types);

  my @base_config = $self->style('general');

  my @pack_options = ();
  if ($options && ref $options eq 'HASH') {
    @pack_options = %$options;
  } else {
    $options ||= 0;
    if ($options == 1) {  # compact
      push @pack_options,(-bump => 0,-label=>0);
    } elsif ($options == 2) { #expanded
      push @pack_options,(-bump=>1);
    } elsif ($options == 3) { #expand and label
      push @pack_options,(-bump=>1,-label=>1);
    } elsif ($options == 4) { #hyperexpand
      push @pack_options,(-bump => 2);
    } elsif ($options == 5) { #hyperexpand and label
      push @pack_options,(-bump => 2,-label=>1);
    }
  }

  for my $label (@labels_to_render) {


      my @types = shellwords($self->setting($label=>'feature')||'');
      @types    = $label unless @types;

      next if defined $selector and !$selector->($self,$label);

      my @features = !$range ? grep {$self->_visible($_)} $self->features(\@types)
                             : $self->features(-types   => \@types,
					       -seq_id  => $range->seq_id,
					       -start   => $range->start,
					       -end     => $range->end
					      );
      next unless @features;  # suppress tracks for features that don't appear

      # fix up funky group hack
      foreach (@features) {$_->primary_tag('group') if $_->has_tag('_ff_group')};
      my $features = \@features;

      my @auto_bump;
      push @auto_bump,(-bump  => @$features < $max_bump)  if defined $max_bump;
      push @auto_bump,(-label => @$features < $max_label) if defined $max_label;

      my @more_arguments = $override_options ? @$override_options : ();

      my @config = ( -glyph   => 'segments',         # really generic
		     -bgcolor => $COLORS[$color++ % @COLORS],
		     -label   => 1,
		     -description => 1,
		     -key     => $features[0]->type || $label,
		     @auto_bump,
		     @base_config,         # global
		     $self->style($label),  # feature-specific
		     @pack_options,
		     @more_arguments,
	  );

      if (defined($position_to_insert)) {
	  push @tracks,$panel->insert_track($position_to_insert++,$features,@config);
      } else {
	  push @tracks,$panel->add_track($features,@config);
      }
  }
  return wantarray ? (scalar(@tracks),$panel,\@tracks) : scalar @tracks;
}

sub _stat {
  my $self = shift;
  my $file = shift;
  defined fileno($file)  or return;
  my @stat = stat($file) or return;
  if ($self->{stat} && @{$self->{stat}}) { # merge #includes so that mtime etc are max age
      for (8,9,10) {
	  $self->{stat}[$_] = $stat[$_] if $stat[$_] > $self->{stat}[$_];
      }
      $self->{stat}[7] += $stat[7];
  } else {
      $self->{stat} = \@stat;
  }
}

sub _visible {
    my $self = shift;
    my $feat = shift;
    my $min  = $self->min;
    my $max  = $self->max;
    return $feat->start<=$max && $feat->end>=$min;
}

=over 4

=item $error = $features-E<gt>error([$error])

Get/set the current error message.

=back

=cut

sub error {
  my $self = shift;
  my $d = $self->{error};
  $self->{error} = shift if @_;
  $d;
}

=over 4

=item $smart_features = $features-E<gt>smart_features([$flag]

Get/set the "smart_features" flag.  If this is set, then any features
added to the featurefile object will have their configurator() method
called using the featurefile object as the argument.

=back

=cut

sub smart_features {
  my $self = shift;
  my $d = $self->{smart_features};
  $self->{smart_features} = shift if @_;
  $d;
}

sub parse_argv {
  my $self = shift;
  local $/ = "\n";
  local $_;
  while (<>) {
    chomp;
    $self->parse_line($_);
  }
}

sub parse_file {
    my $self = shift;
    my $file = shift;

    $file =~ s/(\s)/\\$1/g; # escape whitespace from glob expansion

    for my $f (glob($file)) {
	my $fh   = IO::File->new($f) or return;
	my $cwd  = getcwd();
	chdir(dirname($f));
	$self->parse_fh($fh);
	chdir($cwd);
    }
}

sub parse_fh {
    my $self = shift;
    my $fh   = shift;
    $self->_stat($fh);
    local $/ = "\n";
    local $_;
    while (<$fh>) {
	chomp;
	$self->parse_line($_) || last;
    }
}

sub parse_text {
  my $self = shift;
  my $text = shift;

  foreach (split m/\015?\012|\015\012?/,$text) {
    $self->parse_line($_);
  }
}

sub parse_line {
  my $self = shift;
  my $line = shift;

  $line =~ s/\015//g;  # get rid of carriage returns left over by MS-DOS/Windows systems
  $line =~ s/\s+$//;   # get rid of trailing whitespace

  if (/^#include\s+(.+)/i) {  # #include directive
      my ($include_file) = shellwords($1);
      # detect some loops
      croak "#include loop detected at $include_file"
	  if $self->{includes}{$include_file}++;
      $self->parse_file($include_file);
      return 1;
  }

  if (/^#exec\s+(.+)/i) {  # #exec directive
      my ($command,@args) = shellwords($1);
      open (my $fh,'-|') || exec $command,@args;
      $self->parse_fh($fh);
      return 1;
  }

  return 1 if $line =~ /^\s*\#[^\#]?$/;   # comment line

  # Are we in a configuration section or a data section?
  # We start out in 'config' state, and are triggered to
  # reenter config state whenever we see a /^\[ pattern (config section)
  my $old_state = $self->{state};
  my $new_state = $self->_state_transition($line);

  if ($new_state ne $old_state) {
      delete $self->{current_config};
      delete $self->{current_tag};
  }

  if ($new_state eq 'config') {
      $self->parse_config_line($line);
  } elsif ($new_state eq 'data') {
      $self->parse_data_line($line);
  }
  $self->{state} = $new_state;
  1;
}

sub _state_transition {
    my $self = shift;
    my $line = shift;
    my $current_state = $self->{state};

    if ($current_state eq 'data') {
	return 'config' if $line =~ m/^\s*\[([^\]]+)\]/;  # start of a configuration section
    }

    elsif ($current_state eq 'config') {
	return 'data'   if $line =~ /^\#\#(\w+)/;     # GFF3 meta instruction
	return 'data'   if $line =~ /^reference\s*=/; # feature-file reference sequence directive

	return 'config' if $line =~ /^\s*$/;                             #empty line
	return 'config' if $line =~ m/^\[(.+)\]/;                    # section beginning
	return 'config' if $line =~ m/^[\w:\s]+=/
	    && $self->{current_config};                                  # configuration line
	return 'config' if $line =~ m/^\s+(.+)/
	    && $self->{current_tag};                                     # continuation section
	return 'config' if $line =~ /^\#/;                               # comment -not a meta
	return 'data';
    }
    return $current_state;
}

sub parse_config_line {
    my $self = shift;
    local $_ = shift;

    # strip right-column comments unless they look like colors or html fragments
    s/\s*\#.*$// unless /\#[0-9a-f]{6,8}\s*$/i || /\w+\#\w+/ || /\w+\"*\s*\#\d+$/;

    if (/^\s+(.+)/ && $self->{current_tag}) { # configuration continuation line
	my $value = $1;
	my $cc = $self->{current_config} ||= 'general';       # in case no configuration named
	$self->{config}{$cc}{$self->{current_tag}} .= ' ' . $value;
	# respect newlines in code subs
	$self->{config}{$cc}{$self->{current_tag}} .= "\n"
	    if $self->{config}{$cc}{$self->{current_tag}}=~ /^sub\s*\{/;
	return 1;
    }

    elsif (/^\[(.+)\]/) {  # beginning of a configuration section
	my $label = $1;
	my $cc = $label =~ /^(general|default)$/i ? 'general' : $label;  # normalize
	push @{$self->{types}},$cc unless $cc eq 'general';
	$self->{current_config} = $cc;
	return 1;
    }

    elsif (/^([\w: -]+?)\s*=\s*(.*)/) {   # key value pair within a configuration section
	my $tag = lc $1;
	my $cc = $self->{current_config} ||= 'general';       # in case no configuration named
	my $value = defined $2 ? $2 : '';
	$self->{config}{$cc}{$tag} = $value;
	$self->{current_tag} = $tag;
	return 1;
    }


    elsif (/^$/) { # empty line
     # no longer required -- new sections are indicated by the start of a [stanza]
     # line and not by termination with a blank line
     #	undef $self->{current_tag};
	return 1;
    }

}

sub parse_data_line {
    my $self = shift;
    my $line = shift;
    $self->{loader} ||= $self->_make_loader($line) or return;
    $self->{loader}->load_line($line);
}

sub _make_loader {
    my $self = shift;
    local $_ = shift;
    my $db   = $self->db;

    my $type;

    # we support gff2, gff3 and featurefile formats
    if (/^\#\#gff-version\s+([23])/) {
	$type = "Bio::DB::SeqFeature::Store::GFF$1Loader";
    }
    elsif (/^reference\s*=.+/) {
	$type = "Bio::DB::SeqFeature::Store::FeatureFileLoader";
    }
    else {
	my @tokens = shellwords($_);
	unshift @tokens,'' if /^\s+/ and length $tokens[0];

	if (@tokens >=8 && $tokens[3]=~ /^-?\d+$/ && $tokens[4]=~ /^-?\d+$/) {
	    $type = 'Bio::DB::SeqFeature::Store::GFF3Loader';
	}
	else {
	    $type = 'Bio::DB::SeqFeature::Store::FeatureFileLoader';
	}
    }
    eval "require $type"
	    unless $type->can('new');
    my $loader = $type->new(-store             => $db,
			    -map_coords        => $self->{coordinate_mapper},
			    -index_subfeatures => 0,
	);
    eval {$loader->allow_whitespace(1)}
        if $self->allow_whitespace;  # gff2 and gff3 loaders allow this

    $loader->start_load() if $loader;
    return $loader;
}

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

=over 4

=item $flat = $features-E<gt>allow_whitespace([$new_flag])

If true, then GFF3 and GFF2 parsing is relaxed to allow whitespace to
delimit the columns. Default is false.

=back

=cut

sub allow_whitespace {
    my $self = shift;
    my $d    = $self->{allow_whitespace};
    $self->{allow_whitespace} = shift if @_;
    $d;
}

=over 4

=item $features-E<gt>add_feature($feature [=E<gt>$type])

Add a new Bio::FeatureI object to the set.  If $type is specified, the
object's primary_tag() will be set to that type. Otherwise, the method
will use the feature's existing primary_tag() to index and store the
feature.

=back

=cut

# add a feature of given type to our list
# we use the primary_tag() method
sub add_feature {
  my $self = shift;
  my ($feature,$type) = @_;
  $feature->configurator($self) if $self->smart_features;
  $feature->primary_tag($type) if defined $type;
  $self->db->store($feature);
}


=over 4

=item $features-E<gt>add_type($type=E<gt>$hashref)

Add a new feature type to the set.  The type is a string, such as
"EST".  The hashref is a set of key=E<gt>value pairs indicating options to
set on the type.  Example:

  $features->add_type(EST => { glyph => 'generic', fgcolor => 'blue'})

When a feature of type "EST" is rendered, it will use the generic
glyph and have a foreground color of blue.

=back

=cut

# Add a type to the list.  Hash values are used for key/value pairs
# in the configuration.  Call as add_type($type,$configuration) where
# $configuration is a hashref.
sub add_type {
  my $self = shift;
  my ($type,$type_configuration) = @_;
  my $cc = $type =~ /^(general|default)$/i ? 'general' : $type;  # normalize
  push @{$self->{types}},$cc unless $cc eq 'general' or $self->{config}{$cc};
  if (defined $type_configuration) {
    for my $tag (keys %$type_configuration) {
      $self->{config}{$cc}{lc $tag} = $type_configuration->{$tag};
    }
  }
}



=over 4

=item $features-E<gt>set($type,$tag,$value)

Change an individual option for a particular type.  For example, this
will change the foreground color of EST features to my favorite color:

  $features->set('EST',fgcolor=>'chartreuse')

=back

=cut

# change configuration of a type.  Call as set($type,$tag,$value)
# $type will be added if not already there.
sub set {
  my $self = shift;
  croak("Usage: \$featurefile->set(\$type,\$tag,\$value\n")
    unless @_ == 3;
  my ($type,$tag,$value) = @_;
  unless ($self->{config}{$type}) {
    return $self->add_type($type,{$tag=>$value});
  } else {
    $self->{config}{$type}{lc $tag} = $value;
  }
}

# break circular references
sub finished {
  my $self = shift;
  delete $self->{features};
}

sub DESTROY {
    my $self = shift;
    $self->finished(@_);
#    $self->{safe_context}->unlink_all_worlds
#	if $self->{safe_context};
}

=over 4

=item $value = $features-E<gt>setting($stanza =E<gt> $option)

In the two-element form, the setting() method returns the value of an
option in the configuration stanza indicated by $stanza.  For example:

  $value = $features->setting(general => 'height')

will return the value of the "height" option in the [general] stanza.

Call with one element to retrieve all the option names in a stanza:

  @options = $features->setting('general');

Call with no elements to retrieve all stanza names:

  @stanzas = $features->setting;

=back

=cut

sub setting {
  my $self = shift;
  if (@_ > 2) {
    $self->{config}->{$_[0]}{$_[1]} = $_[2];
  }

  elsif (@_ <= 1) {
      return $self->_setting(@_);
  }

  elsif ($self->safe) {
      return $self->code_setting(@_);
  }

  elsif ($self->safe_world) {
      return $self->safe_setting(@_);
  }

  else {
      $self->{code_check}++ && $self->clean_code(); # not safe; clean coderefs
      return $self->_setting(@_);
  }
}

=head2 fallback_setting()

  $value = $browser->setting(gene => 'fgcolor');

Tries to find the setting for designated label (e.g. "gene") first. If
this fails, looks in [TRACK DEFAULTS]. If this fails, looks in [GENERAL].

=cut

sub fallback_setting {
  my $self = shift;
  my ($label,$option) = @_;
  for my $key ($label,'TRACK DEFAULTS','GENERAL') {
    my $value = $self->setting($key,$option);
    return $value if defined $value;
  }
  return;
}


# return configuration information
# arguments are ($type) => returns tags for type
#               ($type=>$tag) => returns values of tag on type
#               ($type=>$tag,$value) => sets value of tag
sub _setting {
  my $self = shift;
  my $config = $self->{config} or return;
  return keys %{$config} unless @_;
  return keys %{$config->{$_[0]}}        if @_ == 1;
  return $config->{$_[0]}{$_[1]}         if @_ == 2 && defined $_[0] && exists $config->{$_[0]};
  return $config->{$_[0]}{$_[1]} = $_[2] if @_ > 2;
  return;
}


=over 4

=item $value = $features-E<gt>code_setting($stanza=E<gt>$option);

This works like setting() except that it is also able to evaluate code
references.  These are options whose values begin with the characters
"sub {".  In this case the value will be passed to an eval() and the
resulting codereference returned.  Use this with care!

=back

=cut

sub code_setting {
  my $self = shift;
  my $section = shift;
  my $option  = shift;
  croak 'Cannot call code_setting unless feature file is marked as safe'
      unless $self->safe;

  my $setting = $self->_setting($section=>$option);
  return unless defined $setting;
  return $setting if ref($setting) eq 'CODE';
  if ($setting =~ /^\\&([:\w]+)/) {  # coderef in string form
    my $subroutine_name = $1;
    my $package         = $self->base2package;
    my $codestring      = $subroutine_name =~ /::/
                           ? "\\&$subroutine_name"
                           : "\\&${package}\:\:${subroutine_name}" ;
    my $coderef         = eval $codestring;
    $self->_callback_complain($section,$option) if $@;
    $self->set($section,$option,$coderef);
    $self->set_callback_source($section,$option,$setting);
    return $coderef;
  }
  elsif ($setting =~ /^sub\s*(\(\$\$\))*\s*\{/) {
    my $package         = $self->base2package;
    my $coderef         = eval "package $package; $setting";
    $self->_callback_complain($section,$option) if $@;
    $self->set($section,$option,$coderef);
    $self->set_callback_source($section,$option,$setting);
    return $coderef;
  } else {
    return $setting;
  }
}

sub _callback_complain {
  my $self    = shift;
  my ($section,$option) = @_;
  carp "An error occurred while evaluating the callback at section='$section', option='$option':\n   => $@";
}

=over 4

=item $value = $features-E<gt>safe_setting($stanza=E<gt>$option);

This works like code_setting() except that it evaluates anonymous code
references in a "Safe::World" compartment. This depends on the
L<Safe::World> module being installed and the -safe_world option being
set to true during object construction.

=back

=cut

sub safe_setting {
    my $self    = shift;

    my $section = shift;
    my $option  = shift;

    my $setting = $self->_setting($section=>$option);
    return unless defined $setting;
    return $setting if ref($setting) eq 'CODE';

    if ($setting =~ /^sub\s*(\(\$\$\))*\s*\{/
	&& (my $context = $self->{safe_context})) {


	# turn setting from an anonymous sub into a named
	# sub in the context namespace

	# create proper symbol name
	my $subname = "${section}_${option}";
	$subname    =~ tr/a-zA-Z0-9_//cd;
	$subname    =~ s/^\d+//;

	my ($prototype)
	    = $setting =~ /^sub\s*\(\$\$\)/;

	$setting    =~ s/^sub?.*?\{/sub $subname {/;

	my $success = $context->eval("$setting; 1");
	$self->_callback_complain($section,$option) if $@;
	unless ($success) {
	    $self->set($section,$option,1);  # if call fails, it becomes a generic "true" value
	    return 1;
	}

	my $coderef = $prototype
	    ?  sub ($$) { return $context->call($subname,$_[0],$_[1]) }
	    :  sub {
		if ($_[-1]->isa('Bio::Graphics::Glyph')) {
		    my %newglyph = %{$_[-1]};
		    $_[-1]       = bless \%newglyph,'Bio::Graphics::Glyph'; # make generic
		}
		$context->call($subname,@_);
	    };
	$self->set($section,$option,$coderef);
	$self->set_callback_source($section,$option,$setting);
	return $coderef;
    }
    else {
	return $setting;
    }
}

=over 4

=item $flag = $features-E<gt>safe([$flag]);

This gets or sets and "safe" flag.  If the safe flag is set, then
calls to setting() will invoke code_setting(), allowing values that
begin with the string "sub {" to be interpreted as anonymous
subroutines.  This is a potential security risk when used with
untrusted files of features, so use it with care.

=back

=cut

sub safe {
   my $self = shift;
   my $d = $self->{safe};
   $self->{safe} = shift if @_;
   $self->evaluate_coderefs if $self->{safe} && !$d;
   $d;
}

=over 4

=item $flag = $features-E<gt>safe_world([$flag]);

This gets or sets and "safe_world" flag.  If the safe_world flag is
set, then values that begin with the string "sub {" will be evaluated
in a "safe" compartment that gives minimal access to the system. This
is not a panacea for security risks, so use with care.

=back

=cut

sub safe_world {
    my $self            = shift;
    my $safe            = shift;

    if ($safe && !$self->{safe_content}) {  # initialise the thing

	eval "require Safe::World; 1";
	unless (Safe::World->can('new')) {
	    warn "The Safe::World module is not installed on this system. Can't use it to evaluate codesubs in a safe context";
	    return;
	}

	unless ($self->{safe_lib}) {
	    $self->{safe_lib} = Safe::World->new(sharepack => ['Bio::DB::SeqFeature',
							       'Bio::Graphics::Feature',
							       'Bio::SeqFeature::Lite',
							       'Bio::Graphics::Glyph',
						 ])  or return;

	    $self->{safe_lib}->eval(<<END)           or return;
use Bio::DB::SeqFeature;
use Bio::Graphics::Feature;
use Bio::SeqFeature::Lite;
use Bio::Graphics::Glyph;
1;
END
	}

	$self->{safe_context} = Safe::World->new(root => $self->base2package)        or return;
	$self->{safe_context}->op_permit_only(':default');
	$self->{safe_context}->link_world($self->{safe_lib});
	$self->{safe_world} = $safe;
    }
    return $self->{safe_world};
}

=over 4

=item $features-E<gt>set_callback_source($type,$tag,$value)

=item $features-E<gt>get_callback_source($type,$tag)

These routines are used internally to get and set the source of a sub
{} callback.

=back

=cut

sub set_callback_source {
    my $self = shift;
    my ($type,$tag,$value) = @_;
    $self->{source}{$type}{lc $tag} = $value;
}

sub get_callback_source {
    my $self = shift;
    my ($type,$tag) = @_;
    $self->{source}{$type}{lc $tag};
}

=over 4

=item @args = $features-E<gt>style($type)

Given a feature type, returns a list of track configuration arguments
suitable for suitable for passing to the
Bio::Graphics::Panel-E<gt>add_track() method.

=back

=cut

# turn configuration into a set of -name=>value pairs suitable for add_track()
sub style {
  my $self = shift;
  my $type = shift;

  my $config  = $self->{config}  or return;
  my $hashref = $config->{$type};
  unless ($hashref) {
    $type =~ s/:.+$//;
    $hashref = $config->{$type} or return;
  }

  return map {("-$_" => $hashref->{$_})} keys %$hashref;
}


=over 4

=item $glyph = $features-E<gt>glyph($type);

Return the name of the glyph corresponding to the given type (same as
$features-E<gt>setting($type=E<gt>'glyph')).

=back

=cut

# retrieve just the glyph part of the configuration
sub glyph {
  my $self = shift;
  my $type = shift;
  my $config  = $self->{config}  or return;
  my $hashref = $config->{$type} or return;
  return $hashref->{glyph};
}


=over 4

=item @types = $features-E<gt>configured_types()

Return a list of all the feature types currently known to the feature
file set.  Roughly equivalent to:

  @types = grep {$_ ne 'general'} $features->setting;

=back

=cut

# return list of configured types, in proper order
sub configured_types {
  my $self = shift;
  my $types = $self->{types} or return;
  return @$types;
}

sub labels {
    return shift->configured_types;
}

=over 4

=item  @types = $features-E<gt>types()

This is similar to the previous method, but will return *all* feature
types, including those that are not configured with a stanza.

=back

=cut

sub types {
  my $self = shift;
  my $db = $self->db;
  $self->_patch_old_bioperl;
  return $self->db->types;
}

sub _patch_old_bioperl {
    my $self = shift;
    if ($Bio::Root::Version::VERSION >= 1.0069 &&
	$Bio::Root::Version::VERSION <= 1.006901
	) {  # bad version!
	local $^W=0;
	*Bio::DB::SeqFeature::Store::memory::types = sub {
	    my $self = shift;
	    eval "require Bio::DB::GFF::Typename" unless Bio::DB::GFF::Typename->can('new');
	    my @types;
	    for my $primary_tag ( keys %{$$self{_index}{type}} ) {
		for my $source_tag ( keys %{$$self{_index}{type}{$primary_tag}} ) {
		    push @types, Bio::DB::GFF::Typename->new($primary_tag,$source_tag);
		}
	    }
	    return @types;
	}
    }
}

=over 4

=item $features = $features-E<gt>features($type)

Return a list of all the feature types of type "$type".  If the
featurefile object was created by parsing a file or text scalar, then
the features will be of type Bio::Graphics::Feature (which follow the
Bio::FeatureI interface).  Otherwise the list will contain objects of
whatever type you added with calls to add_feature().

Two APIs:

  1) original API:

      # Reference to an array of all features of type "$type"
      $features = $features-E<gt>features($type)

      # Reference to an array of all features of all types
      $features = $features-E<gt>features()

      # A list when called in a list context
      @features = $features-E<gt>features()

   2) Bio::Das::SegmentI API:

       @features = $features-E<gt>features(-type=>['list','of','types']);

       # variants
       $features = $features-E<gt>features(-type=>['list','of','types']);
       $features = $features-E<gt>features(-type=>'a type');
       $iterator = $features-E<gt>features(-type=>'a type',-iterator=>1);

       $iterator = $features-E<gt>features(-type=>'a type',-seq_id=>$id,-start=>$start,-end=>$end);

=back

=cut

# return features
sub features {
  my $self = shift;
  my ($types,$iterator,$seq_id,$start,$end,@rest) = defined($_[0] && $_[0]=~/^-/)
    ? rearrange([['TYPE','TYPES'],'ITERATOR','SEQ_ID','START','END'],@_) : (\@_);

  $types = [$types] if $types && !ref($types);
  my @args     = $types && @$types ? (-type=>$types) : ();

  push @args,(-seq_id => $seq_id) if $seq_id;
  push @args,(-start  => $start)  if defined $start;
  push @args,(-end    => $end)    if defined $end;

  my $db = $self->db;

  if ($iterator) {
      return $db->get_seq_stream(@args);
  } else {
      my @f = $db->features(@args);
      return wantarray ?  @f : \@f;
  }
}



=over 4

=item @features = $features-E<gt>features($type)

Return a list of all the feature types of type "$type".  If the
featurefile object was created by parsing a file or text scalar, then
the features will be of type Bio::Graphics::Feature (which follow the
Bio::FeatureI interface).  Otherwise the list will contain objects of
whatever type you added with calls to add_feature().

=back

=cut

sub make_strand {
  local $^W = 0;
  return +1 if $_[0] =~ /^\+/ || $_[0] > 0;
  return -1 if $_[0] =~ /^\-/ || $_[0] < 0;
  return 0;
}

=head2 get_seq_stream

 Title   : get_seq_stream
 Usage   : $stream = $s->get_seq_stream(@args)
 Function: get a stream of features that overlap this segment
 Returns : a Bio::SeqIO::Stream-compliant stream
 Args    : see below
 Status  : Public

This is the same as feature_stream(), and is provided for Bioperl
compatibility.  Use like this:

 $stream = $s->get_seq_stream('exon');
 while (my $exon = $stream->next_seq) {
    print $exon->start,"\n";
 }

=cut

sub get_seq_stream {
  my $self = shift;
  local $^W = 0;
  my @args = $_[0] =~ /^-/ ? (@_,-iterator=>1) : (-types=>\@_,-iterator=>1);
  $self->features(@args);
}

=head2 get_feature_by_name

 Usage   : $db->get_feature_by_name(-name => $name)
 Function: fetch features by their name
 Returns : a list of Bio::DB::GFF::Feature objects
 Args    : the name of the desired feature
 Status  : public

This method can be used to fetch a named feature from the file.

The full syntax is as follows.  Features can be filtered by
their reference, start and end positions

  @f = $db->get_feature_by_name(-name  => $name,
                                -ref   => $sequence_name,
                                -start => $start,
                                -end   => $end);

This method may return zero, one, or several Bio::Graphics::Feature
objects.

=cut

sub get_feature_by_name {
   my $self = shift;
   my ($name,$ref,$start,$end) = rearrange(['NAME','REF','START','END'],@_);
   my @args;
   push @args,(-name   => $name) if defined $name;
   push @args,(-seq_id => $ref)  if defined $ref;
   push @args,(-start  => $start)if defined $start;
   push @args,(-end    => $end)  if defined $end;
   return $self->db->features(@args);
}

sub get_features_by_name { shift->get_feature_by_name(@_) }

=head2 search_notes

 Title   : search_notes
 Usage   : @search_results = $db->search_notes("full text search string",$limit)
 Function: Search the notes for a text string
 Returns : array of results
 Args    : full text search string, and an optional row limit
 Status  : public

Each row of the returned array is a arrayref containing the following fields:

  column 1     Display name of the feature
  column 2     The text of the note
  column 3     A relevance score.

=cut

sub search_notes {
  my $self = shift;
  return $self->db->search_notes(@_);
}


=head2 get_feature_stream(), top_SeqFeatures(), all_SeqFeatures()

Provided for compatibility with older BioPerl and/or Bio::DB::GFF
APIs.

=cut

*get_feature_stream = \&get_seq_stream;
*top_SeqFeatures    = *all_SeqFeatures = \&features;


=over 4

=item @refs = $features-E<gt>refs

Return the list of reference sequences referred to by this data file.

=back

=cut

sub refs {
  my $self = shift;
  my $refs = $self->{refs} or return;
  keys %$refs;
}

=over 4

=item  $min = $features-E<gt>min

Return the minimum coordinate of the leftmost feature in the data set.

=back

=cut

sub min {
    my $self = shift;
    $self->_min_max();
    $self->{min};
}

=over 4

=item $max = $features-E<gt>max

Return the maximum coordinate of the rightmost feature in the data set.

=back

=cut

sub max {
    my $self = shift;
    $self->_min_max();
    $self->{max};
}

sub _min_max {
    my $self = shift;
    return if defined $self->{min} and defined $self->{max};

    my ($min,$max);
    if (my $bases = $self->setting(general=>'bases')) {
	($min,$max)        = $bases =~ /^(-?\d+)(?:\.\.|-)(-?\d+)/;
    }

    if (!defined $min) {
	# otherwise sort through the features
	my $fs = $self->get_seq_stream;
	while (my $f = $fs->next_seq) {
	    $min = $f->start if !defined $min or $min > $f->start;
	    $max = $f->end   if !defined $max or $max < $f->start;
	}
    }

    @{$self}{'min','max'} = ($min,$max);
}

sub init_parse {
  my $s = shift;

  $s->{max}          = $s->{min} = undef;
  $s->{types}        = [];
  $s->{features}     = {};
  $s->{config}       = {};
  $s->{loader}       = undef;
  $s->{state}        = 'config';
  $s->{feature_count}= 0;
}

sub finish_parse {
  my $s = shift;
  if ($s->safe) {
      $s->initialize_code;
      $s->evaluate_coderefs;
  }
  elsif ($s->safe_world) {
      $s->evaluate_safecoderefs;
  }
  $s->{loader}->finish_load() if $s->{loader};
  $s->{loader}       = undef;
  $s->{state}        = 'config';
}

sub evaluate_coderefs {
  my $self = shift;
  for my $s ($self->_setting) {
    for my $o ($self->_setting($s)) {
      $self->code_setting($s,$o);
    }
  }
}
sub evaluate_safecoderefs {
  my $self = shift;
  for my $s ($self->_setting) {
    for my $o ($self->_setting($s)) {
      $self->safe_setting($s,$o);
    }
  }
}

sub clean_code {
  my $self = shift;
  for my $s ($self->_setting) {
    for my $o ($self->_setting($s)) {
	$self->_setting($s,$o,1) if
	    $self->_setting($s,$o) =~ /\Asub\s*{/;
    }
  }
}

sub initialize_code {
  my $self       = shift;
  my $package    = $self->base2package;
  my $init_code  = $self->_setting(general => 'init_code') or return;
  my $code       = "package $package; $init_code; 1;";
  eval $code;
  $self->_callback_complain(general=>'init_code') if $@;
}

sub base2package {
  my $self = shift;
  return $self->{base2package} if exists $self->{base2package};
  my $rand     = int rand(1000000);
  return $self->{base2package} = "Bio::Graphics::FeatureFile::CallBack::P$rand";
}

sub split_group {
  my $self = shift;
  my $gff = $self->{gff} ||= Bio::DB::GFF->new(-adaptor=>'memory');
  return $gff->split_group(shift, $self->{gff_version} > 2);
}

# create a panel if needed
sub new_panel {
  my $self    = shift;
  my $options = shift;

  eval "require Bio::Graphics::Panel" unless Bio::Graphics::Panel->can('new');

  # general configuration of the image here
  my $width         = $self->setting(general => 'pixels')
                      || $self->setting(general => 'width')
			|| WIDTH;

  my ($start,$stop);
  my $range_expr = '(-?\d+)(?:-|\.\.)(-?\d+)';

  if (my $bases = $self->setting(general => 'bases')) {
    ($start,$stop) =  $bases =~ /([\d-]+)(?:-|\.\.)([\d-]+)/;
  }

  if (!defined $start || !defined $stop) {
    $start = $self->min unless defined $start;
    $stop  = $self->max unless defined $stop;
  }

  my $new_segment   = Bio::Graphics::Feature->new(-start=>$start,-stop=>$stop);
  my @panel_options = %$options if $options && ref $options eq 'HASH';
  my $panel = Bio::Graphics::Panel->new(-segment   => $new_segment,
					-width     => $width,
					-key_style => 'between',
					$self->style('general'),
					@panel_options
      );
  $panel;
}

=over 4

=item $mtime = $features-E<gt>mtime

=item $atime = $features-E<gt>atime

=item $ctime = $features-E<gt>ctime

=item $size = $features-E<gt>size

Returns stat() information about the data file, for featurefile
objects created using the -file option.  Size is in bytes.  mtime,
atime, and ctime are in seconds since the epoch.

=back

=cut

sub mtime {
  my $self = shift;
  my $d = $self->{m_time} || $self->{stat}->[9];
  $self->{m_time} = shift if @_;
  $d;
}
sub atime { shift->{stat}->[8];  }
sub ctime { shift->{stat}->[10]; }
sub size  { shift->{stat}->[7];  }

=over 4

=item $label = $features-E<gt>feature2label($feature)

Given a feature, determines the configuration stanza that bests
describes it.  Uses the feature's type() method if it has it (DasI
interface) or its primary_tag() method otherwise.

=back

=cut

sub feature2label {
  my $self    = shift;
  my $feature = shift;
  my $type      = $feature->can('type') ? $feature->type
                                        : $feature->primary_tag;
  $type or return;
  (my $basetype = $type) =~ s/:.+$//;
  my @labels    = $self->type2label($type);
  @labels       = $self->type2label($basetype) unless @labels;
  @labels       = ($type) unless @labels;
  wantarray ? @labels : $labels[0];
}

=over 4

=item $link = $features-E<gt>link_pattern($linkrule,$feature,$panel)

Given a feature, tries to generate a URL to link out from it.  This
uses the 'link' option, if one is present.  This method is a
convenience for the generic genome browser.

=back

=cut

sub link_pattern {
  my $self     = shift;
  my ($linkrule,$feature,$panel,$dont_escape) = @_;

  $panel ||= 'Bio::Graphics::Panel';

  if (ref($linkrule) && ref($linkrule) eq 'CODE') {
    my $val = eval {$linkrule->($feature,$panel)};
    $self->_callback_complain(none=>"linkrule for $feature") if $@;
    return $val;
  }

  require CGI unless defined &CGI::escape;
  my $escape_method = $dont_escape ? sub {shift} : \&CGI::escape;

  my $n;
  $linkrule ||= ''; # prevent uninit warning
  my $seq_id  = $feature->can('seq_id') ? $feature->seq_id() : $feature->location->seq_id();
  $seq_id   ||= $feature->seq_id; #fallback
  $linkrule =~ s!\$(\w+)!
        $escape_method->(
        $1 eq 'ref'              ? (($n = $seq_id) && "$n") || ''
            : $1 eq 'name'         ? (($n = $feature->display_name) && "$n")     || ''
            : $1 eq 'class'        ? eval {$feature->class}  || ''
            : $1 eq 'type'         ? eval {$feature->method} || $feature->primary_tag || ''
            : $1 eq 'method'       ? eval {$feature->method} || $feature->primary_tag || ''
            : $1 eq 'source'       ? eval {$feature->source} || $feature->source_tag  || ''
            : $1 =~ 'seq_?id'      ? eval{$feature->seq_id} || eval{$feature->location->seq_id} || ''
            : $1 eq 'start'        ? $feature->start || ''
            : $1 eq 'end'          ? $feature->end   || ''
            : $1 eq 'stop'         ? $feature->end   || ''
            : $1 eq 'segstart'     ? $panel->start   || ''
            : $1 eq 'segend'       ? $panel->end     || ''
            : $1 eq 'length'       ? $feature->length || 0
            : $1 eq 'description'  ? eval {join '',$feature->notes} || ''
            : $1 eq 'id'           ? eval {$feature->feature_id} || eval {$feature->primary_id} || ''
            : '$'.$1
              )
		!exg;
  return $linkrule;
}

sub make_link {
  my $self             = shift;
  my ($feature,$panel) = @_;

  my ($linkrule) = $feature->each_tag_value('link');

  unless ($linkrule) {
      for my $label ($self->feature2label($feature)) {
	  $linkrule     ||= $self->setting($label,'link');
	  $linkrule     ||= $self->setting(general=>'link');
      }
  }
  return $self->link_pattern($linkrule,$feature,$panel);
}

sub make_title {
  my $self    = shift;
  my $feature = shift;

  for my $label ($self->feature2label($feature)) {
    my $linkrule     = $self->setting($label,'title');
    $linkrule      ||= $self->setting(general=>'title');
    next unless $linkrule;
    return $self->link_pattern($linkrule,$feature,undef,1);
  }

  my $method  = eval {$feature->method} || $feature->primary_tag;
  my $seqid   = $feature->can('seq_id')  ? $feature->seq_id : $feature->location->seq_id;
  my $title = eval {
    if ($feature->can('target') && (my $target = $feature->target)) {
      join (' ',
	    $method,
	    (defined $seqid ? "$seqid:" : '').
	    $feature->start."..".$feature->end,
	    $feature->target.':'.
	    $feature->target->start."..".$feature->target->end);
    } else {
      join(' ',
	   $method,
	   $feature->can('display_name') ? $feature->display_name : $feature->info,
	   (defined $seqid ? "$seqid:" : '').
	   ($feature->start||'?')."..".($feature->end||'?')
	  );
    }
  };
  warn $@ if $@;
  $title;
}

# given a feature type, return its label(s)
sub type2label {
  my $self = shift;
  my $type = shift;
  $self->{_type2label} ||= $self->invert_types;
  my @labels = keys %{$self->{_type2label}{lc $type}};
  wantarray ? @labels : $labels[0]
}

sub invert_types {
  my $self = shift;
  my $config  = $self->{config} or return;
  my %inverted;
  for my $label (keys %{$config}) {
      my $feature = $config->{$label}{feature} || $label;
      foreach (shellwords($feature||'')) {
	  $inverted{lc $_}{$label}++;
      }
  }
  \%inverted;
}

=over 4

=item $citation = $features-E<gt>citation($feature)

Given a feature, tries to generate a citation for it, using the
"citation" option if one is present.  This method is a convenience for
the generic genome browser.

=back

=cut

# This routine returns the "citation" field.  It is here in order to simplify the logic
# a bit in the generic browser
sub citation {
  my $self = shift;
  my $feature = shift || 'general';
  return $self->setting($feature=>'citation');
}

=over 4

=item $name = $features-E<gt>name([$feature])

Get/set the name of this feature set.  This is a convenience method
useful for keeping track of multiple feature sets.

=back

=cut

# give this feature file a nickname
sub name {
  my $self = shift;
  my $d = $self->{name};
  $self->{name} = shift if @_;
  $d;
}

1;

__END__

=head1 Appendix -- Sample Feature File

 # file begins
 [general]
 pixels = 1024
 bases = 1-20000
 reference = Contig41
 height = 12

 [mRNA]
 glyph = gene
 key   = Spliced genes

 [Cosmid]
 glyph = segments
 fgcolor = blue
 key = C. elegans conserved regions

 [EST]
 glyph = segments
 bgcolor= yellow
 connector = dashed
 height = 5;

 [FGENESH]
 glyph = transcript2
 bgcolor = green
 description = 1

 mRNA B0511.1 Chr1:1..100 Type=UTR;Note="putative primase"
 mRNA B0511.1 Chr1:101..200,300..400,500..800 Type=CDS
 mRNA B0511.1 Chr1:801..1000 Type=UTR

 reference = Chr3
 Cosmid	B0511	516..619
 Cosmid	B0511	3185..3294
 Cosmid	B0511	10946..11208
 Cosmid	B0511	13126..13511
 Cosmid	B0511	11394..11539
 EST	yk260e10.5	15569..15724
 EST	yk672a12.5	537..618,3187..3294
 EST	yk595e6.5	552..618
 EST	yk595e6.5	3187..3294
 EST	yk846e07.3	11015..11208
 EST	yk53c10
 	yk53c10.3	15000..15500,15700..15800
 	yk53c10.5	18892..19154
 EST	yk53c10.5	16032..16105
 SwissProt	PECANEX	13153-13656	Note="Swedish fish"
 FGENESH	"Predicted gene 1"	1-205,518-616,661-735,3187-3365,3436-3846	"Pfam domain"
 # file ends

=head1 SEE ALSO

L<Bio::Graphics::Panel>,
L<Bio::Graphics::Glyph>,
L<Bio::DB::SeqFeature::Store::FeatureFileLoader>,
L<Bio::Graphics::Feature>,
L<Bio::Graphics::FeatureFile>

=head1 AUTHOR

Lincoln Stein E<lt>[e-mail]<gt>.

Copyright (c) 2001 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.

=cut