[p5sagit/p5-mst-13.2.git] / lib / Filter / Simple.pm

package Filter::Simple;

use vars qw{ $VERSION };

$VERSION = '0.60';

use Filter::Util::Call;
use Carp;

sub import {
	if (@_>1) { shift; goto &FILTER }
	else      { *{caller()."::FILTER"} = \&FILTER }
}

sub FILTER (&;$) {
	my $caller = caller;
	my ($filter, $terminator) = @_;
	croak "Usage: use Filter::Simple sub {...}, $terminator_opt;"
		unless ref $filter eq CODE;
	*{"${caller}::import"} = gen_filter_import($caller,$filter,$terminator);
	*{"${caller}::unimport"} = \*filter_unimport;
}

sub gen_filter_import {
    my ($class, $filter, $terminator) = @_;
    return sub {
	my ($imported_class, @args) = @_;
	$terminator = qr/^\s*no\s+$imported_class\s*;\s*$/
		unless defined $terminator;
	filter_add(
		sub {
			my ($status, $off);
			my $count = 0;
			my $data = "";
			while ($status = filter_read()) {
				return $status if $status < 0;
				if ($terminator && m/$terminator/) {
					$off=1;
					last;
				}
				$data .= $_;
				$count++;
				$_ = "";
			}
			$_ = $data;
			$filter->(@args) unless $status < 0;
			$_ .= "no $imported_class;\n" if $off;
			return $count;
		}
	);
    }
}

sub filter_unimport {
	filter_del();
}

1;

__END__

=head1 NAME

Filter::Simple - Simplified source filtering


=head1 SYNOPSIS

 # in MyFilter.pm:

	 package MyFilter;

	 use Filter::Simple;
	 
	 FILTER { ... };

	 # or just:
	 #
	 # use Filter::Simple sub { ... };

 # in user's code:

	 use MyFilter;

	 # this code is filtered

	 no MyFilter;

	 # this code is not


=head1 DESCRIPTION

=head2 The Problem

Source filtering is an immensely powerful feature of recent versions of Perl.
It allows one to extend the language itself (e.g. the Switch module), to 
simplify the language (e.g. Language::Pythonesque), or to completely recast the
language (e.g. Lingua::Romana::Perligata). Effectively, it allows one to use
the full power of Perl as its own, recursively applied, macro language.

The excellent Filter::Util::Call module (by Paul Marquess) provides a
usable Perl interface to source filtering, but it is often too powerful
and not nearly as simple as it could be.

To use the module it is necessary to do the following:

=over 4

=item 1.

Download, build, and install the Filter::Util::Call module.
(If you have Perl 5.7.1 or later you already have Filter::Util::Call.)

=item 2.

Set up a module that does a C<use Filter::Util::Call>.

=item 3.

Within that module, create an C<import> subroutine.

=item 4.

Within the C<import> subroutine do a call to C<filter_add>, passing
it either a subroutine reference.

=item 5.

Within the subroutine reference, call C<filter_read> or C<filter_read_exact>
to "prime" $_ with source code data from the source file that will
C<use> your module. Check the status value returned to see if any
source code was actually read in.

=item 6.

Process the contents of $_ to change the source code in the desired manner.

=item 7.

Return the status value.

=item 8.

If the act of unimporting your module (via a C<no>) should cause source
code filtering to cease, create an C<unimport> subroutine, and have it call
C<filter_del>. Make sure that the call to C<filter_read> or
C<filter_read_exact> in step 5 will not accidentally read past the
C<no>. Effectively this limits source code filters to line-by-line
operation, unless the C<import> subroutine does some fancy
pre-pre-parsing of the source code it's filtering.

=back

