view release on metacpan or  search on metacpan

lib/Text/Reform.pm  view on Meta::CPAN

		}
	}
	else {
		my $tmp = $config->{header};
		$config->{header} = sub { $tmp }
	}
	if (ref $config->{footer} eq 'HASH') {
		$config->{footer} =
			lcr $config->{footer}, $config->{pagewidth}, 'footer';
	}
	elsif (ref $config->{footer} eq 'CODE') {
		my $tmp = $config->{footer};
		$config->{footer} = sub {
			my $footer = &$tmp;
			return (ref $footer eq 'HASH')
				? lcr($footer,$config->{pagewidth},'footer')->()
				: $footer;
		}
	}
	else {
		my $tmp = $config->{footer};
		$config->{footer} = sub { $tmp }
	}
	unless (ref $config->{pagefeed} eq 'CODE')
		{ my $tmp = $config->{pagefeed}; $config->{pagefeed} = sub { $tmp } }
	unless (ref $config->{break} eq 'CODE')
		{ $config->{break} = break_at($config->{break}) }
	if (defined $config->{pagenum} && ref $config->{pagenum} ne 'SCALAR') 
		{ my $tmp = $config->{pagenum}+0; $config->{pagenum} = \$tmp }
	unless (ref $config->{filler} eq 'HASH') {
		$config->{filler} = { left  => "$config->{filler}",
			  	      right => "$config->{filler}" }
	}
}

sub FormOpt::DESTROY
{
	print STDERR "\nWarning: lexical &form configuration at $std_config{_line} was never used.\n"
		if $^W && !$std_config{_used};
	%std_config = %{$std_config{_prev}};
}

sub form
{
	use vars '%carped';
	local %carped;
	my $config = {%std_config};
	my $startidx = 0;
	if (@_ && ref($_[0]) eq 'HASH')		# RESETTING CONFIG
	{
		if (@_ > 1)			# TEMPORARY RESET
		{
			$config = {%$config, %{$_[$startidx++]}};
			fix_config(%$config);
			$startidx = 1;
		}
		elsif (defined wantarray)	# CONTEXT BEING CAPTURED
		{
			$_[0]->{_prev} = { %std_config };
			$_[0]->{_used} = 0;
			$_[0]->{_line} = join " line ", (caller)[1..2];;
			%{$_[0]} = %std_config = (%std_config, %{$_[0]});
			fix_config(%std_config);
			return bless $_[0], 'FormOpt';
		}
		else				# PERMANENT RESET
		{
			$_[0]->{_used} = 1;
			$_[0]->{_line} = join " line ", (caller)[1..2];;
			%std_config = (%std_config, %{$_[0]});
			fix_config(%std_config);
			return;
		}
	}
	$config->{pagenum} = do{\(my $tmp=1)}
		unless defined $config->{pagenum};

	$std_config{_used}++;
	my @ref = map { ref } @_;
	my @orig = @_;
	my $caller = caller;
	no strict;

	for (my $nextarg=0; $nextarg<@_; $nextarg++)
	{
		my $next = $_[$nextarg];
		if (!defined $next) {
			my $tmp = "";
			splice @_, $nextarg, 1, \$tmp;
		}
		elsif ($ref[$nextarg] eq 'ARRAY') {
			splice @_, $nextarg, 1, \join("\n", @$next)
		}
		elsif ($ref[$nextarg] eq 'HASH' && $next->{cols} ) {
			croak "Missing 'from' data for 'cols' option"
				unless $next->{from};
			croak "Can't mix other options with 'cols' option"
				if keys %$next > 2;
			my ($cols, $data) = @{$next}{'cols','from'};
			croak "Invalid 'cols' option.\nExpected reference to array of column specifiers but found " . (ref($cols)||"'$cols'")
				unless ref $cols eq 'ARRAY';
			croak "Invalid 'from' data for 'cols' option.\nExpected reference to array of hashes or arrays but found " . (ref($data)||"'$data'")
				unless ref $data eq 'ARRAY';
			splice @_, $nextarg, 2, columns(@$cols,@$data);
			splice @ref, $nextarg, 2, ('ARRAY')x@$cols;
			$nextarg--;
		}
		elsif (!defined eval { local $SIG{__DIE__};
				       $_[$nextarg] = $next;
				       _debug "writeable: [$_[$nextarg]]";
				       1})
		{
		        _debug "unwriteable: [$_[$nextarg]]";
			my $arg = $_[$nextarg];
			splice @_, $nextarg, 1, \$arg;
		}
		elsif (!$ref[$nextarg]) {
			splice @_, $nextarg, 1, \$_[$nextarg];
		}
                elsif ($ref[$nextarg] ne 'HASH' and $ref[$nextarg] ne 'SCALAR')
                {
			splice @_, $nextarg, 1, \"$next";
                }
	}

	my $header = $config->{header}->(${$config->{pagenum}});
	$header.="\n" if $header && substr($header,-1,1) ne "\n";

	my $footer = $config->{footer}->(${$config->{pagenum}});