File Coverage

blib/lib/String/Tokenizer.pm

Criterion	Covered	Total	%
statement	117	117	100.0
branch	44	44	100.0
condition	9	14	64.2
subroutine	24	24	100.0
pod	6	6	100.0
total	200	205	97.5

package String::Tokenizer;

use strict;
use warnings;

our $VERSION = '0.05';

use constant RETAIN_WHITESPACE => 1;
use constant IGNORE_WHITESPACE => 0;

### constructor

sub new {
	my ($_class, @args) = @_;
	my $class = ref($_class) || $_class;
	my $string_tokenizer = {
		tokens => [],
        delimiter => undef,
        handle_whitespace => IGNORE_WHITESPACE
		};
	bless($string_tokenizer, $class);
	$string_tokenizer->tokenize(@args) if @args;
	return $string_tokenizer;
}

### methods

sub setDelimiter {
    my ($self, $delimiter) = @_;
    my $delimiter_reg_exp = join "\|" => map { s/(\W)/\\$1/g; $_ } split // => $delimiter;
    $self->{delimiter} = qr/$delimiter_reg_exp/;
}

sub handleWhitespace {
    my ($self, $value) = @_;
    $self->{handle_whitespace} = $value;
}

sub tokenize {
	my ($self, $string, $delimiter, $handle_whitespace) = @_;
    # if we have a delimiter passed in then use it
    $self->setDelimiter($delimiter)             if defined $delimiter;
    # if we are asking about whitespace then handle it
    $self->handleWhitespace($handle_whitespace) if defined $handle_whitespace;
    # if the two above are not handled, then the object will use
    # the values set already.
	# split everything by whitespace no matter what
	# (possible multiple occurances of white space too)
	my @tokens;
    if ($self->{handle_whitespace}) {
        @tokens = split /(\s+)/ => $string;
    }
    else {
        @tokens = split /\s+/ => $string;
    }
	if ($self->{delimiter}) {
		# create the delimiter reg-ex
		# escape all non-alpha-numeric
		# characters, just to be safe
		my $delimiter = $self->{delimiter};
		# loop through the tokens
		@tokens = map {
				# if the token contains a delimiter then ...
				if (/$delimiter/) {
					my ($token, @_tokens);
					# split the token up into characters
					# and the loop through all the characters
					foreach my $char (split //) {
						# if the character is a delimiter
						if ($char =~ /^$delimiter$/) {
							# and we already have a token in the works
							if (defined($token) && $token =~ /^.*$/) {
								# add the token to the
								# temp tokens list
								push @_tokens => $token;
							}
							# and then push our delimiter character
							# onto the temp tokens list
							push @_tokens => $char;
							# now we need to undefine our token
							$token = undef;
						}
						# if the character is not a delimiter then
						else {
							# check to make sure the token is defined
							$token = "" unless defined $token;
							# and then add the chracter to it
							$token .= $char;
						}
					}
					# now push any remaining token onto
					# the temp tokens list
					push @_tokens => $token if defined $token;
					# and return tokens
					@_tokens;
				}
				# if our token does not have
				# the delimiter in it
				else {
					# just return it
					$_
				}
			} @tokens;
	}
	$self->{tokens} = \@tokens;
}

sub getTokens {
	my ($self) = @_;
	return wantarray ?
			@{$self->{tokens}}
			:
			$self->{tokens};
}

sub iterator {
    my ($self) = @_;
    # returns a copy of the array
    return String::Tokenizer::Iterator->new($self->{tokens});
}

package String::Tokenizer::Iterator;

use strict;
use warnings;

sub new {
    ((caller())[0] eq "String::Tokenizer")
        || die "Insufficient Access Priviledges : Only String::Tokenizer can create String::Tokenizer::Iterator instances";
    my ($_class, $tokens) = @_;
    my $class = ref($_class) || $_class;
    my $iterator = {
        tokens => $tokens,
        index => 0
        };
    bless($iterator, $class);
    return $iterator;
}

sub reset {
    my ($self) = @_;
    $self->{index} = 0;
}

sub hasNextToken {
    my ($self) = @_;
    return ($self->{index} < scalar @{$self->{tokens}}) ? 1 : 0;
}

sub hasPrevToken {
    my ($self) = @_;
    return ($self->{index} > 0);
}

sub nextToken {
    my ($self) = @_;
    return undef if ($self->{index} >= scalar @{$self->{tokens}});
    return $self->{tokens}->[$self->{index}++];
}

sub prevToken {
    my ($self) = @_;
    return undef if ($self->{index} <= 0);
    return $self->{tokens}->[--$self->{index}];
}

sub currentToken {
    my ($self) = @_;
    return $self->{tokens}->[$self->{index} - 1];
}

sub lookAheadToken {
    my ($self) = @_;
    return undef if (  $self->{index} <= 0
                    || $self->{index} >= scalar @{$self->{tokens}});
    return $self->{tokens}->[$self->{index}];
}

sub collectTokensUntil {
    my ($self, $token_to_match) = @_;
    # if this matches our current token ...
    # then we just return nothing as there
    # is nothing to accumulate
    if ($self->lookAheadToken() eq $token_to_match) {
        # then just advance it one
        $self->nextToken();
        # and return nothing
        return;
    }

    # if it doesnt match our current token then, ...
    my @collection;
    # store the index we start at
    my $old_index = $self->{index};
    my $matched;
    # loop through the tokens
    while ($self->hasNextToken()) {
        my $token = $self->nextToken();
        if ($token ne $token_to_match) {
            push @collection => $token;
        }
        else {
            $matched++;
            last;
        }
    }
    unless ($matched) {
        # reset back to where we started, and ...
        $self->{index} = $old_index;
        # and return nothing
        return;
    }
    # and return our collection
    return @collection;
}


sub skipTokensUntil {
    my ($self, $token_to_match) = @_;
    # if this matches our current token ...
    if ($self->lookAheadToken() eq $token_to_match) {
        # then just advance it one
        $self->nextToken();
        # and return success
        return 1;
    }
    # if it doesnt match our current token then, ...
    # store the index we start at
    my $old_index = $self->{index};
    # and loop through the tokens
    while ($self->hasNextToken()) {
        # return success if we match our token
        return 1 if ($self->nextToken() eq $token_to_match);
    }
    # otherwise we didnt match, and should
    # reset back to where we started, and ...
    $self->{index} = $old_index;
    # return failure
    return 0;
}

sub skipTokenIfWhitespace {
    my ($self) = @_;
    $self->{index}++ if $self->lookAheadToken() =~ /^\s+$/;
}

sub skipTokens {
    my ($self, $num_token_to_skip) = @_;
    $num_token_to_skip ||= 1;
    $self->{index} += $num_token_to_skip;
}

*skipToken = \&skipTokens;

1;

__END__