File Coverage

blib/lib/Regexp/Ignore.pm

Criterion	Covered	Total	%
statement	126	135	93.3
branch	10	16	62.5
condition	7	10	70.0
subroutine	12	14	85.7
pod	10	11	90.9
total	165	186	88.7

package Regexp::Ignore;

use 5.006;
use strict;
use warnings;

our $VERSION = '0.03';

#############################################################
# new($original_text, $delimiter_pattern)
#############################################################
# the constructor
sub new {
    my $proto = shift; # get the class name
    my $class = ref($proto) || $proto;
    my $self  = {};

    $self->{TEXT} = shift;
    $self->{DELIMITER_PATTERN} = shift;

    $self->{DELIMITER_PATTERN_REGULAR_EXPRESSION} = $self->{DELIMITER_PATTERN};
    $self->{DELIMITER_PATTERN_REGULAR_EXPRESSION} =
	quotemeta($self->{DELIMITER_PATTERN_REGULAR_EXPRESSION});
    $self->{DELIMITER_PATTERN_REGULAR_EXPRESSION} =~
	s/__INDEX__/\(\?\:[\\d\]\+\)/g;
    $self->{DELIMITER_PATTERN_REGULAR_EXPRESSION} =
	qr/$self->{DELIMITER_PATTERN_REGULAR_EXPRESSION}/;
    $self->{TRANSLATION_POSITION_FACTOR} = 0;
    bless ($self, $class);
    return $self;
} # of new

#################
# text
#################
sub text {
    my $self = shift;
    if (@_) { $self->{TEXT} = shift }
    return $self->{TEXT};
} # of text

#################
# delimited_text
#################
sub delimited_text {
    my $self = shift;
    return $self->{DELIMITED_TEXT};
} # of delimited_text

#################
# cleaned_text
#################
sub cleaned_text {
    my $self = shift;
    if (@_) { $self->{CLEANED_TEXT} = shift }
    return $self->{CLEANED_TEXT};
} # of cleaned_text

######################
# delimiter_pattern
######################
sub delimiter_pattern {
    my $self = shift;
    if (@_) { $self->{DELIMITER_PATTERN} = shift }
    return $self->{DELIMITER_PATTERN};
} # of delimiter_pattern

######################
# translation_position_factor
######################
sub translation_position_factor {
    my $self = shift;
    if (@_) { $self->{TRANSLATION_POSITION_FACTOR} = shift }
    return $self->{TRANSLATION_POSITION_FACTOR};
} # of translation_position_factor

########################
# get_tokens
########################
sub get_tokens {
    my $self = shift;
    die("This is an abstract method");
} # of get_tokens

#####################
# split
#####################
sub split {
    my $self = shift;
    # get the tokens
    $self->{TOKENS} = [];
    $self->{FLAGS} = [];
    ($self->{TOKENS}, $self->{FLAGS}) = $self->get_tokens();

    # now build the delimited text which will hold the wanted tokens and
    # for each token, a delimiter just before it, that represents the token.
    # build also the cleaned text and the positions translation between them
    $self->{DELIMITED_TEXT} = "";
    $self->{CLEANED_TEXT} = "";
    my $index = 0;
    my $cleaned_position = 0;
    my $delimited_position = 0;
    my $delimiter_length = length($self->{DELIMITER_PATTERN});
    my @cleaned_to_delimited_positions;
    while (defined($self->{TOKENS}[$index])) {
	if ($self->{FLAGS}[$index]) { # if the flag is 1, the text is clean
	    my $token = $self->{TOKENS}[$index];
	    my $token_length = length($token);

	    # add the token to the cleaned text with the delimiter
	    $self->{DELIMITED_TEXT} .= $token;
	    $self->{CLEANED_TEXT} .= $token;

	    # now keep the positions
	    if ($token_length > 0) {
		for (my $j = 0; $j < $token_length; $j++) {
		    $cleaned_to_delimited_positions[$cleaned_position + $j] =
			$delimited_position + $j;
#		    print "".($cleaned_position + $j)." ==> ".
#			($delimited_position + $j)."\n";
		}
		$cleaned_position += $token_length;
		$delimited_position += $token_length;
	    }
	}
	else {
	    # create the delimiter and add it to the delimited text.
	    my $delimiter = $self->{DELIMITER_PATTERN};
	    my $index_string = sprintf("%09d", $index);
	    $delimiter =~ s/__INDEX__/$index_string/g;
	    $self->{DELIMITED_TEXT} .= $delimiter;
	    # add the delimiter length to the $delimited_position
	    $delimited_position += $delimiter_length;
	}
	$index++; # increment the index
    }
    # save the translation hash as a data member
    $self->{CLEANED_TO_DELIMITED_POSITIONS} = \@cleaned_to_delimited_positions;
} # of split

