Raw content of Bio::Tools::StateMachine::IOStateMachine
<![CDATA[#-----------------------------------------------------------------
# $Id: IOStateMachine.pm,v 1.6 2002/10/22 07:38:49 lapp Exp $
#
# BioPerl module Bio::Tools::StateMachine::IOStateMachine
#
# Cared for by Steve Chervitz <sac@bioperl.org>
#
# You may distribute this module under the same terms as perl itself
#-----------------------------------------------------------------
=head1 NAME
Bio::Tools::StateMachine::IOStateMachine - IO-based implementation of AbstractStateMachine
=head1 SYNOPSIS
use Bio::Tools::StateMachine::IOStateMachine;
# A state machine that reads input from a file
my $sm = Bio::Tools::StateMachine::IOStateMachine->new( -file => 'data.txt' );
# A state machine that reads input from a STDIN
my $sm = Bio::Tools::StateMachine::IOStateMachine->new();
# A state machine that reads input from a STDIN
# and times out if input doesn't arrive within 30 seconds.
my $sm = Bio::Tools::StateMachine::IOStateMachine->new( -timeout_sec => 30 );
=head1 DESCRIPTION
An implementation of AbstractStateMachine that samples an input stream
to determine whether a state change has occurred.
=head1 EXAMPLES
To get a feel for how to use this, have look at
Bio::SearchIO::psiblast which subclasses IOStateMachine.
=head1 FEEDBACK
=head2 Mailing Lists
User feedback is an integral part of the evolution of this and other
Bioperl modules. Send your comments and suggestions preferably to one
of the Bioperl mailing lists. Your participation is much appreciated.
bioperl-l@bioperl.org - General discussion
http://bio.perl.org/MailList.html - About the mailing lists
=head2 Reporting Bugs
Report bugs to the Bioperl bug tracking system to help us keep track
the bugs and their resolution. Bug reports can be submitted via email
or the web:
bioperl-bugs@bio.perl.org
http://bugzilla.bioperl.org/
=head1 AUTHOR
Steve Chervitz, E<lt>sac@bioperl.orgE<gt>
See the L<FEEDBACK | FEEDBACK> section for where to send bug reports and comments.
=head1 COPYRIGHT
Copyright (c) 2001 Steve Chervitz. All Rights Reserved.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
=head1 DISCLAIMER
This software is provided "as is" without warranty of any kind.
=head1 APPENDIX
The rest of the documentation details each of the object methods.
Internal methods are usually preceded with a _
=cut
# Let the code begin...
package Bio::Tools::StateMachine::IOStateMachine;
use strict;
use vars qw( @ISA @EXPORT_OK );
use Bio::Root::IO;
use Bio::Tools::StateMachine::AbstractStateMachine qw($INITIAL_STATE $FINAL_STATE);
@ISA = qw( Bio::Root::IO
Bio::Tools::StateMachine::AbstractStateMachine
);
# Propagating the initial and final states from AbstractStateMachine
@EXPORT_OK = qw( $INITIAL_STATE $FINAL_STATE );
=head2 _init_state_machine()
Argument : Named parameter -TIMEOUT_SEC => seconds,
to specify the number of seconds to allow before throwing
an exception if input fails to arrive within that amount of time.
=cut
sub _init_state_machine {
my($self, @args) = @_;
$self->SUPER::_init_state_machine(@args);
my ($timeout) = $self->_rearrange( [qw(TIMEOUT_SECS)], @args);
if( defined $timeout ) {
if($timeout =~ /^\d+$/ ) {
$self->{'_timeout_secs'} = $timeout;
}
else {
$self->throw(-class =>'Bio::Root::BadParameter',
-text => "TIMEOUT_SECS must be a number: $timeout",
-value => $timeout
);
}
}
}
=head2 check_for_new_state()
Purpose : Obtains data from the input stream to be checked
for the existence of a new state.
Usage : check_for_new_state( [$ignore_blank_lines] );
Argument : boolean: true if you want to ignore blank lines
Returns : the next chunk of input ($/ is not altered)
If there is no more input, returns undef.
Subclasses should override this method and call it to obtain
the chunk of data for new state testing.
=cut
sub check_for_new_state {
my ($self, $ignore_blank_lines) = @_;
$self->verbose and print STDERR "Checking for new state...\n";
my $chunk = $self->next_input_chunk();
# Determine if we're supposed to ignore blanks and if so, loop
# until we're either out of input or hit a non-blank line.
if( defined $chunk &&
$ignore_blank_lines and $chunk =~ /^\s*$/ ) {
while( $chunk = $self->next_input_chunk()) {
last unless not $chunk or $chunk =~ /^\s*$/;
}
}
$self->verbose and print STDERR " Input chunk: " . $chunk, "\n";
return $chunk;
}
=head2 next_input_chunk()
Argument : n/a
Returns : The next chunk of input data from the IO stream
To be used in determining what state the machine should be in.
=cut
sub next_input_chunk {
my $self = shift;
$self->verbose and print STDERR "Getting next input chunk...\n", ;
if(not defined $self->{'_alarm_available'}) {
$self->_check_if_alarm_available();
}
$SIG{ALRM} = sub { die "Timed out!"; };
my $chunk;
eval {
if( $self->{'_alarm_available'} and defined $self->{'_timeout_secs'}) {
alarm($self->{'_timeout_secs'});
}
$chunk = $self->_readline();
};
if($@ =~ /Timed out!/) {
$self->throw(-class => 'Bio::Root::IOException',
-text => "Timed out while waiting for input (timeout=$self->{'_timeout_secs'}s).");
} elsif($@ =~ /\S/) {
my $err = $@;
$self->throw(-class => 'Bio::Root::IOException',
-text => "Unexpected error during readline: $err");
}
return $chunk;
}
# alarm() not available (ActiveState perl for win32 doesn't have it.
# See jitterbug PR#98)
sub _check_if_alarm_available {
my $self = shift;
eval {
alarm(0);
};
if($@) {
$self->{'_alarm_available'} = 0;
}
else {
$self->{'_alarm_available'} = 1;
}
}
sub append_input_cache {
my ($self, $data) = @_;
push( @{$self->{'_input_cache'}}, $data) if defined $data;
}
sub get_input_cache {
my $self = shift;
my @cache = ();
if( ref $self->{'_input_cache'} ) {
@cache = @{$self->{'_input_cache'}};
}
return @cache;
}
sub clear_input_cache {
my $self = shift;
@{$self->{'_input_cache'}} = ();
}
1;
]]>