X-Git-Url: http://git.asbjorn.biz/?a=blobdiff_plain;f=browse%2FParseMaster.pm;fp=browse%2FParseMaster.pm;h=0000000000000000000000000000000000000000;hb=20c9aafecfb762d8b258c410ba6c915684a8fb5b;hp=f07ba680467fc817a5c36bee24106c8d24e2225a;hpb=70d3099041b3de973b4266be0caee72b962556dd;p=jquery.git diff --git a/browse/ParseMaster.pm b/browse/ParseMaster.pm deleted file mode 100644 index f07ba68..0000000 --- a/browse/ParseMaster.pm +++ /dev/null @@ -1,207 +0,0 @@ -#ParseMaster (July 25 2005) -# Based on "ParseMaster.js" by Dean Edwards -# Ported to Perl by Rob Seiler, ELR Software Pty Ltd -# Copyright 2005. License - -package ParseMaster; -use strict; -use Data::Dumper; - -# Package wide variable declarations -use vars qw/$VERSION - @_X_escaped @_X_patterns - /; - -$VERSION = '017'; - -# constants -my $X_EXPRESSION = 0; -my $X_REPLACEMENT = 1; -my $X_LENGTH = 2; - -# re's used to determine nesting levels -my $X_GROUPS = qr/\(/o; # NB: Requires g modifier! -my $X_SUB_REPLACE = qr/\$\d/o; -my $X_INDEXED = qr/^\$\d+$/o; -my $XX_ESCAPE = qr/\\./o; # NB: Requires g modifier! -my $XX_DELETED = qr/\001[^\001]*\001/o; # NB: Requires g modifier! -my $DIGIT = qr/[^\D]/o; # Yep - this is a digit - contains no non-digits - -# Constructor -sub new { - my $class = shift; - my $self = {}; - @_X_escaped = (); # Re-initialize global for each instance - @_X_patterns = (); # Re-initialize global for each instance - # Instance variables - access by similarly named set/get functions - $self->{_ignoreCase_} = 0; - $self->{_escapeChar_} = ''; - bless ($self, $class); - return $self; -} - -sub ignoreCase { - my ($self, $value) = @_; - if (defined($value)) { - $self->{_ignoreCase_} = $value; - } - return $self->{_ignoreCase_}; -} - -sub escapeChar{ - my ($self, $value) = @_; - if (defined($value)) { - $self->{_escapeChar_} = $value; - } - return $self->{_escapeChar_}; -} - -####################### -# Public Parsemaster functions - -my $X_DELETE = sub(@$) { - my $X_offset = pop; - my @X_match = @_; - return (chr(001) . $X_match[$X_offset] . chr(001)); -}; # NB semicolon required for closure! - -# create and add a new pattern to the patterns collection -sub add { - my ($self, $expression, $X_replacement) = @_; - if (!$X_replacement) {$X_replacement = $X_DELETE}; - - # count the number of sub-expressions - my $temp = &_X_internalEscape($expression); - my $length = 1; # Always at least one because each pattern is itself a sub-expression - $length += $temp =~ s/$X_GROUPS//g; # One way to count the left capturing parentheses in the regexp string - - # does the pattern deal with sub-expressions? - if ((ref($X_replacement) ne "CODE") && ($X_replacement =~ m/$X_SUB_REPLACE/)) { - if ($X_replacement =~ m/$X_INDEXED/) { # a simple lookup? (eg "$2") - # store the index (used for fast retrieval of matched strings) - $X_replacement = substr($X_replacement,1) - 1; - } - else { # a complicated lookup (eg "Hello $2 $1") - my $i = $length; - while ($i) { # Had difficulty getting Perl to do Dean's splitting and joining of strings containing $'s - my $str = '$a[$o+' . ($i-1) . ']'; # eg $a[$o+1] - $X_replacement =~ s/\$$i/$str/; # eg $2 $3 -> $a[$o+1] $a[$o+2] - $i--; - } - # build a function to do the lookup - returns interpolated string of array lookups - $X_replacement = eval('sub {my $o=pop; my @a=@_; return "' . $X_replacement . '"};'); - } - } - else {} - # pass the modified arguments - &_X_add($expression || q/^$/, $X_replacement, $length); -} - -# execute the global replacement -sub exec { -#print Dumper(@_X_patterns); - my ($self, $X_string) = @_; - my $escChar = $self->escapeChar(); - my $ignoreCase = $self->ignoreCase(); - my ($regexp,$captures) = &_getPatterns(); # Concatenated and parenthesized regexp eg '(regex1)|(regex2)|(regex3)' etc - $X_string = &_X_escape($X_string, $escChar); - if ($ignoreCase) {$X_string =~ s/$regexp/{&_X_replacement(&_matchVars($captures,\$X_string))}/gie} # Pass $X_String as a - else {$X_string =~ s/$regexp/{&_X_replacement(&_matchVars($captures,\$X_string))}/ge} # reference for speed - - $X_string = &_X_unescape($X_string, $escChar); - $X_string =~ s/$XX_DELETED//g; - return $X_string; -} - -sub _X_add { - push (@_X_patterns, [@_]); # Save each argument set as is into an array of arrays -} - -# this is the global replace function (it's quite complicated) -sub _X_replacement { - my (@arguments) = @_; -#print Dumper (@arguments); - if ($arguments[0] le '') {return ''} - # Dereference last index (source String) here - faster than in _matchVars (maybe not needed at all?) - $arguments[$#arguments] = ${$arguments[$#arguments]}; - my $i = 1; - # loop through the patterns - for (my $j=0; $j