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

So this is somewhat of an odd thing I ran in to - I guess I'm missing something here completely. I am using LWP to write a simple script which does a form post on a given url & gets the response back & looks for certain data like cookies. The script works fine by itself & it returns output something like this, which is what is expected & I can do stuff like $response->headers('Cookies') & get some result back:

$VAR1 = bless( {
  '_protocol' => 'HTTP/1.1',
  '_content' => '',
  '_rc' => '302',
  '_headers' => bless( {
    'client-response-num' => 1,
    'cache-control' => 'no-store',
    'location' => 'https://jt-sa-01/dana-admin/misc/admin.cgi',
    'set-cookie' => [
      'DSASSERTREF=x; path=/; expires=Thu, 01 Jan 1970 22:00:00 GMT; s
+ecure',
      'DSID=0f3004797e779893378f666af21f9a26; path=/; secure',
      'DSFirstAccess=1277234276; path=/; secure'
    ],
    'date' => 'Tue, 22 Jun 2010 19:17:56 GMT',
    'client-ssl-cert-issuer' => '/C=??/ST=??/L=??/O=SLT/OU=??/CN=chang
+emyip.net/emailAddress=??',
    'client-ssl-cipher' => 'RC4-SHA',
    'client-peer' => '10.64.221.51:443',
    'client-date' => 'Tue, 22 Jun 2010 21:21:18 GMT',
    'client-ssl-warning' => 'Peer certificate not verified',
    'content-type' => 'text/html; charset=utf-8',
    'pragma' => 'no-cache',
    'client-ssl-cert-subject' => '/C=??/ST=??/L=??/O=SLT/OU=??/CN=chan
+gemyip.net/emailAddress=??',
    'client-transfer-encoding' => [
      'chunked'
    ],
    'expires' => '-1'
  }, 'HTTP::Headers' ),
  '_msg' => 'Moved',
  'handlers' => {
    'response_data' => [
      {
        'callback' => sub { "DUMMY" }
      },
      {
        'callback' => sub { "DUMMY" }
      }
    ]
  },
  '_request' => bless( {
    '_content' => 'username=admindb&password=dana123&realm=Admin%20Use
+rs',
    '_uri' => bless( do{\(my $o = 'https://jt-sa-01/dana-na/auth/url_a
+dmin/login.cgi')}, 'URI::https' ),
    '_headers' => bless( {
      'user-agent' => 'libwww-perl/5.820',
      'content-type' => 'application/x-www-form-urlencoded'
    }, 'HTTP::Headers' ),
    '_method' => 'POST',
    '_uri_canonical' => $VAR1->{'_request'}{'_uri'}
  }, 'HTTP::Request' )
}, 'HTTP::Response' );

[download]

But, if I try to take the same piece of code & plug it into our framework as a class method & invoke it on the same machine, the response is little bit different:

$VAR1 = bless( {
  '_previous' => bless( {
    '_previous' => bless( {
      '_previous' => bless( {
        '_previous' => bless( {
          '_protocol' => 'HTTP/1.1',
          '_content' => '',
          '_rc' => '302',
          '_headers' => bless( {
            'client-response-num' => 1,
            'cache-control' => 'no-store',
            'location' => 'https://jt-sa-01/dana-admin/misc/admin.cgi'
+,
            'set-cookie' => [
              'DSASSERTREF=x; path=/; expires=Thu, 01 Jan 1970 22:00:0
+0 GMT; secure',
              'DSID=10a4e7edf63570a214bce369cacaced1; path=/; secure',
              'DSFirstAccess=1277232586; path=/; secure'
            ],
            'date' => 'Tue, 22 Jun 2010 18:49:46 GMT',
            'client-ssl-cert-issuer' => '/C=??/ST=??/L=??/O=SLT/OU=??/
+CN=changemyip.net/emailAddress=??',
            'client-ssl-cipher' => 'RC4-SHA',
            'client-peer' => '10.64.221.51:443',
            'client-date' => 'Tue, 22 Jun 2010 20:53:01 GMT',
            'client-ssl-warning' => 'Peer certificate not verified',
            'content-type' => 'text/html; charset=utf-8',
            'pragma' => 'no-cache',
            'client-ssl-cert-subject' => '/C=??/ST=??/L=??/O=SLT/OU=??
+/CN=changemyip.net/emailAddress=??',
            'client-transfer-encoding' => [
              'chunked'
            ],
            'expires' => '-1'
          }, 'HTTP::Headers' ),
          '_msg' => 'Moved',
          'handlers' => {
            'response_data' => [
              {
                'callback' => sub { "DUMMY" }
              },
              {
                'callback' => sub { "DUMMY" }
              }
            ]
          },
          '_request' => bless( {
            '_content' => 'username=admindb&password=dana123&realm=Adm
+in%20Users',
            '_uri' => bless( do{\(my $o = 'https://jt-sa-01/dana-na/au
+th/url_admin/login.cgi')}, 'URI::https' ),
            '_headers' => bless( {
              'user-agent' => 'libwww-perl/5.820',
              'content-type' => 'application/x-www-form-urlencoded'
            }, 'HTTP::Headers' ),
            '_method' => 'POST',
            '_uri_canonical' => $VAR1->{'_previous'}{'_previous'}{'_pr
+evious'}{'_previous'}{'_request'}{'_uri'}
          }, 'HTTP::Request' )
        }, 'HTTP::Response' ),
        '_msg' => 'Found',
        'handlers' => {
          'response_data' => [
            {
              'callback' => sub { "DUMMY" }
            },
            {
              'callback' => $VAR1->{'_previous'}{'_previous'}{'_previo
+us'}{'_previous'}{'handlers'}{'response_data'}[1]{'callback'}
            }
          ]
        },

[download]
To point out the difference between the two, the first dump has no '_previous' blessed reference but the second one has multiple nested ones, which I believe is some sort of callbacks? Please correct me if I'm wrong. Regardless, in the second instance I cannot seem to do $response->headers('Cookies'), which always returns undef but if you see the dump the cookies are there. Why does the second output have some many callbacks (I'm not specifically adding any) & what is probably going on here? Any suggestions? Thanks.

Replies are listed 'Best First'.
Re: LWP & callbacks
by Anonymous Monk on Jun 22, 2010 at 22:13 UTC
[reply]
      I got that idea by looking at the "handlers" section of the second dump: 
      'handlers' => {
          'response_data' => [
            {
              'callback' => sub { "DUMMY" }
            },
            {
              'callback' => $VAR1->{'_previous'}{'_previous'}{'_previo
+us'}{'_previous'}{'handlers'}{
+'response_data'}[1]{'callback'}
            }

      [download]
      But I guess you pointed out my mistake. But regardless here is the code what I am trying out: 
      use LWP;
use Data::Dumper;

# Login & get DSID cookie
my $ua = new LWP::UserAgent;
my $url = 'https://jt-sa-01/dana-na/auth/url_admin/login.cgi';

my $req = HTTP::Request->new(POST => $url);
$req->content_type('application/x-www-form-urlencoded');
$req->content('username=admindb&password=dana123&realm=Admin%20Users')
+;
my $res = $ua->request($req);
print Dumper($res);

      [download]

      The same code when I use it standalone, I get the first style of output but when I use same code snippet in an internal framework we have (this piece of code is called as an object method), I get the second style of output that I posted.

      So I guess, what I wanted to know is why is that the same piece of code in two different place is generating two different styles of output.
[reply]
[d/l]
[select]
        So I guess, what I wanted to know is why is that the same piece of code in two different place is generating two different styles of output.

        Because there is a difference :)

[reply]
Re: LWP & callbacks
by rovingeyes (Sexton) on Jun 23, 2010 at 18:31 UTC
    Well, I sorta found a solution for the problem - wrote a simple recursive function that keeps on doing $res->previous to check if the _previous exists & then finally returns the required response blessed reference back. This still does not address my original question - why is it happening & how can I debug/figure out what is going on. So if anyone has any input regarding that, please chime in.
[reply]
      But, if I try to take the same piece of code & plug it into our framework as a class method & invoke it on the same machine, the response is little bit different:

      Your answer lies there. Your unnamed, unguessable framework is doing something wonky with your unshown code. If you show what you're doing, you're more likely to get help. Right now, unless someone happens to have have exactly the same experience, you probably have a better chance of winning the lottery. :)

[reply]

Back to Seekers of Perl Wisdom