#######################
# s
#
# switches:
#                   e   Evaluate the right side as an expression.
#            second e   The replacement portion is `eval'ed before being
#                       run as a Perl expression
# e is not yet implemented.
#                   g   Replace globally, i.e., all occurrences.
#                   i   Do case-insensitive pattern matching.
#                   m   Treat string as multiple lines.
#                   o   Compile pattern only once.
#                   s   Treat string as single line.
#                   x   Use extended regular expressions.
#######################
sub s {
    my $self = shift;
    my $pattern = shift;
    my $replacer = shift || "";
    my $switches = shift || "";

    # if there is a g switch, remember it and remove it from
    # the switches string
    my $g_switch = ($switches =~ s/g//g);
    # the same with e switches
    my $e_switch = ($switches =~ s/e//g);

    # calculate the compiled pattern - include the switches
    my $compiled_pattern = eval("qr/$pattern/$switches");

    # we build the resulted cleaned text (after replacing) in the buffer
    my $buffer = "";
    my $last_position = 0; # holds the position just after each match

    # the translation factor fix the translation table, when we have
    # a replacer that is different in its size from the match.
    $self->{TRANSLATION_POSITION_FACTOR} = 0;

    # a flag that we use to implement the g switch.
    my $no_g_counter = 1;

    # counter will count the number of substitutions
    my $counter = 0;

    # the main loop where we match and replace
    while ($no_g_counter && $self->{CLEANED_TEXT} =~ /$compiled_pattern/gc) {
	$no_g_counter = $g_switch;
	# keep the matching varibales. note that we do not keep the variables
	# $` and $'.
	my $variables = { 1 => $1,
			  2 => $2,
			  3 => $3,
			  4 => $4,
			  5 => $5,
			  6 => $6,
			  7 => $7,
			  8 => $8,
			  9 => $9,
		          '&' => $& };
	my $match = $&; # the match itself
	# get the position of the end of the match, the start of the match,
	# and the match length
	my $end_match_position = pos($self->{CLEANED_TEXT}) - 1;
	my $match_length = length($match);
	my $start_match_position = $end_match_position - $match_length + 1;
	# calculate the replacer and its length
	my $this_replacer = $replacer;
	$this_replacer =~ s/\$([0-9])/$variables->{$1}/g;

# here I tried to create the e_switch. there are two problems with it:
# 1. lexical variables from the code that calls this method are not
#    available for this method.
# 2. I didn't fully understand the way it is done with the real s//
#    operator - when it is evaled, how to eval the expression without the
#    variable etc.
# so meanwhile, use replace.
#	if ($e_switch) {
#	    my ($package, $filename, $line) = caller;
#	    if ($e_switch >= 1) {
#		my $put_quotes = sub {
#		    my $one = shift || "";
#		    my $two = shift || "";
#		    my $three = shift || "";
#		    if ($one eq '"' && $three eq '"') {
#			return "\'\$$two\'";
#		    }
#		    else {
#			return "$one\'\$$two\'$three";
#		    }
#		};
#		$this_replacer =~
#		    s/(\"?)\$(\w+)(\"?)/&$put_quotes($1, $2, $3)/ge;
#		$this_replacer =~ s/\&(\w+)/\&$package\:\:$1/g;
#		print "eval($this_replacer)\n";
#		$this_replacer = eval($this_replacer);
#	    }
#	    if ($e_switch == 2) {
#		$this_replacer =~ s/\$(\w+)/\$$package\:\:$1/g;
#		print "eval($this_replacer)\n";
#		$this_replacer = eval($this_replacer);
#	    }
#	}

	my $replacer_length = length($this_replacer);

#	print $self->{CLEANED_TEXT}."\n";
	$self->replace(\$buffer,
		       \$last_position,
		       $start_match_position,
		       $end_match_position,
		       $this_replacer);
	$counter++;
    }
    # add the rest of the text in the cleaned text
    $buffer .= substr($self->{CLEANED_TEXT}, $last_position);
    $self->{CLEANED_TEXT} = $buffer;
    return $counter;
} # of s

#####################
# replace
#####################
sub replace {
    my $self = shift;
    my $buffer_ref = shift;
    my $last_position_ref = shift;
    my $start_match_position = shift;
    my $end_match_position = shift;
    my $this_replacer = shift;

    my $match_length = $end_match_position - $start_match_position + 1;
    my $replacer_length = length($this_replacer);

#    print "replace: \$start_match_position=$start_match_position\n";
#    print "replace: \$end_match_position=$end_match_position\n";
#    print "replace: \$match_length=$match_length\n";
#    print "replace: \$replacer_length=$replacer_length\n";
#    print "replace: \$this_replacer=$this_replacer==\n";
#    print "replace: TRANSLATION_POSITION_FACTOR=".
#	$self->{TRANSLATION_POSITION_FACTOR}."\n";

    my $translation_array =
	$self->{CLEANED_TO_DELIMITED_POSITIONS};

    # build the buffer of the cleaned text
    $$buffer_ref .=
	substr($self->{CLEANED_TEXT},
	       $$last_position_ref,
	       $start_match_position - $$last_position_ref).$this_replacer;

    # get the start and end positions of the match in the delimited text
    my $delimited_start_match_position =
	$translation_array->[$start_match_position +
			     $self->{TRANSLATION_POSITION_FACTOR}];
    my $delimited_end_match_position =
	$translation_array->[$end_match_position +
			     $self->{TRANSLATION_POSITION_FACTOR}];
    my $delimited_match_length = $delimited_end_match_position -
	$delimited_start_match_position + 1;

    # get that delimited text in the matched position
    my $delimited_match = substr($self->{DELIMITED_TEXT},
				 $delimited_start_match_position,
				 $delimited_match_length);
#    print "delimited_match=$delimited_match\n";
    my $re = $self->{DELIMITER_PATTERN_REGULAR_EXPRESSION};
    my @delimiters = ($delimited_match =~ /$re/g);
    my $delimited_replacer = $this_replacer.join("",@delimiters);
    $self->{DELIMITED_TEXT} =
	substr($self->{DELIMITED_TEXT},
	       0, $delimited_start_match_position).
		   $delimited_replacer.
		       substr($self->{DELIMITED_TEXT},
			      $delimited_end_match_position + 1);

    # calculate the translation position factor
    my $new_translation_position_factor = $replacer_length - $match_length;

    # fix the translation array
    # first of all we should push (or pull) all the indexes after the
    # replacer.
    my $translation_array_size = scalar(@$translation_array);

    if ($new_translation_position_factor < 0) {
	# if the factor is negative we should copy the cells in the array
	# from the start to the end (so we do not run over the cells we
	# want to copy from)
	for (my $i =
	     $end_match_position + $self->{TRANSLATION_POSITION_FACTOR} + 1;
	     $i < $translation_array_size; $i++) {
	    $translation_array->[$i + $new_translation_position_factor] =
		$translation_array->[$i] + $new_translation_position_factor;
	}
    }
    elsif ($new_translation_position_factor > 0) {
	# if the factor is positive we should copy the cells in the array
	# from the end to the start (so we do not run over the cells we
	# want to copy from)
	for (my $i = $translation_array_size - 1;
	     $i > $end_match_position + $self->{TRANSLATION_POSITION_FACTOR};
	     $i--) {
	    $translation_array->[$i + $new_translation_position_factor] =
		$translation_array->[$i] + $new_translation_position_factor;
	}
    }

    # now we should create the translation for the new replacer. we know,
    # though, that the replacer is put in the start of the region in the
    # delimited_text (and after it we put all the delimiters). so the
    # translation is simple:
    for (my $i = 0; $i < $replacer_length; $i++) {
	$translation_array->[$start_match_position +
			     $self->{TRANSLATION_POSITION_FACTOR} + $i] =
	    $delimited_start_match_position + $i;
    }

    # fix the translation position factor for the next replace calls
    $self->{TRANSLATION_POSITION_FACTOR} += $new_translation_position_factor;

    # set the last_position
    $$last_position_ref = $end_match_position + 1;
} # of replace

#####################
# merge
#####################
sub merge {
    my $self = shift;

    my $delimited_text = $self->{DELIMITED_TEXT};

    # $re will hold the regular expression to match a
    # delimiter. yet, it will have around the index a paranthesis,
    # so the index will go to $1 when there is a match.
    my $re = quotemeta($self->{DELIMITER_PATTERN});
    $re =~ s/__INDEX__/\(\[\\d\]\+\)/g;
    $re = qr/$re/;
    # the buffer will hold the resulted text
    my $buffer = $delimited_text;
    # instead of the pattern, put back the unwanted tokens
    $buffer =~ s/$re/$self->{TOKENS}[$1]/g;

    # return all the tokens as the text
    $self->{TEXT} = $buffer;
    return $self->{TEXT};
} # of merge

1;
__END__