Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic
 
PerlMonks  

Detecting declaration type?

by LanX (Canon)
on Sep 17, 2012 at 21:24 UTC ( #994113=perlquestion: print w/ replies, xml ) Need Help??
LanX has asked for the wisdom of the Perl Monks concerning the following question:

Hi

is it possible to detect the "declared type" of a variable at runtime?

{package Foo } my Foo $x; print type_of($x) # should print Foo

I read fields, but I couldn't find any practical way to achieve this.

Cheers Rolf

Comment on Detecting declaration type?
Download Code
Re: Detecting declaration type?
by RichardK (Priest) on Sep 17, 2012 at 22:10 UTC

    I think this is what you're looking for : ref

      unfortunately not, cause my Foo $x doesn't bless $x into Foo.

      Cheers Rolf

Re: Detecting declaration type?
by tobyink (Abbot) on Sep 17, 2012 at 22:38 UTC

    OK, this ain't pretty...

    use 5.010; use Lexical::Types; use Hash::FieldHash qw(fieldhash); BEGIN { fieldhash %::_TYPE_TRACKER } BEGIN { package Foobar; sub TYPEDSCALAR { $::_TYPE_TRACKER{\$_[1]} = $_[2] } } my Foobar $foo = "Hello"; say $::_TYPE_TRACKER{ \$foo };
    perl -E'sub Monkey::do{say$_,for@_,do{($monkey=[caller(0)]->[3])=~s{::}{ }and$monkey}}"Monkey say"->Monkey::do'
      Thanks a lot!

      I didn't expect to even get two good answers! :)

      Cheers Rolf

Re: Detecting declaration type?
by Anonymous Monk on Sep 17, 2012 at 23:24 UTC

    Apparently introspection isn't part of the API

    see attributes, Attribute::Handlers

    #!/usr/bin/perl -- package Foo; BEGIN { use Scalar::Util qw( refaddr ); our %attrs; sub MODIFY_SCALAR_ATTRIBUTES { print "Foo::MODIFY_SCALAR_ATTRIBUTES! @_\n"; my($package, $scalarref, @attrs) = @_; $attrs{ refaddr $scalarref } = \@attrs; return; } sub FETCH_SCALAR_ATTRIBUTES { print "Foo::FETCH_SCALAR_ATTRIBUTES! @_\n"; my($package, $scalarref) = @_; my $attrs = $attrs{ refaddr $scalarref }; return $attrs ? @$attrs : (); } sub new { print "Foo::new! @_\n"; my $class = shift; return bless { yo => [@_] }, $class ; } } use strict; use warnings; use attributes(); use Data::Dump; my Foo $bar : WHAT = 24; my Foo $ey = 42; my Foo $new :AND :CHEWY = Foo->new( 42 ); print "\n\n"; for my $ref( \$bar, \$ey, \$new ){ dd $ref; dd [ attributes::get($ref) ]; dd [ attributes::_fetch_attrs($ref) ]; #~ use Devel::Peek;Dump( $ref ); print "\n\n"; } dd \%Foo::attrs; __END__ Foo::MODIFY_SCALAR_ATTRIBUTES! Foo SCALAR(0x9c8284) WHAT Foo::new! Foo 42 Foo::MODIFY_SCALAR_ATTRIBUTES! Foo SCALAR(0xa3358c) AND CHEWY \24 Foo::FETCH_SCALAR_ATTRIBUTES! Foo SCALAR(0x9c8284) ["WHAT"] [] \42 Foo::FETCH_SCALAR_ATTRIBUTES! Foo SCALAR(0x99aa3c) [] [] \bless({ yo => [42] }, "Foo") [] [] { 10257028 => ["WHAT"], 10696076 => ["AND", "CHEWY"] }
      Great Anonymous!

      you seem to solve it w/o any XS-dependencies which is brilliant.

      I'll test it as soon as possible!

      Cheers Rolf

        Here it is slightly clearer description of the problem, you cannot find out what the type is -- attributes calls the appropriate MODIFY handler and that is it, but you can't do FETCH-ing outside of the class, attributes::get will call the wrong FETCH based on caller

        #!/usr/bin/perl -- use strict; use warnings; use attributes(); use Data::Dump; BEGIN { package Junk; $INC{'Junk.pm'}=__FILE__; use Scalar::Util(); sub Junk::MODIFY_SCALAR_ATTRIBUTES { print "Junk::MODIFY_SCALAR_ATTRIBUTES! @_\n"; my($package, $scalarref, @attrs) = @_; $Junk::attrs{ Scalar::Util::refaddr $scalarref } = \@attrs; return; } sub Junk::FETCH_SCALAR_ATTRIBUTES { print "Junk::FETCH_SCALAR_ATTRIBUTES! @_\n"; my($package, $scalarref) = @_; my $attrs = $Junk::attrs{ Scalar::Util::refaddr $scalarref }; return $attrs ? @$attrs : (); } } BEGIN { package Foo; use Scalar::Util(); sub MODIFY_SCALAR_ATTRIBUTES { print "Foo::MODIFY_SCALAR_ATTRIBUTES! @_\n"; my($package, $scalarref, @attrs) = @_; $Foo::attrs{ Scalar::Util::refaddr $scalarref } = \@attrs; return; } sub FETCH_SCALAR_ATTRIBUTES { print "Foo::FETCH_SCALAR_ATTRIBUTES! @_\n"; my($package, $scalarref) = @_; my $attrs = $Foo::attrs{ Scalar::Util::refaddr $scalarref }; return $attrs ? @$attrs : (); } sub MODIFY_REF_ATTRIBUTES { print "Foo::MODIFY_REF_ATTRIBUTES! @_\n"; my($package, $scalarref, @attrs) = @_; $Foo::attrs{ attributes::refaddr $scalarref } = \@attrs; return; } sub FETCH_REF_ATTRIBUTES { print "Foo::FETCH_REF_ATTRIBUTES! @_\n"; my($package, $scalarref) = @_; my $attrs = $Foo::attrs{ Scalar::Util::refaddr $scalarref }; return $attrs ? @$attrs : (); } sub new { print "Foo::new! @_\n"; my $class = shift; return bless { yo => [@_] }, $class ; } } sub FETCH_SCALAR_ATTRIBUTES { print "\nCalling me is a mistake? bug?\n@_\n@{[caller]}\nSince the +re is no object, you don't know type(package)\n\n"; return; } BEGIN { * FETCH_REF_ATTRIBUTES = \&FETCH_SCALAR_ATTRIBUTES ; } my Junk $bar :STOOL :CHAIR = 42; my Foo $new :AND :CHEWY = Foo->new( 42 ); for my $ref( \$bar, \$new ){ dd [ $ref, attributes::reftype( $ref ) , attributes::_guess_stash +( $ref ) ], [ attributes::get($ref) ], [ attributes::_fetch_attrs($ref) ];;; print "\n\n"; } dd \%Junk::attrs , \%Foo::attrs; __END__ Junk::MODIFY_SCALAR_ATTRIBUTES! Junk SCALAR(0xa38c14) STOOL CHAIR Foo::new! Foo 42 Foo::MODIFY_SCALAR_ATTRIBUTES! Foo SCALAR(0xa38ca4) AND CHEWY Calling me is a mistake? bug? main SCALAR(0xa38c14) attributes C:/perl/5.14.1/lib/MSWin32-x86-multi-thread/attributes.pm 9 +2 Since there is no object, you don't know type(package) ([\42, "SCALAR", undef], [], []) Calling me is a mistake? bug? main REF(0xa38ca4) attributes C:/perl/5.14.1/lib/MSWin32-x86-multi-thread/attributes.pm 9 +2 Since there is no object, you don't know type(package) ([\bless({ yo => [42] }, "Foo"), "REF", undef], [], []) ( { 10718228 => ["STOOL", "CHAIR"] }, { 10718372 => ["AND", "CHEWY"] }, )

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://994113]
Approved by davies
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (5)
As of 2014-12-21 21:56 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (108 votes), past polls