For example, here is a minimal source code filter in a module named
BANG.pm. It simply converts every occurrence of the sequence C<BANG\s+BANG>
to the sequence C<die 'BANG' if $BANG> in any piece of code following a
C<use BANG;> statement (until the next C<no BANG;> statement, if any):

        package BANG;
 
        use Filter::Util::Call ;

        sub import {
            filter_add( sub {
                my $caller = caller;
                my ($status, $no_seen, $data);
                while ($status = filter_read()) {
                        if (/^\s*no\s+$caller\s*;\s*?$/) {
                                $no_seen=1;
                                last;
                        }
                        $data .= $_;
                        $_ = "";
                }
                $_ = $data;
                s/BANG\s+BANG/die 'BANG' if \$BANG/g
                        unless $status < 0;
                $_ .= "no $class;\n" if $no_seen;
                return 1;
            })
        }

        sub unimport {
            filter_del();
        }

        1 ;

This level of sophistication puts filtering out of the reach of
many programmers.


=head2 A Solution

The Filter::Simple module provides a simplified interface to
Filter::Util::Call; one that is sufficient for most common cases.

Instead of the above process, with Filter::Simple the task of setting up
a source code filter is reduced to:

=over 4

=item 1.

Set up a module that does a C<use Filter::Simple> and then
calls C<FILTER { ... }>.

=item 2.

Within the anonymous subroutine or block that is passed to
C<FILTER>, process the contents of $_ to change the source code in
the desired manner.

=back

In other words, the previous example, would become:

        package BANG;
        use Filter::Simple;
	
	FILTER {
            s/BANG\s+BANG/die 'BANG' if \$BANG/g;
        };

        1 ;


=head2 Disabling or changing <no> behaviour

By default, the installed filter only filters to a line of the form:

        no ModuleName;

but this can be altered by passing a second argument to C<use Filter::Simple>.

That second argument may be either a C<qr>'d regular expression (which is then
used to match the terminator line), or a defined false value (which indicates
that no terminator line should be looked for).

For example, to cause the previous filter to filter only up to a line of the
form:

        GNAB esu;

you would write:

        package BANG;
        use Filter::Simple;
	
	FILTER {
                s/BANG\s+BANG/die 'BANG' if \$BANG/g;
        }
        => qr/^\s*GNAB\s+esu\s*;\s*?$/;

and to prevent the filter's being turned off in any way:

        package BANG;
        use Filter::Simple;
	
	FILTER {
                s/BANG\s+BANG/die 'BANG' if \$BANG/g;
        }
              => "";
	# or: => 0;


=head2 All-in-one interface

Separating the loading of Filter::Simple:

        use Filter::Simple;

from the setting up of the filtering:

        FILTER { ... };

is useful because it allows other code (typically parser support code
or caching variables) to be defined before the filter is invoked.
However, there is often no need for such a separation.

In those cases, it is easier to just append the filtering subroutine and
any terminator specification directly to the C<use> statement that loads
Filter::Simple, like so:

        use Filter::Simple sub {
                s/BANG\s+BANG/die 'BANG' if \$BANG/g;
        };

This is exactly the same as:

        use Filter::Simple;
	BEGIN {
		Filter::Simple::FILTER {
			s/BANG\s+BANG/die 'BANG' if \$BANG/g;
		};
	}

except that the C<FILTER> subroutine is not exported by Filter::Simple.


=head2 How it works

The Filter::Simple module exports into the package that calls C<FILTER>
(or C<use>s it directly) -- such as package "BANG" in the above example --
two automagically constructed
subroutines -- C<import> and C<unimport> -- which take care of all the
nasty details.

In addition, the generated C<import> subroutine passes its own argument
list to the filtering subroutine, so the BANG.pm filter could easily 
be made parametric:

        package BANG;
 
        use Filter::Simple;
        
        FILTER {
            my ($die_msg, $var_name) = @_;
            s/BANG\s+BANG/die '$die_msg' if \${$var_name}/g;
        };

        # and in some user code:

        use BANG "BOOM", "BAM";  # "BANG BANG" becomes: die 'BOOM' if $BAM


