This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to Locale::Codes 2.00.
[perl5.git] / lib / Locale / Maketext.pm
1
2 # Time-stamp: "2001-06-21 23:09:33 MDT"
3
4 require 5;
5 package Locale::Maketext;
6 use strict;
7 use vars qw( @ISA $VERSION $MATCH_SUPERS $USING_LANGUAGE_TAGS
8              $USE_LITERALS);
9 use Carp ();
10 use I18N::LangTags 0.21 ();
11
12 #--------------------------------------------------------------------------
13
14 BEGIN { unless(defined &DEBUG) { *DEBUG = sub () {0} } }
15  # define the constant 'DEBUG' at compile-time
16
17 $VERSION = "1.03";
18 @ISA = ();
19
20 $MATCH_SUPERS = 1;
21 $USING_LANGUAGE_TAGS = 1;
22  # Turning this off is somewhat of a security risk in that little or no
23  # checking will be done on the legality of tokens passed to the
24  # eval("use $module_name") in _try_use.  If you turn this off, you have
25  # to do your own taint checking.
26
27 $USE_LITERALS = 1 unless defined $USE_LITERALS;
28  # a hint for compiling bracket-notation things.
29
30 my %isa_scan = ();
31
32 ###########################################################################
33
34 sub quant {
35   my($handle, $num, @forms) = @_;
36
37   return $num if @forms == 0; # what should this mean?
38   return $forms[2] if @forms > 2 and $num == 0; # special zeroth case
39
40   # Normal case:
41   # Note that the formatting of $num is preserved.
42   return( $handle->numf($num) . ' ' . $handle->numerate($num, @forms) );
43    # Most human languages put the number phrase before the qualified phrase.
44 }
45
46
47 sub numerate {
48  # return this lexical item in a form appropriate to this number
49   my($handle, $num, @forms) = @_;
50   my $s = ($num == 1);
51
52   return '' unless @forms;
53   if(@forms == 1) { # only the headword form specified
54     return $s ? $forms[0] : ($forms[0] . 's'); # very cheap hack.
55   } else { # sing and plural were specified
56     return $s ? $forms[0] : $forms[1];
57   }
58 }
59
60 #--------------------------------------------------------------------------
61
62 sub numf {
63   my($handle, $num) = @_[0,1];
64   if($num < 10_000_000_000 and $num > -10_000_000_000 and $num == int($num)) {
65     $num += 0;  # Just use normal integer stringification.
66          # Specifically, don't let %G turn ten million into 1E+007
67   } else {
68     $num = CORE::sprintf("%G", $num);
69      # "CORE::" is there to avoid confusion with the above sub sprintf.
70   }
71   while( $num =~ s/^([-+]?\d+)(\d{3})/$1,$2/s ) {1}  # right from perlfaq5
72    # The initial \d+ gobbles as many digits as it can, and then we
73    #  backtrack so it un-eats the rightmost three, and then we
74    #  insert the comma there.
75
76   $num =~ tr<.,><,.> if ref($handle) and $handle->{'numf_comma'};
77    # This is just a lame hack instead of using Number::Format
78   return $num;
79 }
80
81 sub sprintf {
82   no integer;
83   my($handle, $format, @params) = @_;
84   return CORE::sprintf($format, @params);
85     # "CORE::" is there to avoid confusion with myself!
86 }
87
88 #=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#
89
90 use integer; # vroom vroom... applies to the whole rest of the module
91
92 sub language_tag {
93   my $it = ref($_[0]) || $_[0];
94   return undef unless $it =~ m/([^':]+)(?:::)?$/s;
95   $it = lc($1);
96   $it =~ tr<_><->;
97   return $it;
98 }
99
100 sub encoding {
101   my $it = $_[0];
102   return(
103    (ref($it) && $it->{'encoding'})
104    || "iso-8859-1"   # Latin-1
105   );
106
107
108 #--------------------------------------------------------------------------
109
110 sub fallback_languages { return('i-default', 'en', 'en-US') }
111
112 sub fallback_language_classes { return () }
113
114 #--------------------------------------------------------------------------
115
116 sub fail_with { # an actual attribute method!
117   my($handle, @params) = @_;
118   return unless ref($handle);
119   $handle->{'fail'} = $params[0] if @params;
120   return $handle->{'fail'};
121 }
122
123 #--------------------------------------------------------------------------
124
125 sub failure_handler_auto {
126   # Meant to be used like:
127   #  $handle->fail_with('failure_handler_auto')
128
129   my($handle, $phrase, @params) = @_;
130   $handle->{'failure_lex'} ||= {};
131   my $lex = $handle->{'failure_lex'};
132
133   my $value;
134   $lex->{$phrase} ||= ($value = $handle->_compile($phrase));
135
136   # Dumbly copied from sub maketext:
137   {
138     local $SIG{'__DIE__'};
139     eval { $value = &$value($handle, @_) };
140   }
141   # If we make it here, there was an exception thrown in the
142   #  call to $value, and so scream:
143   if($@) {
144     my $err = $@;
145     # pretty up the error message
146     $err =~ s<\s+at\s+\(eval\s+\d+\)\s+line\s+(\d+)\.?\n?>
147              <\n in bracket code [compiled line $1],>s;
148     #$err =~ s/\n?$/\n/s;
149     Carp::croak "Error in maketexting \"$phrase\":\n$err as used";
150     # Rather unexpected, but suppose that the sub tried calling
151     # a method that didn't exist.
152   } else {
153     return $value;
154   }
155 }
156
157 #==========================================================================
158
159 sub new {
160   # Nothing fancy!
161   my $class = ref($_[0]) || $_[0];
162   my $handle = bless {}, $class;
163   $handle->init;
164   return $handle;
165 }
166
167 sub init { return } # no-op
168
169 ###########################################################################
170
171 sub maketext {
172   # Remember, this can fail.  Failure is controllable many ways.
173   Carp::croak "maketext requires at least one parameter" unless @_ > 1;
174
175   my($handle, $phrase) = splice(@_,0,2);
176
177   # Look up the value:
178
179   my $value;
180   foreach my $h_r (
181     @{  $isa_scan{ref($handle) || $handle} || $handle->_lex_refs  }
182   ) {
183     print "* Looking up \"$phrase\" in $h_r\n" if DEBUG;
184     if(exists $h_r->{$phrase}) {
185       print "  Found \"$phrase\" in $h_r\n" if DEBUG;
186       unless(ref($value = $h_r->{$phrase})) {
187         # Nonref means it's not yet compiled.  Compile and replace.
188         $value = $h_r->{$phrase} = $handle->_compile($value);
189       }
190       last;
191     } elsif($phrase !~ m/^_/s and $h_r->{'_AUTO'}) {
192       # it's an auto lex, and this is an autoable key!
193       print "  Automaking \"$phrase\" into $h_r\n" if DEBUG;
194       
195       $value = $h_r->{$phrase} = $handle->_compile($phrase);
196       last;
197     }
198     print "  Not found in $h_r, nor automakable\n" if DEBUG > 1;
199     # else keep looking
200   }
201
202   unless(defined($value)) {
203     print "! Lookup of \"$phrase\" in/under ", ref($handle) || $handle,
204       " fails.\n" if DEBUG;
205     if(ref($handle) and $handle->{'fail'}) {
206       print "WARNING0: maketext fails looking for <$phrase>\n" if DEBUG;
207       my $fail;
208       if(ref($fail = $handle->{'fail'}) eq 'CODE') { # it's a sub reference
209         return &{$fail}($handle, $phrase, @_);
210          # If it ever returns, it should return a good value.
211       } else { # It's a method name
212         return $handle->$fail($phrase, @_);
213          # If it ever returns, it should return a good value.
214       }
215     } else {
216       # All we know how to do is this;
217       Carp::croak("maketext doesn't know how to say:\n$phrase\nas needed");
218     }
219   }
220
221   return $$value if ref($value) eq 'SCALAR';
222   return $value unless ref($value) eq 'CODE';
223   
224   {
225     local $SIG{'__DIE__'};
226     eval { $value = &$value($handle, @_) };
227   }
228   # If we make it here, there was an exception thrown in the
229   #  call to $value, and so scream:
230   if($@) {
231     my $err = $@;
232     # pretty up the error message
233     $err =~ s<\s+at\s+\(eval\s+\d+\)\s+line\s+(\d+)\.?\n?>
234              <\n in bracket code [compiled line $1],>s;
235     #$err =~ s/\n?$/\n/s;
236     Carp::croak "Error in maketexting \"$phrase\":\n$err as used";
237     # Rather unexpected, but suppose that the sub tried calling
238     # a method that didn't exist.
239   } else {
240     return $value;
241   }
242 }
243
244 ###########################################################################
245
246 sub get_handle {  # This is a constructor and, yes, it CAN FAIL.
247   # Its class argument has to be the base class for the current
248   # application's l10n files.
249   my($base_class, @languages) = @_;
250   $base_class = ref($base_class) || $base_class;
251    # Complain if they use __PACKAGE__ as a project base class?
252
253   unless(@languages) {  # Calling with no args is magical!  wooo, magic!
254     if(length( $ENV{'REQUEST_METHOD'} || '' )) { # I'm a CGI
255       my $in = $ENV{'HTTP_ACCEPT_LANGUAGE'} || '';
256         # supposedly that works under mod_perl, too.
257       $in =~ s<\([\)]*\)><>g; # Kill parens'd things -- just a hack.
258       @languages = &I18N::LangTags::extract_language_tags($in) if length $in;
259         # ...which untaints, incidentally.
260       
261     } else { # Not running as a CGI: try to puzzle out from the environment
262       if(length( $ENV{'LANG'} || '' )) {
263         push @languages, split m/[,:]/, $ENV{'LANG'};
264          # LANG can be only /one/ locale as far as I know, but what the hey.
265       }
266       if(length( $ENV{'LANGUAGE'} || '' )) {
267         push @languages, split m/[,:]/, $ENV{'LANGUAGE'};
268       }
269       print "Noting ENV LANG ", join(',', @languages),"\n" if DEBUG;
270       # Those are really locale IDs, but they get xlated a few lines down.
271       
272       if(&_try_use('Win32::Locale')) {
273         # If we have that module installed...
274         push @languages, Win32::Locale::get_language()
275          if defined &Win32::Locale::get_language;
276       }
277     }
278   }
279
280   #------------------------------------------------------------------------
281   print "Lgs1: ", map("<$_>", @languages), "\n" if DEBUG;
282
283   if($USING_LANGUAGE_TAGS) {
284     @languages = map &I18N::LangTags::locale2language_tag($_), @languages;
285      # if it's a lg tag, fine, pass thru (untainted)
286      # if it's a locale ID, try converting to a lg tag (untainted),
287      # otherwise nix it.
288
289     push @languages, map I18N::LangTags::super_languages($_), @languages
290      if $MATCH_SUPERS;
291
292     @languages =  map { $_, I18N::LangTags::alternate_language_tags($_) }
293                       @languages;    # catch alternation
294
295     push @languages, I18N::LangTags::panic_languages(@languages)
296       if defined &I18N::LangTags::panic_languages;
297     
298     push @languages, $base_class->fallback_languages;
299      # You are free to override fallback_languages to return empty-list!
300
301     @languages =  # final bit of processing:
302       map {
303         my $it = $_;  # copy
304         $it =~ tr<-A-Z><_a-z>; # lc, and turn - to _
305         $it =~ tr<_a-z0-9><>cd;  # remove all but a-z0-9_
306         $it;
307       } @languages
308     ;
309   }
310   print "Lgs2: ", map("<$_>", @languages), "\n" if DEBUG > 1;
311
312   push @languages, $base_class->fallback_language_classes;
313    # You are free to override that to return whatever.
314
315
316   my %seen = ();
317   foreach my $module_name ( map { $base_class . "::" . $_ }  @languages )
318   {
319     next unless length $module_name; # sanity
320     next if $seen{$module_name}++        # Already been here, and it was no-go
321             || !&_try_use($module_name); # Try to use() it, but can't it.
322     return($module_name->new); # Make it!
323   }
324
325   return undef; # Fail!
326 }
327
328 ###########################################################################
329 #
330 # This is where most people should stop reading.
331 #
332 ###########################################################################
333
334 sub _compile {
335   # This big scarp routine compiles an entry.
336   # It returns either a coderef if there's brackety bits in this, or
337   #  otherwise a ref to a scalar.
338   
339   my $target = ref($_[0]) || $_[0];
340   
341   my(@code);
342   my(@c) = (''); # "chunks" -- scratch.
343   my $call_count = 0;
344   my $big_pile = '';
345   {
346     my $in_group = 0; # start out outside a group
347     my($m, @params); # scratch
348     
349     while($_[1] =~  # Iterate over chunks.
350      m<\G(
351        [^\~\[\]]+  # non-~[] stuff
352        |
353        ~.       # ~[, ~], ~~, ~other
354        |
355        \[          # [ presumably opening a group
356        |
357        \]          # ] presumably closing a group
358        |
359        ~           # terminal ~ ?
360        |
361        $
362      )>xgs
363     ) {
364       print "  \"$1\"\n" if DEBUG > 2;
365
366       if($1 eq '[' or $1 eq '') {       # "[" or end
367         # Whether this is "[" or end, force processing of any
368         #  preceding literal.
369         if($in_group) {
370           if($1 eq '') {
371             $target->_die_pointing($_[1], "Unterminated bracket group");
372           } else {
373             $target->_die_pointing($_[1], "You can't nest bracket groups");
374           }
375         } else {
376           if($1 eq '') {
377             print "   [end-string]\n" if DEBUG > 2;
378           } else {
379             $in_group = 1;
380           }
381           die "How come \@c is empty?? in <$_[1]>" unless @c; # sanity
382           if(length $c[-1]) {
383             # Now actually processing the preceding literal
384             $big_pile .= $c[-1];
385             if($USE_LITERALS and (
386               (ord('A') == 65)
387                ? $c[-1] !~ m<[^\x20-\x7E]>s
388                   # ASCII very safe chars
389                : $c[-1] !~ m/[^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~\x07]/s
390                   # EBCDIC very safe chars
391             )) {
392               # normal case -- all very safe chars
393               $c[-1] =~ s/'/\\'/g;
394               push @code, q{ '} . $c[-1] . "',\n";
395               $c[-1] = ''; # reuse this slot
396             } else {
397               push @code, ' $c[' . $#c . "],\n";
398               push @c, ''; # new chunk
399             }
400           }
401            # else just ignore the empty string.
402         }
403
404       } elsif($1 eq ']') {  # "]"
405         # close group -- go back in-band
406         if($in_group) {
407           $in_group = 0;
408           
409           print "   --Closing group [$c[-1]]\n" if DEBUG > 2;
410           
411           # And now process the group...
412           
413           if(!length($c[-1]) or $c[-1] =~ m/^\s+$/s) {
414             DEBUG > 2 and print "   -- (Ignoring)\n";
415             $c[-1] = ''; # reset out chink
416             next;
417           }
418           
419            #$c[-1] =~ s/^\s+//s;
420            #$c[-1] =~ s/\s+$//s;
421           ($m,@params) = split(",", $c[-1], -1);  # was /\s*,\s*/
422           
423           # A bit of a hack -- we've turned "~,"'s into DELs, so turn
424           #  'em into real commas here.
425           if (ord('A') == 65) { # ASCII, etc
426             foreach($m, @params) { tr/\x7F/,/ } 
427           } else {              # EBCDIC (1047, 0037, POSIX-BC)
428             # Thanks to Peter Prymmer for the EBCDIC handling
429             foreach($m, @params) { tr/\x07/,/ } 
430           }
431           
432           # Special-case handling of some method names:
433           if($m eq '_*' or $m =~ m<^_(-?\d+)$>s) {
434             # Treat [_1,...] as [,_1,...], etc.
435             unshift @params, $m;
436             $m = '';
437           } elsif($m eq '*') {
438             $m = 'quant'; # "*" for "times": "4 cars" is 4 times "cars"
439           } elsif($m eq '#') {
440             $m = 'numf';  # "#" for "number": [#,_1] for "the number _1"
441           }
442
443           # Most common case: a simple, legal-looking method name
444           if($m eq '') {
445             # 0-length method name means to just interpolate:
446             push @code, ' (';
447           } elsif($m =~ m<^\w+(?:\:\:\w+)*$>s
448             and $m !~ m<(?:^|\:)\d>s
449              # exclude starting a (sub)package or symbol with a digit 
450           ) {
451             # Yes, it even supports the demented (and undocumented?)
452             #  $obj->Foo::bar(...) syntax.
453             $target->_die_pointing(
454               $_[1], "Can't (yet?) use \"SUPER::\" in a bracket-group method",
455               2 + length($c[-1])
456             )
457              if $m =~ m/^SUPER::/s;
458               # Because for SUPER:: to work, we'd have to compile this into
459               #  the right package, and that seems just not worth the bother,
460               #  unless someone convinces me otherwise.
461             
462             push @code, ' $_[0]->' . $m . '(';
463           } else {
464             # TODO: implement something?  or just too icky to consider?
465             $target->_die_pointing(
466              $_[1],
467              "Can't use \"$m\" as a method name in bracket group",
468              2 + length($c[-1])
469             );
470           }
471           
472           pop @c; # we don't need that chunk anymore
473           ++$call_count;
474           
475           foreach my $p (@params) {
476             if($p eq '_*') {
477               # Meaning: all parameters except $_[0]
478               $code[-1] .= ' @_[1 .. $#_], ';
479                # and yes, that does the right thing for all @_ < 3
480             } elsif($p =~ m<^_(-?\d+)$>s) {
481               # _3 meaning $_[3]
482               $code[-1] .= '$_[' . (0 + $1) . '], ';
483             } elsif($USE_LITERALS and (
484               (ord('A') == 65)
485                ? $p !~ m<[^\x20-\x7E]>s
486                   # ASCII very safe chars
487                : $p !~ m/[^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~\x07]/s
488                   # EBCDIC very safe chars            
489             )) {
490               # Normal case: a literal containing only safe characters
491               $p =~ s/'/\\'/g;
492               $code[-1] .= q{'} . $p . q{', };
493             } else {
494               # Stow it on the chunk-stack, and just refer to that.
495               push @c, $p;
496               push @code, ' $c[' . $#c . "], ";
497             }
498           }
499           $code[-1] .= "),\n";
500
501           push @c, '';
502         } else {
503           $target->_die_pointing($_[1], "Unbalanced ']'");
504         }
505         
506       } elsif(substr($1,0,1) ne '~') {
507         # it's stuff not containing "~" or "[" or "]"
508         # i.e., a literal blob
509         $c[-1] .= $1;
510         
511       } elsif($1 eq '~~') { # "~~"
512         $c[-1] .= '~';
513         
514       } elsif($1 eq '~[') { # "~["
515         $c[-1] .= '[';
516         
517       } elsif($1 eq '~]') { # "~]"
518         $c[-1] .= ']';
519
520       } elsif($1 eq '~,') { # "~,"
521         if($in_group) {
522           # This is a hack, based on the assumption that no-one will actually
523           # want a DEL inside a bracket group.  Let's hope that's it's true.
524           if (ord('A') == 65) { # ASCII etc
525             $c[-1] .= "\x7F";
526           } else {              # EBCDIC (cp 1047, 0037, POSIX-BC)
527             $c[-1] .= "\x07";
528           }
529         } else {
530           $c[-1] .= '~,';
531         }
532         
533       } elsif($1 eq '~') { # possible only at string-end, it seems.
534         $c[-1] .= '~';
535         
536       } else {
537         # It's a "~X" where X is not a special character.
538         # Consider it a literal ~ and X.
539         $c[-1] .= $1;
540       }
541     }
542   }
543
544   if($call_count) {
545     undef $big_pile; # Well, nevermind that.
546   } else {
547     # It's all literals!  Ahwell, that can happen.
548     # So don't bother with the eval.  Return a SCALAR reference.
549     return \$big_pile;
550   }
551
552   die "Last chunk isn't null??" if @c and length $c[-1]; # sanity
553   print scalar(@c), " chunks under closure\n" if DEBUG;
554   if(@code == 0) { # not possible?
555     print "Empty code\n" if DEBUG;
556     return \'';
557   } elsif(@code > 1) { # most cases, presumably!
558     unshift @code, "join '',\n";
559   }
560   unshift @code, "use strict; sub {\n";
561   push @code, "}\n";
562
563   print @code if DEBUG;
564   my $sub = eval(join '', @code);
565   die "$@ while evalling" . join('', @code) if $@; # Should be impossible.
566   return $sub;
567 }
568
569 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
570
571 sub _die_pointing {
572   # This is used by _compile to throw a fatal error
573   my $target = shift; # class name
574   # ...leaving $_[0] the error-causing text, and $_[1] the error message
575   
576   my $i = index($_[0], "\n");
577
578   my $pointy;
579   my $pos = pos($_[0]) - (defined($_[2]) ? $_[2] : 0) - 1;
580   if($pos < 1) {
581     $pointy = "^=== near there\n";
582   } else { # we need to space over
583     my $first_tab = index($_[0], "\t");
584     if($pos > 2 and ( -1 == $first_tab  or  $first_tab > pos($_[0]))) {
585       # No tabs, or the first tab is harmlessly after where we will point to,
586       # AND we're far enough from the margin that we can draw a proper arrow.
587       $pointy = ('=' x $pos) . "^ near there\n";
588     } else {
589       # tabs screw everything up!
590       $pointy = substr($_[0],0,$pos);
591       $pointy =~ tr/\t //cd;
592        # make everything into whitespace, but preseving tabs
593       $pointy .= "^=== near there\n";
594     }
595   }
596   
597   my $errmsg = "$_[1], in\:\n$_[0]";
598   
599   if($i == -1) {
600     # No newline.
601     $errmsg .= "\n" . $pointy;
602   } elsif($i == (length($_[0]) - 1)  ) {
603     # Already has a newline at end.
604     $errmsg .= $pointy;
605   } else {
606     # don't bother with the pointy bit, I guess.
607   }
608   Carp::croak( "$errmsg via $target, as used" );
609 }
610
611 ###########################################################################
612
613 my %tried = ();
614   # memoization of whether we've used this module, or found it unusable.
615
616 sub _try_use {   # Basically a wrapper around "require Modulename"
617   # "Many men have tried..."  "They tried and failed?"  "They tried and died."
618   return $tried{$_[0]} if exists $tried{$_[0]};  # memoization
619
620   my $module = $_[0];   # ASSUME sane module name!
621   { no strict 'refs';
622     return($tried{$module} = 1)
623      if defined(%{$module . "::Lexicon"}) or defined(@{$module . "::ISA"});
624     # weird case: we never use'd it, but there it is!
625   }
626
627   print " About to use $module ...\n" if DEBUG;
628   {
629     local $SIG{'__DIE__'};
630     eval "require $module"; # used to be "use $module", but no point in that.
631   }
632   if($@) {
633     print "Error using $module \: $@\n" if DEBUG > 1;
634     return $tried{$module} = 0;
635   } else {
636     print " OK, $module is used\n" if DEBUG;
637     return $tried{$module} = 1;
638   }
639 }
640
641 #--------------------------------------------------------------------------
642
643 sub _lex_refs {  # report the lexicon references for this handle's class
644   # returns an arrayREF!
645   no strict 'refs';
646   my $class = ref($_[0]) || $_[0];
647   print "Lex refs lookup on $class\n" if DEBUG > 1;
648   return $isa_scan{$class} if exists $isa_scan{$class};  # memoization!
649
650   my @lex_refs;
651   my $seen_r = ref($_[1]) ? $_[1] : {};
652
653   if( defined( *{$class . '::Lexicon'}{'HASH'} )) {
654     push @lex_refs, *{$class . '::Lexicon'}{'HASH'};
655     print "%" . $class . "::Lexicon contains ",
656          scalar(keys %{$class . '::Lexicon'}), " entries\n" if DEBUG;
657   }
658
659   # Implements depth(height?)-first recursive searching of superclasses.
660   # In hindsight, I suppose I could have just used Class::ISA!
661   foreach my $superclass (@{$class . "::ISA"}) {
662     print " Super-class search into $superclass\n" if DEBUG;
663     next if $seen_r->{$superclass}++;
664     push @lex_refs, @{&_lex_refs($superclass, $seen_r)};  # call myself
665   }
666
667   $isa_scan{$class} = \@lex_refs; # save for next time
668   return \@lex_refs;
669 }
670
671 sub clear_isa_scan { %isa_scan = (); return; } # end on a note of simplicity!
672
673 ###########################################################################
674 1;
675