File Coverage

blib/lib/Mock/Data/Regex.pm
Criterion Covered Total %
statement 203 247 82.1
branch 139 198 70.2
condition 65 120 54.1
subroutine 38 47 80.8
pod 11 11 100.0
total 456 623 73.1


line stmt bran cond sub pod time code
1             package Mock::Data::Regex;
2 12     12   228929 use strict;
  12         25  
  12         459  
3 12     12   64 use warnings;
  12         23  
  12         556  
4 12     12   729 use Mock::Data::Charset;
  12         39  
  12         393  
5 12     12   65 use Mock::Data::Util qw( _parse_context _escape_str );
  12         29  
  12         80  
6             require Carp;
7             require Scalar::Util;
8             require List::Util;
9             require Hash::Util;
10             require Mock::Data::Generator;
11             our @ISA= ( 'Mock::Data::Generator' );
12              
13             # ABSTRACT: Generator that uses a Regex as a template to generate strings
14             our $VERSION = '0.04'; # VERSION
15              
16              
17             sub new {
18 24     24 1 50017 my $class= shift;
19             my %self= @_ == 1 && (!ref $_[0] || ref $_[0] eq 'Regexp')? ( regex => $_[0] )
20 24 50 66     259 : @_ == 1? %{$_[0]}
  0 100       0  
21             : @_;
22              
23             # If called on an object, carry over some settings
24 24 50       68 if (ref $class) {
25 0         0 %self= ( %$class, %self );
26             # Make sure we didn't copy a regex without a matching regex_parse_tree, or vice versa
27 0 0 0     0 if ($self{regex} == $class->{regex} xor $self{regex_parse_tree} == $class->{regex_parse_tree}) {
28 0 0       0 delete $self{regex_parse_tree} if $self{regex_parse_tree} == $class->{regex_parse_tree};
29 0 0       0 delete $self{regex} if $self{regex} == $class->{regex};
30             }
31 0         0 $class= ref $class;
32             }
33              
34 24 50       75 defined $self{regex} or Carp::croak "Attribute 'regex' is required";
35 24 50       67 $self{regex}= qr/$self{regex}/ unless ref $self{regex} eq 'Regexp';
36             # Must be parsed eventually, so might as well do it now and see the errors right away
37 24   33     135 $self{regex_parse_tree} ||= $class->parse($self{regex});
38 24 100 100     76 $self{max_codepoint} //= 0x7F if $self{regex_parse_tree}->flags->{a};
39              
40 24 50 0     65 $self{prefix} //= Mock::Data::Util::coerce_generator($self{prefix}) if defined $self{prefix};
41 24 50 0     54 $self{suffix} //= Mock::Data::Util::coerce_generator($self{suffix}) if defined $self{suffix};
42              
43 24         81 return bless \%self, $class;
44             }
45              
46              
47 0     0 1 0 sub regex { $_[0]{regex} }
48              
49 209     209 1 561 sub regex_parse_tree { $_[0]{regex_parse_tree} }
50              
51              
52             sub min_codepoint {
53             $_[0]{min_codepoint}
54 207     207 1 485 }
55              
56 207     207 1 719 sub max_codepoint { $_[0]{max_codepoint} }
57              
58              
59 209 50   209 1 1008 sub max_repetition { $_[0]{max_repetition} || '+8' }
60              
61              
62             sub prefix {
63 0 0   0 1 0 if (@_ > 1) {
64 0         0 $_[0]{prefix}= Mock::Data::Util::coerce_generator($_[1]);
65             }
66             $_[0]{prefix}
67 0         0 }
68              
69             sub suffix {
70 0 0   0 1 0 if (@_ > 1) {
71 0         0 $_[0]{suffix}= Mock::Data::Util::coerce_generator($_[1]);
72             }
73             $_[0]{suffix}
74 0         0 }
75              
76              
77             sub generate {
78 209     209 1 12023 my ($self, $mockdata)= (shift,shift);
79 209 100       610 my %opts= ref $_[0] eq 'HASH'? %{$_[0]} : ();
  23         89  
80 209   100     1000 $opts{max_codepoint} //= $self->max_codepoint;
81 209   100     751 $opts{min_codepoint} //= $self->min_codepoint;
82 209   33     808 $opts{max_repetition} //= $self->max_repetition;
83 209         527 my $out= $self->_str_builder($mockdata, \%opts);
84             $self->regex_parse_tree->generate($out)
85             # is the string allowed to end here? Requirement of '' is generated by $ and \Z
86 209 50 66     479 && (!$out->next_req || (grep $_ eq '', @{ $out->next_req }))
      66        
87             or Carp::croak "Regex assertions could not be met (such as '^' or '\$'). Final attempt was: \""._escape_str($out->str)."\"";
88 209   66     844 my $prefix= $opts{prefix} // $self->{prefix};
89 209   66     602 my $suffix= $opts{suffix} // $self->{suffix};
90 209 100 66     727 return $out->str unless defined $prefix || defined $suffix;
91              
92 19         38 my $str= $out->str;
93             # A prefix can only be added if there was not a beginning-of-string assertion, or if
94             # it was a ^/m assertion (flagged as "LF")
95 19 50 66     75 if ($prefix && (!$out->start || $out->start eq 'LF')) {
      66        
96 19         65 my $p= Mock::Data::Util::coerce_generator($prefix)->generate($mockdata);
97 19 100       70 $p .= "\n" if $out->start;
98 19         37 $str= $p . $str;
99             }
100             # A suffix can only be added if there was not an end-of-string assertion, or if
101             # the next assertion allows "\n" and there is no assertion after that.
102 19 100 100     67 if ($suffix && (!$out->next_req || (grep $_ eq "\n", @{ $out->next_req }) && !$out->require->[1])) {
      66        
103 18 100       32 $str .= "\n" if $out->next_req;
104 18         42 $str .= Mock::Data::Util::coerce_generator($suffix)->generate($mockdata);
105             }
106 19         119 return $str;
107             }
108              
109              
110             sub parse {
111 43     43 1 290102 my ($self, $regex)= @_;
112 43         241 return $self->_parse_regex({}) for "$regex";
113             }
114              
115             sub get_charset {
116 0     0 1 0 my $self= shift;
117 0         0 my $p= $self->regex_parse_tree->pattern;
118 0 0 0     0 return Scalar::Util::blessed($p) && $p->isa('Mock::Data::Charset')? $p : undef;
119             }
120              
121             our %_regex_syntax_unsupported= (
122             '' => { map { $_ => 1 } qw( $ ) },
123             '\\' => { map { $_ => 1 } qw( B b A Z z G g K k ) },
124             );
125             our %_parse_regex_backslash= (
126             map +( $_ => $Mock::Data::Charset::_parse_charset_backslash{$_} ),
127             qw( a b c e f n N o r t x 0 1 2 3 4 5 6 7 8 9 )
128             );
129             sub _parse_regex {
130 105     105   179 my $self= shift;
131 105   50     240 my $flags= shift || {};
132 105         180 my $expr= [];
133 105         140 my @or;
134 105         141 while (1) {
135             # begin parenthetical sub-expression?
136 357 100 33     2260 if (/\G \( /gcx) {
    100          
    100          
    100          
    100          
    50          
    100          
137 62         99 my $sub_flags= $flags;
138 62 100       464 if (/\G \? /gcx) {
139             # leading question mark means regex flags. This only supports the ^...: one:
140 43 50 0     223 if (/\G \^ ( \w* ) : /gcx) {
    0          
141 43         76 $sub_flags= {};
142 43         238 ++$sub_flags->{$_} for split '', $1;
143             } elsif ($] < 5.020 and /\G (\w*)-\w* : /gcx) {
144 0         0 $sub_flags= {};
145 0         0 ++$sub_flags->{$_} for split '', $1;
146             } else {
147 0         0 Carp::croak("Unsupported regex feature '(?".substr($_,pos,1)."'");
148             }
149             }
150 62         123 my $pos= -1+pos;
151 62         215 push @$expr, $self->_parse_regex($sub_flags);
152 62 50       232 /\G \) /gcx
153             or die "Missing end-parenthesee, started at "._parse_context($pos);
154             }
155             # end sub-expression?
156             elsif (/\G(?= \) )/gcx) {
157 62         119 last;
158             }
159             # next alternation of 'or'?
160             elsif (/\G \| /gcx) {
161             # else begin next piece of @or
162 11         28 push @or, $self->_node($expr, $flags);
163 11         19 $expr= [];
164             }
165             # character class?
166             elsif (/\G ( \[ | \\w | \\W | \\s | \\S | \\d | \\D | \\N | \\Z | \. | \^ | \$ ) /gcx) {
167 31 100       196 if ($1 eq '[') {
    100          
    100          
    100          
    50          
168             # parse function continues to operate on $_ at pos()
169 5         23 my $parse= Mock::Data::Charset::_parse_charset($flags);
170 5         26 push @$expr, $self->_charset_node($parse, $flags);
171             }
172             elsif (ord $1 == ord '\\') {
173 11 100       35 if ($1 eq "\\Z") {
174 1         6 push @$expr, $self->_assertion_node(end => 1, flags => $flags);
175             }
176             else {
177 10         51 push @$expr, $self->_charset_node(notation => $1, $flags);
178             }
179             }
180             elsif ($1 eq '.') {
181 2 50       14 push @$expr, $self->_charset_node(classes => [ $flags->{s}? 'Any' : '\\N' ], $flags);
182             }
183             elsif ($1 eq '$') {
184 7 100       26 push @$expr, $self->_assertion_node(end => ($flags->{m}? 'LF' : 'FinalLF'), flags => $flags);
185             }
186             elsif ($1 eq '^') {
187 6 100       25 push @$expr, $self->_assertion_node(start => ($flags->{m}? 'LF' : 1 ), flags => $flags);
188             }
189             }
190             # repetition?
191             elsif (/\G ( \? | \* \?? | \+ \?? | \{ ([0-9]+)? (,)? ([0-9]+)? \} ) /gcx) {
192 30         57 my @rep;
193 30 100       168 if ($1 eq '?') {
    100          
    100          
194 1         3 @rep= (0,1);
195             }
196             elsif (ord $1 == ord '*') {
197 5         13 @rep= (0);
198             }
199             elsif (ord $1 == ord '+') {
200 19         47 @rep= (1);
201             }
202             else {
203 5 100 100     52 @rep= $3? ($2||0,$4) : ($2||0,$2);
      50        
204             }
205             # What came before this?
206 30 50       136 if (!@$expr) {
    100          
207 0         0 die "Found quantifier '$1' before anything to quantify at "._parse_context;
208             }
209             elsif (!ref $expr->[-1]) {
210             # If the string is composed of more than one character, split the final one
211             # into its own node so that it can have a repetition applied to it.
212 6 100       17 if (length $expr->[-1] > 1) {
213 2         6 push @$expr, $self->_node([ substr($expr->[-1], -1) ], $flags);
214 2         3 substr($expr->[-2], -1)= '';
215             }
216             # else its one character, wrap it in a node
217             else {
218 4         19 $expr->[-1]= $self->_node([ $expr->[-1] ], $flags);
219             }
220             }
221 30         102 $expr->[-1]->repetition(\@rep)
222             }
223             elsif ($flags->{x} && /\G ( \s | [#].* ) /gcx) {
224             # ignore whitespace and comments under /x mode
225             }
226             elsif (/\G (\\)? (.) /gcxs) {
227             # Tell users about unsupported features
228 118 50 100     717 die "Unsupported notation: '$1$2'" if $_regex_syntax_unsupported{$1||''}{$2};
229 118         164 my $ch;
230 118 100 100     372 if ($1 && defined (my $equiv= $_parse_regex_backslash{$2})) {
231 5 100       39 $ch= chr(ref $equiv? $equiv->() : $equiv);
232             } else {
233 113         195 $ch= $2;
234             }
235 118 100 66     452 if ($flags->{i} && (uc $ch ne lc $ch)) {
    100 100        
236 3         11 push @$expr, $self->_charset_node(chars => [uc $ch, lc $ch], $flags);
237             }
238             elsif (@$expr && !ref $expr->[-1]) {
239 53         95 $expr->[-1] .= $ch;
240             }
241             else {
242 62         155 push @$expr, $ch;
243             }
244             }
245             else {
246 43         67 last; # end of string
247             }
248             }
249 105 50 100     687 return @or? do { push @or, $self->_node($expr, $flags) if @$expr; $self->_or_node(\@or, $flags) }
  5 100       22  
  5 100       18  
250             : (@$expr > 1 || !ref $expr->[0])? $self->_node($expr, $flags)
251             : $expr->[0];
252             }
253              
254             #----------------------------------
255             # Factory Functions for Parse Nodes
256              
257             sub _node {
258 60     60   149 my ($self, $pattern, $flags)= @_;
259 60         228 Mock::Data::Regex::ParseNode->new({ pattern => $pattern, flags => $flags });
260             }
261             sub _or_node {
262 5     5   11 my ($self, $or_list, $flags)= @_;
263 5         34 Mock::Data::Regex::ParseNode::Or->new({ pattern => $or_list, flags => $flags });
264             }
265             sub _charset_node {
266 20     20   41 my $self= shift;
267 20         33 my $flags= pop;
268 20 100       181 Mock::Data::Regex::ParseNode::Charset->new({
269             pattern => @_ > 1? { @_ } : shift,
270             flags => $flags
271             });
272             }
273             sub _assertion_node {
274 14     14   23 my $self= shift;
275 14         72 Mock::Data::Regex::ParseNode::Assertion->new({ @_ });
276             }
277             sub _str_builder {
278 209     209   388 my ($self, $mockdata, $opts)= @_;
279 209         979 Mock::Data::Regex::StrBuilder->new({
280             mockdata => $mockdata,
281             generator => $self,
282             opts => $opts,
283             });
284             }
285              
286             sub _fake_inc {
287 60     60   292 (my $pkg= caller) =~ s,::,/,g;
288 60         285 $INC{$pkg.'.pm'}= $INC{'Mock/Data/Generator/Regex.pm'};
289             }
290              
291             # ------------------------------ Regex Parse Node -------------------------------------
292             # The regular parse nodes hold a "pattern" which is an arrayref of literal strings
293             # or nested parse nodes. It supports a "repetition" flag to handle min/max repetitions
294             # of the node as a whole.
295             # Other subclasses are used to handle OR-lists, charsets, and zero-width assertions.
296              
297             package # Do not index
298             Mock::Data::Regex::ParseNode;
299             Mock::Data::Regex::_fake_inc();
300              
301 79     79   258 sub new { bless $_[1], $_[0] }
302              
303 24     24   83 sub flags { $_[0]{flags} }
304             sub repetition {
305 458 100   458   4413 if (@_ > 1) {
306             # If a quantifier is being applied to a thing that already had a quantifier
307             # (such as /(X*){2}/ )
308             # multiply them
309 30         48 my $val= $_[1];
310 30 50       80 if (my $rep= $_[0]{repetition}) {
311             $rep->[$_]= (defined $rep->[$_] && defined $val->[$_]? $rep->[$_] * $val->[$_] : undef)
312 0 0 0     0 for 0, 1;
313             }
314             else {
315 30         64 $_[0]{repetition}= $_[1];
316             }
317             }
318             return $_[0]{repetition}
319 458         903 }
320             sub min_repetition {
321 0 0   0   0 $_[0]{repetition}? $_[0]{repetition}[0] : 1
322             }
323             sub max_repetition {
324 0 0   0   0 $_[0]{repetition}? $_[0]{repetition}[1] : 1
325             }
326 231     231   19568 sub pattern { $_[0]{pattern} }
327             sub generate {
328 335     335   582 my ($self, $out)= @_;
329 335 100       527 if (my $rep= $self->repetition) {
330 84         229 my ($min, $n)= ($rep->[0], $out->_random_rep_count($rep));
331 84         195 for (1 .. $n) {
332 316 100       641 my $origin= $_ > $min? $out->mark : undef;
333             # Plain nodes expect the pattern to be an arrayref where each item is a parse node or a literal
334 316         370 my $success= 1;
335 316         380 for (@{ $self->{pattern} }) {
  316         494  
336 354 100 100     807 $success &&= ref $_? $_->generate($out) : $out->append($_);
337             }
338 316 100       694 next if $success;
339             # This repetition failed, but did we meet the requirement already?
340 18 50       22 if ($origin) {
341 18         27 $out->reset($origin);
342 18         44 return 1;
343             }
344 0         0 return 0;
345             }
346             }
347             else {
348             # Plain nodes expect the pattern to be an arrayref where each item is a parse node or a literal
349 251         325 for (@{ $self->{pattern} }) {
  251         457  
350 439 100       1005 return 0 unless ref $_? $_->generate($out) : $out->append($_);
    100          
351             }
352             }
353 303         855 return 1;
354             }
355              
356             # --------------------------------- Regex "OR" Parse Node ----------------------------
357             # This parse holds a list of options in ->pattern. It chooses one of the options at
358             # random, but then can backtrack if inner parse nodes were not able to match.
359              
360             package # Do not index
361             Mock::Data::Regex::ParseNode::Or;
362             Mock::Data::Regex::_fake_inc();
363             our @ISA= ('Mock::Data::Regex::ParseNode');
364              
365             sub generate {
366 32     32   44 my ($self, $out)= @_;
367 32         48 my ($min, $n)= (1,1);
368 32 100       73 if (my $rep= $self->{repetition}) {
369 30         50 $min= $rep->[0];
370 30         56 $n= $out->_random_rep_count($rep);
371             }
372 32         60 rep: for (1 .. $n) {
373             # OR nodes expect the pattern to be an arrayref where each item is an option
374             # for what could be appended. Need to reset the output after each attempt.
375 114         186 my $origin= $out->mark;
376             # Pick one at random. It will almost always work on the first try, unless the user
377             # has anchor constraints in the pattern.
378 114         167 my $or= $self->pattern;
379 114         162 my $pick= $or->[ rand scalar @$or ];
380 114 50       181 next rep if ref $pick? $pick->generate($out) : $out->append($pick);
    100          
381             # if it fails, try all the others in random order
382 14         18 for (List::Util::shuffle(grep { $_ != $pick } @$or)) {
  28         85  
383             # reset output
384 14         24 $out->reset($origin);
385             # append something new
386 14 50       21 next rep if ref $_? $_->generate($out) : $out->append($_);
    50          
387             }
388             # None of the options succeeded. Did we get enough reps already?
389 0 0       0 if ($_ > $min) {
390 0         0 $out->reset($origin);
391 0         0 return 1;
392             }
393 0         0 return 0;
394             }
395 32         62 return 1;
396             }
397              
398             # -------------------------------- Regex Charset Parse Node ---------------------------
399             # This node's ->pattern is an instance of Charset. It returns one character
400             # from the set, but also has an optimized handling of the ->repetition flag that generates
401             # multiple characters at once.
402              
403             package # Do not index
404             Mock::Data::Regex::ParseNode::Charset;
405             Mock::Data::Regex::_fake_inc();
406             our @ISA= ('Mock::Data::Regex::ParseNode');
407              
408             sub new {
409 20     20   47 my ($class, $self)= @_;
410 20 50       69 if (ref $self->{pattern} eq 'HASH') {
411 20 100       76 $self->{pattern}{max_codepoint}= 0x7F if $self->{flags}{a};
412 20         78 $self->{pattern}= Mock::Data::Util::charset($self->{pattern});
413             }
414 20         130 bless $self, $class;
415             }
416              
417             sub generate {
418 84     84   153 my ($self, $out)= @_;
419             # Check whether output has a restriction in effect:
420 84 50       175 if (my $req= $out->next_req) {
421             # pick the first requirement which can be matched by this charset
422 0         0 for (@$req) {
423 0 0       0 if (!ref) {
424             # At \Z, can still match if rep count is 0
425 0 0 0     0 return 1 if length == 0 && $self->min_repetition == 0;
426 0 0 0     0 return $out->append($_) if
      0        
      0        
427             length == 1 && $self->pattern->has_member($_)
428             or length > 1 && !(grep !$self->pattern->has_member($_), split //);
429             }
430             }
431 0         0 return 0;
432             }
433 84         202 my $n= $out->_random_rep_count($self->repetition);
434 84         239 return $out->append($self->pattern->generate($out->mockdata, $out->opts, $n));
435             }
436              
437             # ----------------------------- Regex Assertion Parse Node -------------------------------
438             # This node doesn't have a ->pattern, and instead holds constraints about what characters
439             # must occur around the current position. Right now it only handles '^' and '$' and '\Z'
440              
441             package # Do not index
442             Mock::Data::Regex::ParseNode::Assertion;
443             Mock::Data::Regex::_fake_inc();
444             our @ISA= ('Mock::Data::Regex::ParseNode');
445              
446 0     0   0 sub start { $_[0]{start} }
447 0     0   0 sub end { $_[0]{end} }
448             sub generate {
449 86     86   121 my ($self, $out)= @_;
450 86 100       156 if ($self->{start}) {
451             # Previous character must either be start of string or a newline
452             length $out->str == 0
453 47 100 66     70 or ($self->{start} eq 'LF' && substr($out->str,-1) eq "\n")
      100        
454             or return 0;
455             # Set flag on entire output if this is the first assertion
456 33 100 66     61 $out->start($self->{start}) if length $out->str == 0 && !$out->start;
457             }
458 72 100       162 if ($self->{end}) {
459             # Next character must be a newline, or end of the output
460             # end=1 results from \Z and does not allow the newline
461 39 50       131 $out->require(['',"\n"]) unless $self->{end} eq 1;
462             # If end=LF, the end of string is no longer mandatory once "\n" has been matched.
463 39 100       103 $out->require(['']) unless $self->{end} eq 'LF';
464             }
465 72         162 return 1;
466             }
467              
468             # ------------------------ String Builder -----------------------------------
469             # This class constructs an output string in ->{str}, and also performs checks
470             # needed by the assertions like ^ and $. It also has the ability to mark a
471             # position and then revert to that position, without copying the entire string
472             # each time.
473              
474             package # Do not index
475             Mock::Data::Regex::StrBuilder;
476             Mock::Data::Regex::_fake_inc();
477              
478             sub new {
479 209     209   359 my ($class, $self)= @_;
480 209   50     868 $self->{str} //= '';
481 209         521 bless $self, $class;
482             }
483              
484 84     84   186 sub mockdata { $_[0]{mockdata} } # Mock::Data instance
485 0     0   0 sub generator { $_[0]{generator} }
486 216     216   640 sub opts { $_[0]{opts} }
487 439 100   439   778 sub start { $_[0]{start}= $_[1] if @_ > 1; $_[0]{start} }
  439         970  
488 317     317   1607 sub str { $_[0]{str} } # string being built
489             sub _random_rep_count {
490 198     198   337 my ($self, $rep)= @_;
491 198 100       381 return 1 unless defined $rep;
492 158 100       397 return $rep->[0] + int rand($rep->[1] - $rep->[0] + 1)
493             if defined $rep->[1];
494 132   50     269 my $range= $self->opts->{max_repetition} // '+8';
495 132 50       688 return $rep->[0] + int rand($range+1)
496             if ord $range == ord '+';
497 0         0 $range -= $rep->[0];
498 0 0       0 return $range > 0? $rep->[0] + int rand($range+1) : $rep->[0];
499             }
500              
501             sub require {
502 61 100   61   96 push @{ $_[0]{require} }, $_[1] if @_ > 1;
  58         123  
503 61         84 return $_[0]{require};
504             }
505             sub next_req {
506 1031   66 1031   3006 return $_[0]{require} && $_[0]{require}[0];
507             }
508             sub append {
509 659     659   1135 my ($self, $content)= @_;
510 659 100       1037 if (my $req= $self->next_req) {
511             # the provided output must be coerced to one of these options, if possible
512             # TODO: need new ideas for this code. Or just give up on the plan of supporting
513             # lookaround assertions and focus on a simple implemention of "\n" checks for ^/$
514 18         24 for (@$req) {
515 36 50       41 if (!ref) { # next text must match a literal string. '' means end-of-string
516 36 50 66     69 if (length && $content eq $_) {
517 0         0 $self->{str} .= $content;
518 0         0 shift @{ $self->require }; # requirement complete
  0         0  
519 0         0 return 1;
520             }
521             }
522             else {
523             # TODO: support for "lookaround" assertions, will require regex match
524 0         0 die "Unimplemented: zero-width lookaround assertions";
525             }
526             }
527 18         36 return 0; # no match found for the restriction in effect
528             }
529 641         1127 $self->{str} .= $content;
530 641         1565 return 1;
531             }
532             sub mark {
533 362     362   455 my $self= shift;
534 362         556 my $len= $self->{lastmark}= length $self->{str};
535 362         474 my $req= $self->{require};
536 362 100       726 return [ \$self->{str}, $len, $req? [ @$req ] : undef, $self->start ];
537             }
538             sub reset {
539 32     32   37 my ($self, $origin)= @_;
540             # If the string is a different instance than before, go back to that instance
541 0         0 Hash::Util::hv_store(%$self, 'str', ${$origin->[0]})
542 32 50       58 unless \$self->{str} == $origin->[0];
543             # Reset the string to the original length
544 32         49 substr($self->{str}, $origin->[1])= '';
545 32         46 $self->{require}= $origin->[2];
546 32         44 $self->{start}= $origin->[3];
547             }
548              
549             1;
550              
551             __END__