view release on metacpan or  search on metacpan

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

# the via object's goodies, but it seems to work (002_seqio.t)

sub open  {
    no strict qw(refs);
    my ($fh, $mode, $file) = @_;
    if ($file or $mode !~ /:via\(SeqIO(?:::[a-zA-Z_]+)?\)/) {
	#passthru
	# if !defined $file, parse $mode according to presence of &...
	if ($fh) {
	    if ( $fh =~ /^[A-Z]+$/ ) {
		$fh = *{(caller)[0]."::$fh"};
	    }
	}
	if ($file) {
	    if ( $file =~ /^[A-Z]+$/) {
		$file = *{(caller)[0]."::$file"};
	    }
	    return CORE::open($fh || $_[0],$_[1],$file);
	}
	else {
	    $_[0] ? 
		($_[0] = PerlIO::Util->open($_[1])) : 
		CORE::open($fh || $_[0],$_[1]);

	}
    }
    # deal with special filehandles with 2-argument opens
    if ($fh and $fh =~ /(DATA|STD(?:IN|OUT))/) {
	no strict qw(refs);
	my $dup = gensym;
	my $bareword = $1;
	my $redirect = ($bareword =~ /OUT/ ? ">&" : "<&");
	# get a pristine copy of DATA/STDIN/STDOUT
	$fh = *{(caller)[0]."::$bareword"};
	CORE::open($dup, $redirect, $fh) or croak($!);
	if ($bareword =~ /OUT/) {
	    $| && $dup->autoflush(1);
	}
	# now, need to make everything output to the duplicated
	# handle; may need to use ties after all (to make real
	# writes to the subordinate handle only...)
	
	# provide dummy file to CORE::open
	my ($dumh, $file) = tempfile("dumXXXX", UNLINK=>1);

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

	tie $fh, '_viaSeqIO_FH';
	(tied $fh)->sub_fh($dup);
	# private pointer for tied object...
	(tied $fh)->via_o( $dumh->via_o );
	return 1;
	
    }
    else { # passthru
	$DB::single=1;
	($mode, $file) = $mode =~ /(\+?(?:<|>)?>?&?)(.*)/;
	$file =~ /^[A-Z]+$/ and $file = *{(caller)[0]."::$file"};
	$_[0] = PerlIO::Util->open($mode,$file);
    }
    1;
}

# seq object converter

sub T {
    my @objs = @_;
    my @ret;

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

    my $sym = shift;
    $sym ||= $_; 
    for ($sym) {
	m/Bio/ && do {
	    return $OBJS{$sym}; last;
	};
	m/via/ && do {
	    return (tied $sym)->via_o; last;
	};
	m/^[A-Z]+$/ && do {
	    $sym = (caller)[0]."::$sym";
	    return (tied *$sym)->via_o if (tied *$sym);
	    return;
	    last;
	};
    }
    croak("Don't understand the arg");
}

# wrap Bio::PrimarySeqs (incl. Bio::LocatableSeqs) in a Bio::Seq
# for Bio::SeqIO use