view release on metacpan or  search on metacpan

lib/Bio/Das/ProServer/SourceAdaptor/Transport/file.pm  view on Meta::CPAN

    }
  }

  return wantarray ? ($ref, $line_numbers) : $ref;
}

sub _query_fh {
  my ( $self, @predicates ) = @_;

  $self->{'debug'} && carp 'Querying against file';
  local $RS = "\n";
  my $fh    = $self->_fh();
  seek $fh, 0, 0;

  my $ref = [];
  my $line_numbers = [];
  my $i = 0;
  my $sep = $self->config->{'separator'} || '\t'; ## no critic (Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars)
  my $comment = $self->config->{'comment'};

  LINE: while(my $line = <$fh>) {
    chomp $line;
    $line || next;
    $comment && $line =~ m/$comment/mxs && next;
    $i++;
    my @parts = split /$sep/mxs, $line;

    for my $predicate (@predicates) {
      &{ $predicate }( @parts ) || next LINE;
    }

    push @{$ref}, \@parts;
    push @{$line_numbers}, $i;
    if($self->config->{'unique'}) {
      last;
    }
  }

  return wantarray ? ($ref, $line_numbers) : $ref;
}

sub _contents {
  my $self = shift;

  if (!exists $self->{'_contents'}) {
    local $RS = "\n";
    my $fh    = $self->_fh();
    seek $fh, 0, 0;

    my $ref = [];
    my $sep = $self->config->{'separator'} || '\t'; ## no critic (Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars)
    my $comment = $self->config->{'comment'};
    while(my $line = <$fh>) {
      chomp $line;
      $line || next;
      $comment && $line =~ m/$comment/mxs && next;
      my @parts = split /$sep/mxs, $line;
      push @{$ref}, \@parts;
    }
    $self->{'_contents'} = $ref;
    $self->{'_modified'} = stat($fh)->mtime; # Set the modified time
  }

  return $self->{'_contents'};
}

sub last_modified {
  my $self = shift;
  # If the file was cached, use the time from when it was loaded
  if ($self->{'_modified'}) {
    return $self->{'_modified'};
  }
  # Otherwise check it explicitly
  return stat($self->_fh())->mtime;
}

sub DESTROY {
  my $self = shift;
  if($self->{'fh'}) {
    close $self->{'fh'} or carp 'Error closing fh';
  }
  return;
}

1;
__END__

=head1 NAME

Bio::Das::ProServer::SourceAdaptor::Transport::file

=head1 VERSION

$Revision: 688 $

=head1 SYNOPSIS

=head1 DESCRIPTION

A simple data transport for tab-separated files. Access is via the 'query' method.
Expects a file with no header line. By default, fields are expected to be
separated with tab characters.

Can optionally cache the file contents upon first usage. This may improve
subsequence response speed at the expense of memory footprint.

=head1 SUBROUTINES/METHODS

=head2 query - Execute a basic query against a text file

 Queries are of the form:

 $filetransport->query(qq(field1 = 'value')); # =, == and eq operators all do the same thing
 $filetransport->query(qq(field1 lceq 'value'));
 $filetransport->query(qq(field3 like '%value%'));
 $filetransport->query(qq(field0 = 'value' && field1 = 'value'));
 $filetransport->query(qq(field0 = 'value' and field1 = 'value'));
 $filetransport->query(qq(field0 = 'value' and field1 = 'value' and field2 = 'value'));

 "OR" compound queries not (yet) supported

=head2 last_modified - machine time of last data change

  $dbitransport->last_modified();

=head2 DESTROY - object destructor - disconnect filehandle

  Generally not directly invoked, but if you really want to - 

  $filetransport->DESTROY();

=head1 DIAGNOSTICS

Run ProServer with the -debug flag.