How to change the symbol table to wrap a sub in another sub ?

[Withigo]

Dear Monks,
In the pursuit of Laziness, I am attempting to wrap a sub with another sub, and thought that manipulating the symbol table of the package would be the way to go. Since it should only be a couple of lines of code, I'd rather not use a module. Besides, it's nice to know how to do this.
The sub I am wrapping is CGI's param(), and the reason is so that I can call Encode::decode_utf8() on everything returned from param(). Instead of modifying hundreds of individual calls to param(), I'll just hook param() in one place. But I can't quite get it to work, and I couldn't find very many clear explanations with examples here in the monastery.
My code so far:

no strict 'refs';
# get a copy of the real sub
our $real_param = *{"CGI::param"}{CODE};
# automagically create a new sub that contains the old sub
*{"CGI::_real_param"} = \&{$real_param};

# override param()
*{"CGI::param"} = sub {
    return Encode::decode_utf8(shift->_real_param(@_));
};

But it doesn't work. I'm finding the syntax a bit tricky for getting a typeglob out of CGI's symbol table hash and into a scalar reference, and then putting that sub reference into a new typeglob that can be called as a sub. What am I doing wrong and what is a better way?
Thanks!

[davido]

Couldn't you subclass CGI and work using its object oriented interface? In other words, CGI::UTF8 would have $q->param() method that internally utilizes CGI's param() method, but implements its own CGI::UTF8 param() sub for its external interface.

[dtr]

As Davido has mentioned, subclassing would be a better approach. On the other hand, if you don't want to do that, then this should work:-

{
    no strict 'refs';
    no warnings 'redefine';

    my $code = \&CGI::param;
    *{"CGI::param"} = sub {
        my $ret = &$code(@_);
        return Encode::decode_utf8($ret);
    };
}

There are also various modules on the CPAN to do this for you - have a look at Hook::LexWrap and Sub::WrapPackages for starters.

[ikegami]

Why not just subclass CGI?

If you don't want to do that, then I recommend the following:

# Must appear before "use CGI".
BEGIN {
   require CGI;
   package CGI;
   no warnings 'redefine';
   my $real_param = \&CGI::param;
   sub param {
      if (wantarray) {
         return map { Encode::decode_utf8($_) } $real_param->(@_);
      } else {
         return Encode::decode_utf8($real_param->(@_));
      }
   }
}

My version fixes two bugs.

• My version works when called as a function.
• My version works correctly when called in list context.

Updated to work in list context.

[Withigo]

Thanks for the quick replies!
I poked around CGI.pm and discovered that param() is already calling Encode::decode_utf8, so I don't need to! But decode is only called if the charset() is set to utf-8.
So I also tried the following, which works sometimes, and sometimes not. I'm not sure why the charset gets unset sometimes. In the end I used ikegami's solution. Thanks ikegami!



BEGIN{
  no strict 'refs';
  my $real_new = \&CGI::new;
  *{"CGI::new"} = sub {
      my $cgi = &$real_new(@_);
      $cgi->charset('utf-8');
      return $cgi;
  };
}

However, I am confused about one thing in the code suggested.

I always thought that if you take a reference, and then change the underlying typeglob, then the referent must now refer to the new typeglob. The above $real_new refers to the CODE slot in the CGI::new typeglob, and then I put a new sub into the CODE typeglob, so why does $real_new still refer to the contents of the old CODE slot?

And I'm still intersted in seeing out how to do this by using a typeglob instead of a reference to a sub.

[chromatic]

I always thought that if you take a reference, and then change the underlying typeglob, then the referent must now refer to the new typeglob.

Why would it do that? If Perl worked that way, it would need two types of references. One would work for items not in a symbol table (anonymous data structures and subroutines, for example, or references to lexicals) and the other would always look up the referent through the symbol table for each access.

... why does $real_new still refer to the contents of the old CODE slot?

Because perl does the lookup once, finds the contents, and makes a reference to it. Changing what's in the slot after you've already fetched something from the slot only changes what's currently in the slot. It doesn't change what was in the slot previously.