view release on metacpan or  search on metacpan

lib/Filter/Template.pm  view on Meta::CPAN

		if (ref $_ eq 'ARRAY') {
			$regexp .= $_->[0] . '(?:';

			# If the first tail is empty, make the whole group optional.
			my ($tail, $first);
			if (length $_->[1]) {
				$tail  = ')';
				$first = 1;
			}
			else {
				$tail  = ')?';
				$first = 2;
			}

			# Recurse into the group of tails.
			if ($#$_ > 1) {
				$regexp .= text_trie_as_regexp( @{$_}[$first .. $#$_] );
			}
			$regexp .= $tail;
		}
		else {
			$regexp .= $_;
		}
	}

	$regexp;
}

### End of regexp optimizer.

# These must be accessible from outside the current package.
use vars qw(%conditional_stacks %excluding_code %exclude_indent);

sub fix_exclude {
	my $package_name = shift;
	$excluding_code{$package_name} = 0;
	if (@{$conditional_stacks{$package_name}}) {
		foreach my $flag (@{$conditional_stacks{$package_name}}) {
			unless ($flag->[COND_FLAG]) {
				$excluding_code{$package_name} = 1;
				$exclude_indent{$package_name} = $flag->[COND_INDENT];
				last;
			}
		}
	}
}

my (%constants, %templates, %const_regexp, %template);

sub import {
	my $self = shift;
	my %args;
	if(@_ > 1) {
		%args = @_;
	}

	# Outer closure to define a unique scope.
	{
		my $template_name = '';
		my ($template_line, $enum_index);
		my ($package_name, $file_name, $line_number) = (caller)[0,1,2];
		my $const_regexp_dirty = 0;
		my $state = STATE_PLAIN;

		# The following block processes inheritance requests for
		# templates/constants and enums.  added by sungo 09/2001
		my @isas;

		if ($args{isa}) {
			if (ref $args{isa} eq 'ARRAY') {
				foreach my $isa (@{$args{isa}}) {
					push @isas, $isa;
				}
			}
			else {
				push @isas, $args{isa};
			}

			foreach my $isa (@isas) {
				eval "use $isa";
				croak "Unable to load $isa : $@" if $@;

				foreach my $const (keys %{$constants{$isa}}) {
					$constants{$package_name}->{$const} = $constants{$isa}->{$const};
					$const_regexp_dirty = 1;
				}

				foreach my $template (keys %{$templates{$isa}}) {
					$templates{$package_name}->{$template} = (
						$templates{$isa}->{$template}
					);
				}
			}
		}

	$conditional_stacks{$package_name} = [ ];
	$excluding_code{$package_name} = 0;

	my $set_const = sub {
		my ($name, $value) = @_;

		if (
			WARN_DEFINE and
			exists $constants{$package_name}->{$name} and
			$constants{$package_name}->{$name} ne $value
		) {
			warn "const $name redefined at $file_name line $line_number\n";
		}

		$constants{$package_name}->{$name} = $value;
		$const_regexp_dirty++;

		DEBUG_DEFINE and warn(
			",-----\n",
			"| Defined a constant: $name = $value\n",
			"`-----\n"
		);
	};

	# Define the filter sub.
	filter_add(