Ovid has asked for the wisdom of the Perl Monks concerning the following question:

Working more on my debugging module and I wanted a cleaner interface for dumping CGI params than the dumping the CGI object. Basically, I'd like the user to be able to get a list of all parameters and their associated values. However, I want them to be able to do this regardless of whether or not they are using the function oriented or object oriented methods of CGI.pm. Here's some code that demonstrates:

use strict; use warnings; use Foo; use CGI qw/:standard/; my $q = CGI->new( { foo => 'bar', baz => 'Ovid' } ); my $foo = Foo->new; print $foo->list_params( 1 ); print $foo->list_params( $q );

The object takes its parameters from the ones passed to the constructor. Running this from the command line will give the function oriented method the parameters entered on the command line. Name the program test.pl and enter the following from the command line:

test.pl one=two red=blue red=herring bob= marley=bob

The output should be as follows:

$VAR1 = { 'one' => 'two', 'red' => [ 'blue', 'herring' ], 'marley' => 'bob', 'bob' => '' }; $VAR1 = { 'foo' => 'bar', 'baz' => 'Ovid' };

Here's the module Foo.pm that creates this output (this is all simplified tremendously):

package Foo; use strict; use Data::Dumper; sub new { my $class = shift; my ( $package ) = caller; my $objref = { _package => $package }; bless $objref, $class; } sub list_params { my ( $self, $cgi ) = @_; my %formdata; # Use this if OO CGI if ( ref $cgi eq 'CGI' ) { foreach my $key ( $cgi->param ) { my @vals = $cgi->param( $key ); $formdata{ $key } = _format_vals( \@vals ); } # Function-oriented CGI } elsif ( $cgi ) { { # Don't try this at home, kids no strict qw/ refs subs /; my $_param = $self->{ '_package' }.'::param'; my $package = \%{$self->{ '_package' } . '::'}; # Looks like a function oriented call but 'param' was not +exported if ( ! exists $package->{ 'param' } ) { return 0; } foreach my $key ( eval $_param ) { my $_param_call = $_param . "($key)"; my @vals = eval $_param_call; $formdata{ $key } = _format_vals( \@vals ); } } } else { return 0; } Dumper( \%formdata ); } sub _format_vals { my $vals = shift; @$vals == 1 ? @$vals[ 0 ] : ! @$vals ? undef : $vals; } "Ovid";

My first question: I don't like the fact that the user has two different ways of calling the method depending upon whether or not they are using the function or object oriented interface to CGI.pm. Unfortunately, I can't think of a way to simplify this. I would prefer for this to be transparent. I suppose I could walk the symbol table of the calling package and pick any object with a CGI ref, but what if they have more than one CGI object instantiated?

My second question: I've not used typeglobs a lot. Are there any issues with this that I should be aware of?

Third question: I have read several times that taking the ref of an object to determine what it is can be a bad idea. Is it possible that the user could pass a valid CGI object that won't have a ref of 'CGI'?

Fourth question: Is there a cleaner way to write the "no strict..." block in Foo.pm?

Cheers,
Ovid

Join the Perlmonks Setiathome Group or just click on the the link and check out our stats.

Replies are listed 'Best First'.
(Ovid - Dang, I love this place -- and one more question :)
by Ovid (Cardinal) on Jun 01, 2001 at 21:01 UTC

    Thanks for all of the help, everyone! Here's the new list_params() function:

    sub list_params { my ( $self, $cgi ) = @_; my %formdata; $cgi = CGI::self_or_default if ( ! defined $cgi or ! ref $cgi ) an +d $cgi; if ( defined $cgi and $cgi ) { foreach my $key ( $cgi->param ) { my @vals = $cgi->param( $key ); $formdata{ $key } = _format_vals( \@vals ); } } else { return 0; } Dumper( \%formdata ); }

    It's smaller, cleaner, faster, and no typeglobs. I've tested it fairly carefully from the command line and it seems to be fine, regardless of the number of CGI objects or mixing and matching the function and object-oriented interfaces.

    Wondering one thing, though: if a object is a subclass of CGI.pm. is it possible for it to not have the param() method? If so, I'll need to test for $cgi->can('param'). If it is possible to inherit from a module but not inherit all methods, how would that be done?

    Cheers,
    Ovid

    Update: Updated code to be even cleaner.

    Join the Perlmonks Setiathome Group or just click on the the link and check out our stats.

      It might be hard not to inherit the param method, but it is certainly possible to redefine it so its return values make no sense for you:

      package my_dumb_cgi; @ISA = ("CGI"); sub param { return "gotcha!"; }

      Not that this would make any sense, just that it is possible.

      Ah, better. This:

      params { my ( $self, $cgi ) = @_; my %formdata; $cgi = CGI::self_or_default if ( ! defined $cgi or ! ref $cgi ) an +d $cgi; if ( defined $cgi and $cgi ) {
      deserves a bit of "improvement". I'll go through step-wise as I hope that will be more enlightening.

      I was not able to understand this:     $cgi = CGI::self_or_default if ( ! defined $cgi or ! ref $cgi ) and $cgi; so I did some "mechanical" translation which made it easy for me to understand (this may have more to do with the strange ways in which my mind works, though):     $cgi = CGI::self_or_default   if  $cgi  and  ! ( defined $cgi and ref $cgi ); So we don't want to override $cgi if it is false and we don't want to override $cgi if it is a good reference. But, my testing shows that ref $cgi doesn't produce a warning even if $cgi is undef so we can shorten this to:     $cgi = CGI::self_or_default   if  $cgi  and  ! ref $cgi;

      Similarly, $cgi in a "Boolean context" doesn't elicit a warning in the face of undef so:     if ( defined $cgi and $cgi ) { can become:     if (  $cgi  ) {

      This brings us to:

      params { my ( $self, $cgi ) = @_; my %formdata; $cgi = CGI::self_or_default if $cgi and ! ref $cgi; if ( $cgi ) {
      But I'd factor out the if($cgi):
      if ( $cgi ) { $cgi = CGI::self_or_default if ! ref $cgi;
      Finally you can swap if ! with just unless, but I find that mostly a matter of taste.

      Well, anyway, that "works" better for me. (:

              - tye (but my friends call me "Tye")

        Much nicer. One little issue, though:

        # This: $cgi = CGI::self_or_default if $cgi and ! ref $cgi; # is not equivalent to this: $cgi = CGI::self_or_default if ! ref $cgi;

        The reason this is the case is how it's called:

        print $foo->list_params( 1 );

        If someone supplies a false value, it should return "0". With the second version of your assignment to $cgi, it will always return the params, regardless of whether or not a false value has been passed. That might seem irrelevant, but this is a reduced test case of the actual code. Here's how this will be used in real life:

        $write->table( -params => 1, -condition => "$x % 7 == 3", -active => 1, -caller => 0, SomeVar => $some_var, DATA => \%some_hash );

        Since this is part of a debugging module, the programmer may want to turn off the param display once the params are verified, or turn them back on again if there is a problem. Rather than going through and deleting or re-entering the '-param' key, the programmer can just toggle the value at will. (I know we discussed this with /msgs, but this is for the benefit of those not privy to the conversation).

        Cheers,
        Ovid

        Update: Hmm... I seem to be posting a lot of updates lately :(

        Seems I missed a little if which drastically changes the meaning of tye's code:

        if ( $cgi ) { $cgi = CGI::self_or_default if ! ref $cgi;

        sigh

        Join the Perlmonks Setiathome Group or just click on the the link and check out our stats.

      Ovid asks: Wondering one thing, though: if a object is a subclass of CGI.pm. is it possible for it to not have the param() method? If so, I'll need to test for $cgi->can('param'). If it is possible to inherit from a module but not inherit all methods, how would that be done?

      First I figured you could undef a subroutine:

      package MyCGI; use base CGI; undef(*MyCGI::param);
      But then I realized that the subroutine wasn't defined in MyCGI, it was defined in CGI. So I don't think you can undef an inherited routine. But I'm not sure...

      Update: would it be possible to (instead of using @ISA for inheritance) copy all of the subroutine refs from the parent class symbol table into your own and then delete one of them? I'll look into it...

      Later: yes, you can copy from a superclass instead of using @ISA:

      package A; sub abc { "abc\n" }; sub def { "def\n" }; package B; # inherit from A all but A::def foreach my $symname (keys %A::) { next if $symname eq 'def'; $B::{$symname} = $A::{$symname}; } my $b = bless({}, 'B'); print $b->abc; # prints "abc\n" print $b->def; # no such method
Re: Typeglobs and Symbol tables
by stephen (Priest) on Jun 01, 2001 at 04:44 UTC
    Actually, I think maybe you're being too nice to your users. :) If they're using the procedural interface, they can access the object via $CGI::Q like so:
    use CGI qw(:standard); $foo->list_params($CGI::Q);

    Since the procedural interface uses $CGI::Q behind the scenes, there's no need to do the symbol table piggery-jokery you've got. :)

    As princepawn was wondering, it's best to check with the isa() method. For any object $foo, you can check to see if it inherits from or is a certain class by saying $foo->isa('CGI'). It is indeed possible that the user could pass a CGI::Fast object, which is a valid CGI object but will fail ref $cgi eq 'CGI'.

    So, my rewrite would be:

    package Foo; use strict; use Data::Dumper; sub list_params { my ( $self, cgi ) = @_; my %formdata; defined($cgi) && ref($cgi) && $cgi->isa('CGI') or return 0; foreach my $key ( $cgi->param ) { $formdata{ $key } = _format_vals( [ $cgi->param( $key ) ] ); } Dumper( \%formdata ); }
    Note: Code untested.

    stephen

Re: Typeglobs and Symbol tables
by shotgunefx (Parson) on Jun 01, 2001 at 11:17 UTC
    I might be mistaken, but it looks like you are not actually inheriting from CGI?

    It may be easier to subclass it. CGI has a function for mixing and matching the object oriented and procedural interface called CGI::self_or_default(@_);

    Used like so in your overridden functions it will either return the current CGI (or CGI inherited object) or created the default $Q.
    my ($self,@p) = CGI::self_or_default(@_);


    One problem I have noticed with mixing and matching the OO and functional interface while inheriting is that functional calls always appear to use $CGI::Q whether you have created an object via new or not. This can be a problem if you are inheriting from CGI and want to override param to store additional information in the object(like debugging)as they will get stored in different instances depending on how they where called.

    A quick fix for me was using new in the following manner.

    $CGI::Q = new CGI::DebugModule(); # Mix and match away


    You could always provide your own self_or_default to be smart enought to use an existing object if one has been created via new as well.

    -Lee

    "To be civilized is to deny one's nature."
(tye)Re: Typeglobs and Symbol tables
by tye (Sage) on Jun 01, 2001 at 19:49 UTC
    $cgi= $CGI::Q   unless  defined $cgi; Update: $cgi= CGI::self_or_default   unless  defined $cgi;         - tye (but my friends call me "Tye")
Re: Typeglobs and Symbol tables
by princepawn (Parson) on Jun 01, 2001 at 03:03 UTC
    My second question: I've not used typeglobs a lot. Are there any issues with this that I should be aware of?
    I have read that Perl 6 will do away with typeglobs. I don't know if there is a way to write your code so that it will work in Perl 5 and Perl 6.

      Is anyone worrying yet about writing code that works in Perl 5 and Perl 6? Seems a little silly, given that the language design for Perl 6 is still in a state of flux.

      Yes, it does look as tho' typeglobs will cease to exist in Perl 6, but there will be some other way to achieve the same results - probably far more cleanly. Also, there will be ways to automatically convert Perl 5 scripts to Perl 6 syntax - tho' I wouldn't be surprised if typeglob fell into the 10% that this didn't work for :(

      --
      <http://www.dave.org.uk>

      "Perl makes the fun jobs fun
      and the boring jobs bearable" - me

Re: Typeglobs and Symbol tables
by princepawn (Parson) on Jun 01, 2001 at 03:06 UTC
    Third question: I have read several times that taking the ref of an object to determine what it is can be a bad idea. Is it possible that the user could pass a valid CGI object that won't have a ref of 'CGI'?
    Well, if someone has subclassed CGI then the ref will return the string of that class instead. Is there an isa() method in Perl? If not, there certain is a can() method and you could call some method of the ref that is 100% unique to CGI as a means of checking the inheritance tree.
      can() is a method in the special UNIVERSAL package... and so is isa(). Enjoy!
Re: Typeglobs and Symbol tables
by princepawn (Parson) on Jun 01, 2001 at 03:12 UTC
    Fourth question: Is there a cleaner way to write the "no strict..." block in Foo.pm?
    I don't really see the point of your module. Have you seen this section of the CGI documentation?
    FETCHING THE PARAMETER LIST AS A HASH: $params = $q->Vars; print $params->{'address'}; @foo = split("\0",$params->{'foo'}); %params = $q->Vars; use CGI ':cgi-lib'; $params = Vars;

      princepawn wrote:

      I don't really see the point of your module.

      Good point. However, as I mentioned, this is a simplified test case and therefore is taken drastically out of context. This is actually some work I'm doing on this module, the POD of which can be read here.

      Essentially, the programmer often has the problem of trying to debug CGI programs that require cookies, secure connections, or any of a variety of circumstances that make debugging from the command line problematic. With the module I've been working on, they can dump all sorts of useful data to a separate browser window (variable values, traces of function calls, caller information, etc). I am aware of the Vars function, but that didn't suit my needs in this case.

      Cheers,
      Ovid

      Join the Perlmonks Setiathome Group or just click on the the link and check out our stats.