diff options
| author | Jeff Pinyan <japhy@pobox.com> | 2004-04-12 16:24:48 -0400 |
|---|---|---|
| committer | Rafael Garcia-Suarez <rgarciasuarez@gmail.com> | 2004-04-14 08:28:15 +0000 |
| commit | 09e0265ac2438ceab7fdd1011e375d10d5db2a81 (patch) | |
| tree | c85a168416dec025b25ab1c364b7356c72d0dd02 /lib/utf8_heavy.pl | |
| parent | 13f8f3987335c6eed94bd796ae4e7be8f788fdbf (diff) | |
| download | perl-09e0265ac2438ceab7fdd1011e375d10d5db2a81.tar.gz | |
lib/utf8_heavy.pl -- cascading classes and '&' support
Message-ID: <Pine.LNX.4.44.0404122011160.3038-200000@perlmonk.org>
p4raw-id: //depot/perl@22693
Diffstat (limited to 'lib/utf8_heavy.pl')
| -rw-r--r-- | lib/utf8_heavy.pl | 24 |
1 files changed, 20 insertions, 4 deletions
diff --git a/lib/utf8_heavy.pl b/lib/utf8_heavy.pl index f4a0aaa3e8..668a176e4e 100644 --- a/lib/utf8_heavy.pl +++ b/lib/utf8_heavy.pl @@ -88,7 +88,7 @@ sub SWASHNEW { ## It could be a user-defined property. ## - my $caller1 = caller(1); + my $caller1 = $type =~ s/(.+)::// ? $1 : caller(1); if (defined $caller1 && $type =~ /^(?:\w+)$/) { my $prop = $caller1 . "::" . ( $wasIs ? "Is" : "" ) . $type; @@ -108,6 +108,7 @@ sub SWASHNEW { if (defined $caller0 && $type =~ /^To(?:\w+)$/) { my $map = $caller0 . "::" . $type; + if (exists &{$map}) { no strict 'refs'; @@ -203,11 +204,14 @@ sub SWASHNEW { my $char = $1; my $name = $2; print STDERR "$1 => $2\n" if DEBUG; - if ($char =~ /[-+!]/) { + if ($char =~ /[-+!&]/) { my ($c,$t) = split(/::/, $name, 2); # bogus use of ::, really my $subobj; if ($c eq 'utf8') { - $subobj = $c->SWASHNEW($t, "", 0, 0, 0); + $subobj = utf8->SWASHNEW($t, "", 0, 0, 0); + } + elsif (exists &$name) { + $subobj = utf8->SWASHNEW($name, "", 0, 0, 0); } elsif ($c =~ /^([0-9a-fA-F]+)/) { $subobj = utf8->SWASHNEW("", $c, 0, 0, 0); @@ -315,7 +319,7 @@ sub SWASHGET { } for my $x ($self->{EXTRAS}) { pos $x = 0; - while ($x =~ /^([-+!])(.*)/mg) { + while ($x =~ /^([-+!&])(.*)/mg) { my $char = $1; my $name = $2; print STDERR "INDIRECT $1 $2\n" if DEBUG; @@ -356,6 +360,18 @@ sub SWASHGET { } } } + elsif ($char eq '&') { + if ($bits == 1 and $otherbits == 1) { + $swatch &= $other; + } + else { + for ($key = 0; $key < $len; $key++) { + if (!vec($other, $key, $otherbits)) { + vec($swatch, $key, $bits) = 0; + } + } + } + } } } if (DEBUG) { |