perl-embperl mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From Kee Hinckley <naz...@somewhere.com>
Subject DBIx::Recordset, Perl 5.8.1, Tied Hashes and typeglobs
Date Sat, 24 Jan 2004 21:56:53 GMT
DBIx::Recordset relies on the ability to return typeglobs from tied 
hashes.  This appears to have gone away at some point.  Take the 
following program below and try it under 5.6 and 5.8.

Here is the result under Perl 5.6 (MacOS X Jaguar)
Undefined value
Called fetch(foo)
          ->
Setting to 1
Called fetch(foo)
          -> 1
Setting to *foo
Retrieving *foo
Called fetch(foo)
          -> *main::foo
Retrieving a typeglob
Called fetch(2)
Returning a typglob
          -> *TestHash::bar

Here is the same program under Perl 5.8.1 (MacOS X Panther)
Undefined value
Called fetch(foo)

Setting to 1
Called fetch(foo)
          1
Setting to *foo
Can't upgrade that kind of scalar at ./tieglobtest.pl line 44.

Retrieving *foo
Called fetch(foo)
          1
Retrieving a typeglob
Called fetch(2)
Returning a typglob
Can't upgrade that kind of scalar at ./tieglobtest.pl line 48.


Suggestions?


tieglobtest.pl

#!/usr/bin/perl

use strict;
package TestHash;
require Tie::Hash;

use vars qw(@ISA $internal2);
@ISA = qw(Tie::StdHash);


sub FETCH {
     my $this = shift;
     my ($value) = @_;

     print STDERR "Called fetch($value)\n";
     if ($value == 2) {
         print STDERR "Returning a typglob\n";
         local(*bar);
         $internal2 = *bar;
         return *bar;
     }
     return $this->SUPER::FETCH($value);
}



package main;

my ($th, %th);
use vars qw($internal);

tie %th, 'TestHash';

print STDERR "Undefined value\n";
print STDERR "\t -> $th{foo}\n";
print STDERR "Setting to 1\n";
$th{foo} = 1;
print STDERR "\t -> $th{foo}\n";

local(*foo);
*foo = $internal;

print STDERR "Setting to *foo\n";
eval { $th{foo} = *foo; }; print STDERR "$@\n" if ($@);
print STDERR "Retrieving *foo\n";
eval { print STDERR "\t -> $th{foo}\n"; };print STDERR "$@\n" if ($@);
print STDERR "Retrieving a typeglob\n";
eval { print STDERR "\t -> $th{2}\n"; };print STDERR "$@\n" if ($@);

-- 
Kee Hinckley
http://www.messagefire.com/         Next Generation Spam Defense
http://commons.somewhere.com/buzz/  Writings on Technology and Society

I'm not sure which upsets me more: that people are so unwilling to accept
responsibility for their own actions, or that they are so eager to regulate
everyone else's.

---------------------------------------------------------------------
To unsubscribe, e-mail: embperl-unsubscribe@perl.apache.org
For additional commands, e-mail: embperl-help@perl.apache.org


Mime
View raw message