view release on metacpan or  search on metacpan

lib/Acme/ButFirst.pm  view on Meta::CPAN

package Acme::ButFirst;

use 5.006;
use strict;
use warnings;

use Filter::Simple;

our $VERSION = '1.00';

# Yes, this is a recursive regexp. ;)

my $block;

$block = qr{
	{					# An open-curly
		(?:
			(?> [^{}]+ )		# Non-curlies no backtracking.
			|
			(??{ $block })		# An embedded block
		)*
	}					# Close-curly
}x;

sub _butfirstify {

	# Continue to re-write our code until no more butfirst
	# sections exist.

	# We enclose each pair of blocks transposed inside their
	# own block.  This allows chained but-firsts and
	# butfirst modifiers on loops to work 'correctly'.

	1 while s{ ($block) \s* but \s* first \s* ($block) }
                 {{$2\n$1}}gxs;

};

# We have to use 'executable' rather than code, as Filter::Simple
# sometimes thinks that 'but \s* first' is a bareword string.
#
# The downside of this is that we may modify some *real* strings
# as well as code.


FILTER_ONLY executable => \&_butfirstify;

1;
__END__

=head1 NAME

Acme::ButFirst - Do something, but first do something else.

=head1 SYNOPSIS

	use Acme::ButFirst;

	# Print a greeting, but first find caffiene.

	{
		print "Good morning!\n";
	} but first {
		print "I need a coffee\n";
	}

	# Count from 1 to 10, but first print a statement
	# about our counting skills.

	foreach my $count (1..10) {
		print "$count\n";
	} but first {
		print "I can count to...";
	}

	# Print our lines, but first reverse them, but first convert
	# them into upper case.

	while (<>) {
		print;
	} butfirst {
		$_ = reverse $_;
	} butfirst {
		$_ = uc $_;
	}

=head1 DESCRIPTION