The specified filtering subroutine is called every time a C<use BANG> is
encountered, and passed all the source code following that call, up to
either the next C<no BANG;> (or whatever terminator you've set) or the
end of the source file, whichever occurs first. By default, any C<no
BANG;> call must appear by itself on a separate line, or it is ignored.


=head1 AUTHOR

Damian Conway (damian@conway.org)

=head1 COPYRIGHT

 Copyright (c) 2000, Damian Conway. All Rights Reserved.
 This module is free software. It may be used, redistributed
and/or modified under the terms of the Perl Artistic License
     (see http://www.perl.com/perl/misc/Artistic.html)
Commit	Line	Data
b38acab9	1	package Filter::Simple;
	2
	3	use vars qw{ $VERSION };
	4
fbe2c49e	5	$VERSION = '0.60';
b38acab9	6
	7	use Filter::Util::Call;
	8	use Carp;
	9
	10	sub import {
fbe2c49e	11	if (@_>1) { shift; goto &FILTER }
	12	else { *{caller()."::FILTER"} = \&FILTER }
	13	}
	14
	15	sub FILTER (&;$) {
b38acab9	16	my $caller = caller;
fbe2c49e	17	my ($filter, $terminator) = @_;
	18	croak "Usage: use Filter::Simple sub {...}, $terminator_opt;"
	19	unless ref $filter eq CODE;
	20	*{"${caller}::import"} = gen_filter_import($caller,$filter,$terminator);
b38acab9	21	{"${caller}::unimport"} = \filter_unimport;
	22	}
	23
	24	sub gen_filter_import {
fbe2c49e	25	my ($class, $filter, $terminator) = @_;
b38acab9	26	return sub {
b38acab9	27	my ($imported_class, @args) = @_;
fbe2c49e	28	$terminator = qr/^\sno\s+$imported_class\s;\s*$/
fbe2c49e	29	unless defined $terminator;
b38acab9	30	filter_add(
	31	sub {
	32	my ($status, $off);
fbe2c49e	33	my $count = 0;
b38acab9	34	my $data = "";
b38acab9	35	while ($status = filter_read()) {
fbe2c49e	36	return $status if $status < 0;
fbe2c49e	37	if ($terminator && m/$terminator/) {
b38acab9	38	$off=1;
	39	last;
	40	}
	41	$data .= $_;
fbe2c49e	42	$count++;
b38acab9	43	$_ = "";
	44	}
	45	$_ = $data;
	46	$filter->(@args) unless $status < 0;
fbe2c49e	47	$_ .= "no $imported_class;\n" if $off;
fbe2c49e	48	return $count;
b38acab9	49	}
	50	);
	51	}
	52	}
	53
	54	sub filter_unimport {
	55	filter_del();
	56	}
	57
	58	1;
	59
	60	__END__
	61
	62	=head1 NAME
	63
	64	Filter::Simple - Simplified source filtering
	65
fbe2c49e	66
b38acab9	67	=head1 SYNOPSIS
	68
	69	# in MyFilter.pm:
	70
	71	package MyFilter;
	72
fbe2c49e	73	use Filter::Simple;
	74
	75	FILTER { ... };
b38acab9	76
fbe2c49e	77	# or just:
	78	#
	79	# use Filter::Simple sub { ... };
b38acab9	80
	81	# in user's code:
	82
	83	use MyFilter;
	84
	85	# this code is filtered
	86
	87	no MyFilter;
	88
	89	# this code is not
	90
	91
	92	=head1 DESCRIPTION
	93
	94	=head2 The Problem
	95
	96	Source filtering is an immensely powerful feature of recent versions of Perl.
	97	It allows one to extend the language itself (e.g. the Switch module), to
	98	simplify the language (e.g. Language::Pythonesque), or to completely recast the
	99	language (e.g. Lingua::Romana::Perligata). Effectively, it allows one to use
	100	the full power of Perl as its own, recursively applied, macro language.
	101
	102	The excellent Filter::Util::Call module (by Paul Marquess) provides a
	103	usable Perl interface to source filtering, but it is often too powerful
	104	and not nearly as simple as it could be.
	105
	106	To use the module it is necessary to do the following:
	107
	108	=over 4
	109
	110	=item 1.
	111
	112	Download, build, and install the Filter::Util::Call module.
67438989	113	(If you have Perl 5.7.1 or later you already have Filter::Util::Call.)
b38acab9	114
	115	=item 2.
	116
	117	Set up a module that does a C<use Filter::Util::Call>.
	118
	119	=item 3.
	120
	121	Within that module, create an C<import> subroutine.
	122
	123	=item 4.
	124
	125	Within the C<import> subroutine do a call to C<filter_add>, passing
	126	it either a subroutine reference.
	127
	128	=item 5.
	129
	130	Within the subroutine reference, call C<filter_read> or C<filter_read_exact>
	131	to "prime" $_ with source code data from the source file that will
	132	C<use> your module. Check the status value returned to see if any
	133	source code was actually read in.
	134
	135	=item 6.
	136
	137	Process the contents of $_ to change the source code in the desired manner.
	138
	139	=item 7.
	140
	141	Return the status value.
	142
	143	=item 8.
	144
	145	If the act of unimporting your module (via a C<no>) should cause source
	146	code filtering to cease, create an C<unimport> subroutine, and have it call
	147	C<filter_del>. Make sure that the call to C<filter_read> or
	148	C<filter_read_exact> in step 5 will not accidentally read past the
	149	C<no>. Effectively this limits source code filters to line-by-line
	150	operation, unless the C<import> subroutine does some fancy
	151	pre-pre-parsing of the source code it's filtering.
	152
	153	=back
	154
	155	For example, here is a minimal source code filter in a module named
	156	BANG.pm. It simply converts every occurrence of the sequence C<BANG\s+BANG>
	157	to the sequence C<die 'BANG' if $BANG> in any piece of code following a
	158	C<use BANG;> statement (until the next C<no BANG;> statement, if any):
	159
	160	package BANG;
fbe2c49e	161
b38acab9	162	use Filter::Util::Call ;
	163
	164	sub import {
	165	filter_add( sub {
	166	my $caller = caller;
	167	my ($status, $no_seen, $data);
	168	while ($status = filter_read()) {
fbe2c49e	169	if (/^\sno\s+$caller\s;\s*?$/) {
b38acab9	170	$no_seen=1;
	171	last;
	172	}
	173	$data .= $_;
	174	$_ = "";
	175	}
	176	$_ = $data;
	177	s/BANG\s+BANG/die 'BANG' if \$BANG/g
	178	unless $status < 0;
	179	$_ .= "no $class;\n" if $no_seen;
	180	return 1;
	181	})
	182	}
	183
	184	sub unimport {
	185	filter_del();
	186	}
	187
	188	1 ;
	189
7bf0340c	190	This level of sophistication puts filtering out of the reach of
7bf0340c	191	many programmers.
b38acab9	192
	193
	194	=head2 A Solution
	195
7bf0340c	196	The Filter::Simple module provides a simplified interface to
b38acab9	197	Filter::Util::Call; one that is sufficient for most common cases.
	198
	199	Instead of the above process, with Filter::Simple the task of setting up
	200	a source code filter is reduced to:
	201
	202	=over 4
	203
	204	=item 1.
	205
fbe2c49e	206	Set up a module that does a C<use Filter::Simple> and then
fbe2c49e	207	calls C<FILTER { ... }>.
b38acab9	208
	209	=item 2.
	210
fbe2c49e	211	Within the anonymous subroutine or block that is passed to
	212	C<FILTER>, process the contents of $_ to change the source code in
	213	the desired manner.
b38acab9	214
	215	=back
	216
	217	In other words, the previous example, would become:
	218
	219	package BANG;
fbe2c49e	220	use Filter::Simple;
	221
	222	FILTER {
b38acab9	223	s/BANG\s+BANG/die 'BANG' if \$BANG/g;
	224	};
	225
	226	1 ;
	227
	228
fbe2c49e	229	=head2 Disabling or changing <no> behaviour
	230
	231	By default, the installed filter only filters to a line of the form:
	232
	233	no ModuleName;
	234
	235	but this can be altered by passing a second argument to C<use Filter::Simple>.
	236
	237	That second argument may be either a C<qr>'d regular expression (which is then
	238	used to match the terminator line), or a defined false value (which indicates
	239	that no terminator line should be looked for).
	240
	241	For example, to cause the previous filter to filter only up to a line of the
	242	form:
	243
	244	GNAB esu;
	245
	246	you would write:
	247
	248	package BANG;
	249	use Filter::Simple;
	250
	251	FILTER {
	252	s/BANG\s+BANG/die 'BANG' if \$BANG/g;
	253	}
	254	=> qr/^\sGNAB\s+esu\s;\s*?$/;
	255
	256	and to prevent the filter's being turned off in any way:
	257
	258	package BANG;
	259	use Filter::Simple;
	260
	261	FILTER {
	262	s/BANG\s+BANG/die 'BANG' if \$BANG/g;
	263	}
	264	=> "";
	265	# or: => 0;
	266
	267
	268	=head2 All-in-one interface
	269
	270	Separating the loading of Filter::Simple:
	271
	272	use Filter::Simple;
	273
	274	from the setting up of the filtering:
	275
	276	FILTER { ... };
	277
	278	is useful because it allows other code (typically parser support code
	279	or caching variables) to be defined before the filter is invoked.
	280	However, there is often no need for such a separation.
	281
	282	In those cases, it is easier to just append the filtering subroutine and
	283	any terminator specification directly to the C<use> statement that loads
	284	Filter::Simple, like so:
	285
	286	use Filter::Simple sub {
	287	s/BANG\s+BANG/die 'BANG' if \$BANG/g;
	288	};
	289
	290	This is exactly the same as:
	291
	292	use Filter::Simple;
293	BEGIN {
294	Filter::Simple::FILTER {
295	s/BANG\s+BANG/die 'BANG' if \$BANG/g;
296	};
297	}
298
299	except that the C<FILTER> subroutine is not exported by Filter::Simple.
300
301
b38acab9	302	=head2 How it works
b38acab9	303
fbe2c49e	304	The Filter::Simple module exports into the package that calls C<FILTER>
	305	(or C<use>s it directly) -- such as package "BANG" in the above example --
	306	two automagically constructed
b38acab9	307	subroutines -- C<import> and C<unimport> -- which take care of all the
	308	nasty details.
	309
	310	In addition, the generated C<import> subroutine passes its own argument
	311	list to the filtering subroutine, so the BANG.pm filter could easily
	312	be made parametric:
	313
	314	package BANG;
fbe2c49e	315
	316	use Filter::Simple;
	317
	318	FILTER {
b38acab9	319	my ($die_msg, $var_name) = @_;
	320	s/BANG\s+BANG/die '$die_msg' if \${$var_name}/g;
	321	};
	322
	323	# and in some user code:
	324
fbe2c49e	325	use BANG "BOOM", "BAM"; # "BANG BANG" becomes: die 'BOOM' if $BAM
b38acab9	326
b38acab9	327
fbe2c49e	328	The specified filtering subroutine is called every time a C<use BANG> is
	329	encountered, and passed all the source code following that call, up to
	330	either the next C<no BANG;> (or whatever terminator you've set) or the
	331	end of the source file, whichever occurs first. By default, any C<no
	332	BANG;> call must appear by itself on a separate line, or it is ignored.
b38acab9	333
	334
	335	=head1 AUTHOR
	336
	337	Damian Conway (damian@conway.org)
	338
	339	=head1 COPYRIGHT
	340
	341	Copyright (c) 2000, Damian Conway. All Rights Reserved.
fbe2c49e	342	This module is free software. It may be used, redistributed
	343	and/or modified under the terms of the Perl Artistic License
	344	(see http://www.perl.com/perl/misc/Artistic.html)