view release on metacpan or  search on metacpan

lib/PerlIO/via/SeqIO.pm  view on Meta::CPAN

	push @IO::Handle::ISA, 'IO::Handle::_viaSeqIO';
    }
    return;
}

our %MODE_SYM = (
    'r' => '<',
    'w' => '>',
    'a' => '>>',
    'r+' => '+<',
    'w+' => '+>',
    'a+' => '+>>'
    );

# init the layer:

sub PUSHED {
#    no strict qw(refs);
    my $self = { 
	'instance' => $INSTANCE,	
	'mode' => $_[1],
	'perl_mode' => $MODE_SYM{$_[1]},
	'format' => (split(m{::}, $_[0]))[-1],
	'eot'    => 0,
	'fh'     => undef,
	'fileno' => undef,
	'source' => undef,
	'engine' => undef,
	'inited' => 0
    };
    $self->{self} = $self; weaken $self->{self};
    $self->{format} = '' if $self->{format} eq 'SeqIO';
    bless ( $self, $_[0] );
}

# the problem: if OPEN is specified in a via module, 
# you never see the filehandle in subsequent via method
# calls (FILL, WRITE, etc.); yet we need to have access
# to the handle returned by open...however, if we do not
# define OPEN, all via method calls recieve the filehandle
# provided by the lower-level open.
# the hack: fileno() is called at the end of the lower-level
# open call; so the via FILENO provides a hook that receives
# the lower-level filehandle. We pre-empt FILENO one time to
# do our setup machinations on the real filehandle.

# grab the opened filehandle using FILENO (called at the 
# end of open() !)
sub FILENO {
    no strict qw(refs);
    my ($self,$fh) = @_;
    if (!$self->{inited}) {
	# if the secret dup is here, use it
	$fh = $PerlIO::via::SeqIO::__seqio_DUP || $fh;
	$self->{fileno} = fileno($fh); # nec to kick fileno hooks
	$self->{eot} = 0;
	for ($self->{mode}) {
	    m/r/ && do {
		$self->{source} =
		    Bio::SeqIO->new( -fh=>$fh, -format=>$self->{format} );
		$self->{format} ||= (split m/::/,ref($self->{source}))[-1];
		last;
	    };
	    m/w|a/ && do {
		$self->set_write_format($self->{format});
		last;
	    };
	    do { #huh?
		croak "failed(INIT): Don't understand mode '".$self->{mode}."'";
	    };
	}
	# connect the via object to the filehandle
	$fh->via_o($self); 
	$INSTANCE++;
	$self->{inited} = 1;
    }
    return $self->{fileno} || -1;
}

sub set_write_format {
    my ($self, $format) = @_;
    unless (grep( /^$format$/, @PerlIO::via::SeqIO::SUPPORTED_FORMATS)) {
	carp("The format '$format' isn't supported; current format unchanged");
	return;
    }
    unless ($self->{mode}  =~ /\+|w/) {
	carp("Can't set format; handle not open for writing");
	return;
    }
    $self->{format} = $format;
    $self->{io_string} = IO::String->new();
    $self->{engine} = Bio::SeqIO->new(-fh=>$self->{io_string},
				  -format=>$self->{format});
    $self->{engine}->_flush_on_write(1);
    return 1;
}

# the FILL/_readline crosstalk allows true "line-by-line" parsing with
# angle brackets. It's a hack, but the lower-level doesn't respect
# $/, as has been advertised (as far as I can tell)

sub FILL {
    my ($self, $fh) = @_;
    my $line;
    my $sep = $/;
    if ($self->{eot} == 0) {
	$self->{eot} = 1;
	$line = $self->_readline;
	$line && $sep && $line =~ s/$sep$//;
	return $line;
    }
    else { # EOT
	$self->{eot} = 0; # clear flag
#	$DB::single=1;
	if ($/) {
	    return "$/"; # kick out of FILL loop
	    # TODO: figure out why this doesn't work in ActiveState, when
	    # reading via gzip.
	}
	else {
	    return $self->_readline($fh);

lib/PerlIO/via/SeqIO.pm  view on Meta::CPAN

	}
	my $seq = Bio::Seq->new();
	$seq->id( $_->display_id || $_->id );
	$seq->primary_seq( $_ );
	push @ret, $seq;
    }
    return wantarray ? @ret : $ret[0];
}

1;

# tied handle class for special filehandle 2-argument opens
# see comments to open()

package _viaSeqIO_FH;
use strict;
use warnings;
use Config;
our %__SUB_FH;
our $AUTOLOAD;

sub TIEHANDLE { bless ( { sub_fh => undef, via_o => undef }, $_[0] ) }

sub PRINT {
    my ($self, @args) = @_;
    # use the via object's write method on the sub-handle:
    foreach (@args) {
	$self->via_o->WRITE( $_, $self->sub_fh);
    }
    return 1;
}

sub sub_fh {
    my ($self, $fh) = @_;
    if ($fh) {
	#kludge for ActivePerl:
	if ($Config{cf_email} =~ /ActiveState/) { 
	    push @IO::Handle::ISA, 'IO::Seekable';
	}
	return $__SUB_FH{$fh->fileno} = $fh;
    }
    return unless defined $self->fileno;
    return $__SUB_FH{$self->fileno};
}

sub via_o {
    my ($self, $o) = @_;
    if ($o) {
	$self->{via_o} = $o;
	Scalar::Util::weaken($self->{via_o});
    }
    return $self->{via_o};
}

# use AUTOLOAD to perform handle operations on the 
# subhandle, but delegate the work back to the 
# via class (is this Laziness, or laziness?)

sub AUTOLOAD {
    my ($self,@args) = @_;
    my $func = lc ((split m/::/, $AUTOLOAD)[-1]);
    # specials
    $func = uc $func if $func =~ /destroy/;

    for ($func) {
	# delegate these back to the via object:
	m/readline/ && do {
	    return wantarray ? 
		($self->via_o->_readline($self->sub_fh)) :
		$self->via_o->_readline($self->sub_fh);
	};
	m/fileno/ && do {
	    return unless $self->via_o;
	    return $self->via_o->FILENO();
	};
	m/flush/ && do {
	    return $self->via_o->FLUSH($self->sub_fh);
	};
	m/close/ && do {
	    return $self->via_o->CLOSE($self->sub_fh);
	};
        # otherwise, use the native methods of the sub-handle:
	do { 
	    return unless $self->sub_fh;
	    return $self->sub_fh->$func(@args);
	};
    }
}

# pollute IO::Handle slightly differently ( to avoid unauthorized
# release error)
package IO::Handle::_viaSeqIO;
use strict;
use warnings;
use Scalar::Util qw(weaken);

our %__VIA_O;

sub via_o {
    my ($self, $o) = @_;
    my $key = $self->fileno;
    if ($o) {
	$__VIA_O{$key} = $o;
	weaken($__VIA_O{$key});
    }
    return $__VIA_O{$key};
}

# want to call this off the filehandle to keep the 
# interface simple...

sub set_write_format {
    my ($self, $format) = @_;
    return unless $self->via_o;
    # delegate
    return $self->via_o->set_write_format($format);
}


1;
__END__