File Coverage

blib/lib/Text/Oyster.pm

Criterion	Covered	Total	%
statement	42	126	33.3
branch	0	30	0.0
condition	0	2	0.0
subroutine	14	30	46.6
pod	11	12	91.6
total	67	200	33.5

package Text::Oyster;

# $Id: Oyster.pm,v 1.12 2003/06/27 15:38:38 steve Exp $

# Copyright 2000-2001 by Steve McKay. All rights reserved.
# This library is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

use strict;
use Carp;
use vars qw( @ISA $VERSION );
# can we convert to use the base pragma yet?
use Parse::Tokens;
@ISA = ('Parse::Tokens');

$VERSION = 0.32;

sub new
{
	my( $class, $params ) = @_;
	my $self = $class->SUPER::new;
	$self->delimiters( [''] );	# default delimiters
	$self->package( 'Safe' );			# default package
	$self->init( $params );
	return $self;
}

sub init
{
	my( $self, $params ) = @_;
	no strict 'refs';
	my $hash;
	for ( keys %$params )
	{
		my $ref = lc $_;
		if( $_ eq 'hash' )
		{
			$hash = $params->{$_};
			next;
		}
		$self->$ref( $params->{$_} );
	}
	$self->hash( $hash ) if( defined $hash );
	use strict;
}

sub hash
{
	my( $self, $val ) = @_;
	if ( $val ){
	#	$self->_uninstall( $self->{'hash'} ) if $self->{'hash'};
	#	$self->cleanup( $self->package() );
		$self->{'hash'} = $val;
		$self->_install( $val );
	}
	return $self->{'hash'};
}

sub package
{
	my( $self, $val ) = @_;
	$self->{'package'} = $val if $val;
	return $self->{'package'};
}

sub inline_errs
{
	my( $self, $val ) = @_;
	$self->{'inline_errs'} = $val if $val;
	return $self->{'inline_errs'};
}

sub autoclean
{
	my( $self, $val ) = @_;
	$self->{'autoclean'} = $val if $val;
	return $self->{'autoclean'};
}

sub file
{
	my( $self, $val ) = @_;
	if( $val )
	{
		$self->{'file'} = $val;
		# always use the text accessor as it handles cache flushing
		$self->text( &_get_file( $self->{'file'} ) );
	}
	return $self->{'file'};
}

sub parsed
{
	my( $self ) = @_;
	return $self->{'parsed'};
}

sub parse
{
	# overide SUPER::parse
	my( $self, $params ) = @_;
	$self->{'parsed'} = undef;
	$self->init( $params );
	return unless $self->text();
	$self->SUPER::parse();
	return $self->{'parsed'};
}

sub token
{
	# overide SUPER::token
	my( $self, $token) = @_;
	my $package = $self->package();
	no strict 'vars';
	$self->{'parsed'} .= eval qq{
		package $package;
		$token->[1];
	};
	if( $@ ){
		carp $@;
		$self->{'parsed'} .= $@ if $self->inline_errs();
	}
	use strict;
}

sub ether
{
	# overide SUPER::ether

	my( $self, $text ) = @_;
	$self->{'parsed'} .= $text;
}

sub cleanup
{
	# clean up the contents of our package
	# called prior to the installation of a new hash

	my( $self, $package ) = @_;

	return if $package eq 'main';
	no strict 'refs', 'vars';
	*stash = *{"${package}::"};
	for( keys %stash )
	{
		*alias = $stash{$_};
		$alias = undef if( defined $alias );
		@alias = () if( defined @alias );
		%alias = () if( defined %alias )
	}
	use strict;
	return 1;
}

sub DESTROY
{
	my( $self ) = @_;
	$self->cleanup( $self->package() ) if $self->autoclean();
	return;
}

sub _install
{
	# install a given hash in a package for later use

	my( $self, $hash ) = @_;
	my $package = $self->package();
	no strict 'refs';
	for( keys %{$hash} )
	{
	# why if defined?
	#	next unless defined $hash->{$_};
		*{$package."::$_"} = \$hash->{$_};
	}
	use strict;
	return 1;
}

sub _uninstall
{
	# clean up the contents of our package
	# called prior to the installation of a new hash

	my( $self, $hash ) = @_;
	my $package = $self->package();
	no strict 'refs';
	for( keys %{$hash} )
	{
		*{$package."::$_"} = undef;
	}
	use strict;
	return 1;
}

sub _get_file
{
	my( $file ) = @_;
	local *IN;
	open IN, $file || return;
   	local $/;
	my $text = ;
	close IN;
	return $text;
}

1;

__END__