File Coverage

blib/lib/String/ExpandEscapes.pm

Criterion	Covered	Total	%
statement	12	38	31.5
branch	0	16	0.0
condition	0	3	0.0
subroutine	4	6	66.6
pod	1	2	50.0
total	17	65	26.1

package String::ExpandEscapes;
#
#	String::ExpandEscapes - Expand printf-style %-escapes in a string.
#
#	Copyright (c) 2003 Matthias Friedrich .
#
#	$Id: ExpandEscapes.pm,v 1.1.1.1 2003/04/03 19:10:10 matthias Exp $
#

use 5.008;
use strict;
use warnings;
use Carp;

require Exporter;

#
# Change version number for each release!
#
our $VERSION = '0.01';

our @ISA = qw(Exporter);

#
# This allows declaration	use String::ExpandEscapes ':all';
#
our %EXPORT_TAGS = (
	'all' => [ qw(expand expand_handler) ]
);

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

# Export nothing by default.
#
our @EXPORT = qw(
);


#
# This is the default substitution function.
#
sub expand_handler($$$$$)
{
	my $flags = shift;		# left or right alignment
	my $width = shift;		# maximum field width
	my $precision = shift;		# precision
	my $format = shift;		# key for the conversation table
	my $table = shift;		# conversation table (hash reference)

	$precision = ".$precision" if $precision ne '';

	# rewrite '%%' to '%'
	return '%' if $format eq '%';

	# check if we have a rewrite rule for this format specifier
	return undef unless defined $table->{ $format };

	# everything worked fine, now return the string
	return sprintf("%${flags}${width}${precision}s", $table->{ $format } );
}


#
# expand()
#
#	Expand printf-style escape sequences in a string according to a
#	given conversation table.
#
#	Arguments:	source string
#			hash reference to the conversation table or code ref
#			optional user data that is passed to each handler call
#
#	Returns:	destination string
#
#	Examples:	expand('%s', \&handler, ...)
#			expand('%s', \%table)
#
sub expand($$@)
{
	my $str = shift;	# The string containing the escape sequences.
	my $arg = shift;	# First argument: either HASH or CODE.
	my $handler;		# Code reference for a handler function.
	my @user_data;		# Arguments that are passed to the handler.

	#
	# two possibilities:
	#	1. handler is code reference
	#	2. handler is hash reference
	#
	if ( ref $arg eq 'CODE' ) {
		$handler = $arg;
		@user_data = @_;
	}
	elsif ( ref $arg eq 'HASH' ) {

		# If called with a hash reference, no further arguments are
		# allowed
		#
		if ( @_ != 0 ) {
			croak 'expand called in table mode with '
				. 'to many arguments';
		}
		$handler = \&expand_handler;
		@user_data = $arg;
	}
	else {
		croak 'expand called with an argument that is '
			. 'neither a code nor a hash reference';
	}

	#
	# Parse the format string. The code below is executed for each match.
	#
	$str =~ s/	%
			([- +0#]*)	# flags
			(\d*)		# minimum field width aka width
			(\.?)
			(\d*)		# maximum field width aka precision
			(.)		# format selection
		/
			# Special case: "%-10.s" means "%-10.0s".
			#
			my $prec = ( $3 eq '.' and $4 eq '' ) ? 0 : $4;

			# The handler returns the string to substitute.
			#
			my $result = &$handler($1, $2, $prec, $5, @user_data);

			# Leave the function if the handler returned an error.
			#
			return (undef, $&) unless defined $result;

			$result;		# Do the replacement.
		/gesx;

	#
	# We got here without errors, return the string.
	#
	#return $str;
	return ($str, 0);
}


1;

__END__