develooper Front page | perl.perl5.porters | Postings from July 2003

[PATCH Tie::RefHash] added support for overloaded ""

From:
Xavier Noria
Date:
July 30, 2003 15:27
Subject:
[PATCH Tie::RefHash] added support for overloaded ""
Message ID:
200307310029.13567.fxn@hashref.com
Tie::RefHash stringfies references via "$k" to get their key. That might
not work, however, for objects with overloaded "". In the included patch
calls to overload::StrVal($k) are used instead.

fxn
--
s;$;Barcelona Perl Mongers;;$/=$||gaudi||3;map$,+=(split//)*(-1)**$|++,
(split)[.11_09,1.714];$.=$!!~m~erce~;$"=y~catalunya~~,$;=y~rambles~~,$*
=$/^$.;$:=$.+length,$@=$***$**$/**$*%$:,$%=$/*$"-$*;print+chr($_<0xA?$.
."$[$_":m:^$.:?"$.$_":$_)for($**($**$%-$//$/),$%-$*,$,*$/,$***$***$*,$*
**$,,$"*$@+$**$/,$**$,,$;,$***$***$*,$***$*,$.,$**$",$***$,,$***$***$**
$,,$.,$"*$*,$"+$.,$***$,,$,-$.,$"*$@+$**$/,$;*$/**$*,$",$.,++$@+by_fxn)


--- lib/Tie/RefHash.pm.orig	2003-07-30 21:30:19.000000000 +0200
+++ lib/Tie/RefHash.pm	2003-07-31 00:12:19.000000000 +0200
@@ -72,6 +72,8 @@
 @ISA = qw(Tie::Hash);
 use strict;
 
+use overload; # to support objects with overloaded ""
+
 sub TIEHASH {
   my $c = shift;
   my $s = [];
@@ -85,8 +87,9 @@
 sub FETCH {
   my($s, $k) = @_;
   if (ref $k) {
-      if (defined $s->[0]{"$k"}) {
-        $s->[0]{"$k"}[1];
+      my $kstr = overload::StrVal($k);
+      if (defined $s->[0]{$kstr}) {
+        $s->[0]{$kstr}[1];
       }
       else {
         undef;
@@ -100,7 +103,7 @@
 sub STORE {
   my($s, $k, $v) = @_;
   if (ref $k) {
-    $s->[0]{"$k"} = [$k, $v];
+    $s->[0]{overload::StrVal($k)} = [$k, $v];
   }
   else {
     $s->[1]{$k} = $v;
@@ -110,19 +113,19 @@
 
 sub DELETE {
   my($s, $k) = @_;
-  (ref $k) ? delete($s->[0]{"$k"}) : delete($s->[1]{$k});
+  (ref $k) ? delete($s->[0]{overload::StrVal($k)}) : delete($s->[1]{$k});
 }
 
 sub EXISTS {
   my($s, $k) = @_;
-  (ref $k) ? exists($s->[0]{"$k"}) : exists($s->[1]{$k});
+  (ref $k) ? exists($s->[0]{overload::StrVal($k)}) : exists($s->[1]{$k});
 }
 
 sub FIRSTKEY {
   my $s = shift;
   keys %{$s->[0]};	# reset iterator
   keys %{$s->[1]};	# reset iterator
-  $s->[2] = 0;
+  $s->[2] = 0;      # flag for iteration, see NEXTKEY
   $s->NEXTKEY;
 }
 
@@ -131,7 +134,7 @@
   my ($k, $v);
   if (!$s->[2]) {
     if (($k, $v) = each %{$s->[0]}) {
-      return $s->[0]{"$k"}[0];
+      return $v->[0];
     }
     else {
       $s->[2] = 1;




nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About