view release on metacpan or  search on metacpan

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

=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