Error code 302 from HTTP POST operation - perl

I have a perl script that posts data to the web service that I wrote in php ...
This is the code:
use LWP::UserAgent;
my $ua = LWP::UserAgent->new;
my $server_endpoint = "http://example.com/";
my $req = HTTP::Request->new(POST => $server_endpoint);
$req->header('content-type' => 'application/json');
$req->header('x-auth-token' => 'kfksj48sdfj4jd9d');
# add POST data to HTTP request body
my $post_data = '{ "name": "Dan", "address": "NY" }';
$req->content($post_data);
my $resp = $ua->request($req);
if ($resp->is_success) {
my $message = $resp->decoded_content;
print "Received reply: $message\n";
}
else {
print "HTTP POST error code: ", $resp->code, "\n";
print "HTTP POST error message: ", $resp->message, "\n";
}
When I send the request, I get this response:
HTTP POST error code: 302
HTTP POST error message: Found
Questions:
How can I get rid of this error or is this even an error though it's says Found ?
How can I get the return value of the post?
What is the right way to post data ? (The code above is copied from this site.
My php site gets the post data and echo or just print it as return.)
Thanks in advance .

A 302 error from a server is a redirection instruction to the client. If you are using the default configuration of LWP::UserAgent, it will automatically follow redirects up to a maximum of seven times. If you are not getting a successful response, it suggests that either you've got redirects turned off (which looks unlikely from the code you've posted, unless you've omitted some configuration details for LWP::UserAgent), or that you're getting stuck in a redirect loop.
You can examine the redirection data by checking the HTTP::Response object:
my $resp = $ua->request($req);
# check for success, etc.
...
if ($resp->is_redirect) {
# check the number of redirects that the script has made:
say "n redirects: " . $resp->redirects;
}
With the default LWP::UA settings, seven is the maximum number of redirects you'll get before LWP::UA gives up.
More details on the redirects is available by calling $resp->redirects in array context:
# #redirects is an array of HTTP::Response objects
my #redirects = $resp->redirects;
# print out the 'location' header for each Response object to track the redirection:
say "Location: " . $_->header('location') for #redirects;
# or, for more comprehensive troubleshooting, print out the whole response:
say "Response: " . $_->as_string for #redirects;
Example output for a request to google.com, which redirects once:
# say "n redirects: " . $resp->redirects;
n redirects: 1
# say "Location: " . $_->header('location') for #redirects;
Location: http://www.google.co.uk/?gfe_rd=cr&ei=1bg3VJikJ_HH8gfOk4GwDw
# say "Response: " . $_->as_string for #redirects;
Response: HTTP/1.1 302 Found
Cache-Control: private
Connection: close
Date: Fri, 10 Oct 2014 10:45:41 GMT
Location: http://www.google.co.uk/?gfe_rd=cr&ei=1bg3VJikJ_HH8gfOk4GwDw
Server: GFE/2.0
Content-Length: 261
Content-Type: text/html; charset=UTF-8
Alternate-Protocol: 80:quic,p=0.01
Client-Date: Fri, 10 Oct 2014 10:45:39 GMT
Client-Peer: 74.125.230.102:80
Client-Response-Num: 1
Title: 302 Moved
<HTML><HEAD><meta http-equiv="content-type" content="text/html;charset=utf-8">
<TITLE>302 Moved</TITLE></HEAD><BODY>
<H1>302 Moved</H1>
The document has moved
here.
</BODY></HTML>
My guess is that you've got stuck in a redirect loop, and that is why you're not getting the expected response back from your PHP script.
NB: to enable say and other useful features from Perl 5.10 and later, put
use feature ':5.10';
at the top of your script after use strict; use warnings;.

Related

Using KeyForge API with Perl

I'm trying to call the KeyForge API with a simple Perl program but it doesn't work. I'm using what's in the LWP::UserAgent documentation:
use strict;
use warnings;
use LWP::UserAgent ();
my $ua = LWP::UserAgent->new;
my $response = $ua->get('https://www.keyforgegame.com/api/decks/');
if ($response->is_success) {
print $response->decoded_content;
}
else {
die $response->status_line;
}
The program prints:
500 write failed: at test.pl line 16.
If I use the URL https://www.google.com or http://www.example.com, it works. The HTML is correctly displayed.
If I use this simple PowerShell program, it works too:
$Url = "https://www.keyforgegame.com/api/decks/"
$decks = Invoke-RestMethod ($url)
$decks
It displays:
count data
743719 {#{name=Dr. "The Old" Jeffries; expansion=341; power_level=0; chains=0; wins=0; losses=0; id=ec86db52-e41e-4e...
What am I missing?
PS: I'm using Perl 5.16.3 on Windows 10.
EDIT:
Thank you all for your help. I finally found out what was happening. It turns out I had a very old version of Net::HTTP (from 2013). I upgraded it and now it works out of the box, without configuring agent, cookies or e-mail. The error message I had was actually from the client and not from the server.
$ perl -MLWP::UserAgent -e'
my $ua = LWP::UserAgent->new();
my $response = $ua->get("https://www.keyforgegame.com/api/decks/");
print $response->as_string;
'
HTTP/1.1 403 Forbidden
...
Content-Type: text/html; charset=UTF-8
...
<!DOCTYPE html>
...
<title>Access denied | www.keyforgegame.com used Cloudflare to restrict access</title>
...
<h2 data-translate="what_happened">What happened?</h2>
<p>The owner of this website (www.keyforgegame.com) has banned your access based on your browser's signature (4bfe0c0e2e86ab84-ua22).</p>
...
But,
$ perl -MLWP::UserAgent -e'
use version; our $VERSION = qv("v1.0.0");
my $ua = LWP::UserAgent->new(
agent => "NameOfTool/$VERSION",
from => q{me#example.com},
);
my $response = $ua->get("https://www.keyforgegame.com/api/decks/");
print $response->as_string;
'
HTTP/1.1 200 OK
...
Content-Type: application/json
...
{"count":...
If they want to block you, they can. So it's your best interest to provide a unique application name, a proper version and a valid email address (even if providing junk for the agent and leaving out from field works). This gives them more options to resolve any issues they have with your program.

Sending Post Data via LWP (Request built by HTTP::Request) for Spotify API

See: https://developer.spotify.com/web-api/authorization-guide/
I'm using the "client credentials flow" method.
sub get_token {
my $req = HTTP::Request->new(POST => $SPOTIFY_TOKEN);
$req->header('Authorization' => 'Basic MYBASE64HERE');
my $post_data = 'grant_type=client_credentials';
$req->content($post_data);
my $resp = $ua->request($req); #this is LWP
if ($resp->is_success) {
my $token = $resp->decoded_content;
print "$token\n";
return \$token;
}
else {
print "HTTP POST error code: ", $resp->code, "\n";
print "HTTP POST error message: ", $resp->message, "\n";
}
}
I get back HTTP POST error code: 400 / bad request
I know that it doesn't have to do with the header information or the URL. I tested via Curl and used Data::Dumper to verify it was formatted properly.
I'm not sure on the format I need to send the POST body data. I've tried the example above my $post_data = 'grant_type=client_credentials'; as well as every variation I could think of. Is there a proper way to do this in Perl using HTPP::Request to build the POST request?
I think following should work, Please try:
$req->content(grant_type => 'client_credentials');
my $post_data = "grant_type=client_credentials";
Turns out this is the answer. I'm not sure how I missed this previously.

Mailchimp v3.0 API, using Perl Curl

I'm trying to find a way to do a Curl request to MailChimps new API v3.0, that will subscribe a user to a given list. Here is what I have thus far:
use warnings;
use WWW::Curl::Easy;
use JSON;
my $apikey = 'xxxx';
my $listid = 'xxxx';
my $email = 'andy#test.co.uk';
my $endpoint = "https://us6.api.mailchimp.com/3.0/lists";
my $json = JSON::encode_json([
'email_address' => $email,
'status' => 'pending',
'merge_fields' => [
'FNAME' => "andy",
'LNAME' => "newby"
]
]);
my $curl = WWW::Curl::Easy->new;
my $url = "$endpoint/$listid/members/" . Digest::MD5::md5(lc($email));
$curl->setopt(CURLOPT_HEADER,1);
$curl->setopt(CURLOPT_URL, $endpoint);
$curl->setopt(CURLOPT_USERPWD, 'user:' . $apikey);
$curl->setopt(CURLOPT_HTTPHEADER, ['Content-Type: application/json']);
$curl->setopt(CURLOPT_TIMEOUT, 10);
$curl->setopt(CURLOPT_CUSTOMREQUEST, 'PUT');
$curl->setopt(CURLOPT_SSL_VERIFYPEER, 0);
$curl->setopt(CURLOPT_POSTFIELDS, $json);
my $response_body;
$curl->setopt(CURLOPT_WRITEDATA,\$response_body);
# Starts the actual request
my $retcode = $curl->perform;
# Looking at the results...
if ($retcode == 0) {
print("Transfer went ok\n");
my $response_code = $curl->getinfo(CURLINFO_HTTP_CODE);
print "Received response: $response_body\n";
} else {
# Error code, type of error, error message
print "An error happened: $retcode ".$curl->strerror($retcode)." ".$curl->errbuf."\n";
}
The documentation is pretty scarce, due to it being a new API. Has anyone had any success with the MailChimp v3 API, for subscribing someone in Perl? (I'm also open to suggestions for command line curl requests... but everything I tried with regards to that, failed with "internal server errors" coming back from MailChimp, which wasn't very helpful)
UPDATE: As suggested below, I enabled verbose, and it now spits out:
Hostname was NOT found in DNS cache
Trying 184.86.100.251...
Connected to us6.api.mailchimp.com (184.86.100.251) port 443 (#0)
successfully set certificate verify locations:
CAfile: none CApath: /etc/ssl/certs
SSL connection using TLSv1.2 / ECDHE-RSA-AES128-GCM-SHA256
Server certificate:
subject: C=US; ST=GA; L=Atlanta; O=ROCKET SCIENCE GROUP; OU=Rocket Science Group; CN=*.api.mailchimp.com
start date: 2015-09-22 14:39:14 GMT
expire date: 2016-09-22 14:39:13 GMT
subjectAltName: us6.api.mailchimp.com matched
issuer: C=NL; L=Amsterdam; O=Verizon Enterprise Solutions; OU=Cybertrust; CN=Verizon Akamai SureServer CA G14-SHA2
SSL certificate verify ok.
Server auth using Basic with user 'user'
PUT /3.0/lists HTTP/1.1 Authorization: Basic xxxx Host: us6.api.mailchimp.com Accept: / Content-Type: application/json
Content-Length: 108
upload completely sent off: 108 out of 108 bytes < HTTP/1.1 405 Method Not Allowed
Server nginx is not blacklisted < Server: nginx < Content-Type: application/problem+json; charset=utf-8 < Content-Length: 253 <
X-Request-Id: 5f6ab08f-69e7-4c9b-b22a-91714331d5b7 < Link:
https://us6.api.mailchimp.com/schema/3.0/ProblemDetailDocument.json;
rel="describedBy" < Allow: GET, POST < Date: Tue, 13 Oct 2015 11:24:32
GMT < Connection: close < Set-Cookie: _AVESTA_ENVIRONMENT=prod; path=/
<
Closing connection 0 Transfer went ok Received response: HTTP/1.1 405 Method Not Allowed Server: nginx Content-Type:
application/problem+json; charset=utf-8 Content-Length: 253
X-Request-Id: 5f6ab08f-69e7-4c9b-b22a-91714331d5b7 Link:
https://us6.api.mailchimp.com/schema/3.0/ProblemDetailDocument.json;
rel="describedBy" Allow: GET, POST Date: Tue, 13 Oct 2015 11:24:32 GMT
Connection: close Set-Cookie: _AVESTA_ENVIRONMENT=prod; path=/
{"type":"http://kb.mailchimp.com/api/error-docs/405-method-not-allowed","title":"Method
Not Allowed","status":405,"detail":"The requested method and resource
are not compatible. See the Allow header for this resource's available
methods.","instance":""}
I'm not really sure what to make of that though :/
Working code: Thanks to TooMuchPete, I managed to get it going. For anyone who may come across this while trying to use the MailChimp API (3.0) in Perl, below is a working sample (you just need to replace the values of the email, name, api key, and list id);
use WWW::Curl::Easy;
use JSON;
use Digest::MD5;
my $apikey = 'xxxx-us6';
my $listid = 'xxxx';
my $email = 'andy#testr.co.uk';
my $endpoint = "https://us6.api.mailchimp.com/3.0/lists";
my $json = JSON::encode_json({
'email_address' => $email,
'status' => 'pending',
'merge_fields' => {
'FNAME' => "andy",
'LNAME' => "newby"
}
});
my $curl = WWW::Curl::Easy->new;
my $url = "$endpoint/$listid/members/" . Digest::MD5::md5(lc($email));
$curl->setopt(CURLOPT_HEADER,1);
$curl->setopt(CURLOPT_URL, $url);
$curl->setopt(CURLOPT_VERBOSE, 1);
$curl->setopt(CURLOPT_USERPWD, 'user:' . $apikey);
$curl->setopt(CURLOPT_HTTPHEADER, ['Content-Type: application/json']);
$curl->setopt(CURLOPT_TIMEOUT, 10);
$curl->setopt(CURLOPT_CUSTOMREQUEST, 'PUT');
$curl->setopt(CURLOPT_SSL_VERIFYPEER, 0);
$curl->setopt(CURLOPT_POSTFIELDS, $json);
# A filehandle, reference to a scalar or reference to a typeglob can be used here.
my $response_body;
$curl->setopt(CURLOPT_WRITEDATA,\$response_body);
# Starts the actual request
my $retcode = $curl->perform;
# Looking at the results...
if ($retcode == 0) {
print("Transfer went ok\n");
my $response_code = $curl->getinfo(CURLINFO_HTTP_CODE);
# judge result and next action based on $response_code
print "Received response: $response_body\n";
} else {
# Error code, type of error, error message
print "An error happened: $retcode ".$curl->strerror($retcode)." ".$curl->errbuf."\n";
}
I hope this saves someone the grief I had :)
You're attempting to connect to $endpoint instead of $url.
my $url = "$endpoint/$listid/members/" . Digest::MD5::md5(lc($email));
$curl->setopt(CURLOPT_HEADER,1);
$curl->setopt(CURLOPT_URL, $endpoint);
should be:
my $url = "$endpoint/$listid/members/" . Digest::MD5::md5(lc($email));
$curl->setopt(CURLOPT_HEADER,1);
$curl->setopt(CURLOPT_URL, $url);
I received an illegal characters response from MailChimp using the code above until I switched to the md5_base64() call.

Form a CURL request to PayMill in Perl

I'm out of my depth with curl.
I want to integrate PayMill into my site (which is written in Perl).
There isn't a Perl lib for Paymill yet, so I need to connect to them via curl.
I have completed the front end JS Paymill integration, and received a payment token from PayMill.
I now need to pass the token received from Paymill to my backend and use curl to ask PayMill to complete the transaction and charge the user.
At this point I'm stuck.
To make a transaction, the PayMill documentation says that I must do the following:
curl https://api.paymill.de/v2/transactions \
-u b94a7550bd908877cbae5d3cf0dc4b74: \
-d "amount=4200" \
-d "currency=EUR" \
-d "token=098f6bcd4621d373cade4e832627b4f6" \
-d "description=Test Transaction"
I believe -u is the Paymill secret key to authenticate my request although the documentation is not clear here.
I've had a look at WWW::Curl::Easy, Net:Curl::Easy and LWP::Curl, however nothing in the documentation for those methods makes it obvious to me how to form the query above.
I've tried (without really believing it would work), simply encoding a string in perl as described above;
my $request = '-u ' . $private_key . " ";
foreach my $key (keys %$params_in) {
$request .= '-d "' . lc($key) .'='.$params_in->{$key} . ' ';
}
And then passing $request to my attempt at curl as follows;
my $curl = WWW::Curl::Easy->new;
$curl->setopt(WWW::Curl::Easy::CURLOPT_HEADER(), 1);
$curl->setopt(WWW::Curl::Easy::CURLOPT_URL(), $paymill_server);
$curl->setopt(WWW::Curl::Easy::CURLOPT_POST(), 1);
$curl->setopt(WWW::Curl::Easy::CURLOPT_POSTFIELDS(), $request);
my $response;
$curl->setopt(WWW::Curl::Easy::CURLOPT_WRITEDATA(), \$response);
my $retcode = $curl->perform;
however that fails with an Access Denied error, which I assume is because Paymill is not finding my key because I'm messing up the Curl (assuming -u is supposed to be the secret_key).
I feel I'm missing something obvious here.
Could someone point me in the right direction re how to do this?
Thanks
UPDATE
Excellent answers, thanks everyone for your help, it's working now. I went with Matthias's solution in the end and the final complete solution for making a transaction looked as follows;
use LWP::UserAgent;
use MIME::Base64;
use JSON::XS;
my $ua = LWP::UserAgent->new;
$ua->default_header(Authorization => "Basic " . encode_base64(private_key));
my $response = $ua->post(https://api.paymill.de:443/v2/transactions , $params );
if ( $response->is_success ) {
my $obj = eval { decode_json $response->content } || {};
etc
}
Like other answers propose the best way would be using LWP::UserAgent for doing the requests.
Edit: Since PAYMILL is sending challenge responses since a while now I updated the code.
Since Paymill doesn't comply with RFC 2616, Section 14.47 (the API isn't sending a challenge response) LWP::UserAgent and similar are failing in sending a second request with the credentials. The solution is to "force" LWP::UserAgent to send the credentials with the first request by adding them as header:
use LWP::UserAgent;
use MIME::Base64;
my $ua = LWP::UserAgent->new;
# Use the following line no longer:
# $ua->default_header(Authorization => "Basic " . encode_base64("your PRIVATE key"))
$ua->credentials('api.paymill.de:443', '', 'YOUR PRIVATE KEY');
# Dumping only
use Data::Dumper;
print Dumper($ua->get("https://api.paymill.de:443/v2/clients"));
Disclosure: I work at Paymill.
I don't know if the authentication part with the user/password and your token is correct as I don't know what the 'Realm' is supposed to be. Still, have a go with LWP. It's not that I don't like Curl, I just don't know it, but I do know LWP.
use strict; use warnings;
use LWP::UserAgent;
my $ua = LWP::UserAgent->new;
$ua->credentials(
'api.paymill.de:80',
'Realm?',
'b94a7550bd908877cbae5d3cf0dc4b74'
);
my $response = $ua->post(
' https://api.paymill.de/v2/transactions',
{
amount => "4200",
currency => "EUR",
token => "098f6bcd4621d373cade4e832627b4f6",
description => "Test Transaction",
}
);
if ( $response->is_success ) {
print $response->decoded_content; # or whatever
} else {
die $response->status_line;
}
Edit: I read a little in the Paymill documentation. It says:
Authentication
Example
% curl https://api.paymill.de/v2/clients \
-u e73fa5e7b87620585b5ea5d73c4d23bb:
To authenticate at the Paymill API, you need the private key of your
test or live account. You have to use http basic access
authentification. Your key has to be set as the username. A password
isn’t required and you don’t have to insert one. But if you want, feel
free to insert an arbitrary string.
Note
Please keep your private keys secure and don’t pass them to anybody. These private keys have extreme secure information for
handling the transactions of your shop.
All your requests must be made via https. Requests which will be made in another way will fail. This is for security reasons of the
submitted data.
There is also a link to http://en.wikipedia.org/wiki/HTTP_Secure, which clears up the -u part pretty much I believe.
You can use LWP::Protocol::Net::Curl to integrate LWP and libcurl organically. Check this:
#!/usr/bin/env perl
use common::sense;
use Data::Printer;
use JSON::XS;
use LWP::Protocol::Net::Curl verbose => 1;
use LWP::UserAgent;
# create user agent
my $ua = LWP::UserAgent->new;
# POST request
my $res = $ua->post(
'https://b94a7550bd908877cbae5d3cf0dc4b74:#api.paymill.de/v2/transactions',
'Accept-Encoding' => 'gzip',
Content => {
amount => 4200,
currency => 'EUR',
token => '098f6bcd4621d373cade4e832627b4f6',
description => 'Test Transaction',
},
);
# parse received data
my $obj = eval { decode_json $res->content } // {};
# output
p $obj;
The output:
* About to connect() to api.paymill.de port 443 (#0)
* Trying 62.138.241.3...
* Connected to api.paymill.de (62.138.241.3) port 443 (#0)
* Connected to api.paymill.de (62.138.241.3) port 443 (#0)
* successfully set certificate verify locations:
* CAfile: /etc/ssl/certs/ca-certificates.crt
CApath: none
* SSL connection using RC4-SHA
* Server certificate:
* subject: OU=Domain Control Validated; OU=PositiveSSL Wildcard; CN=*.paymill.de
* start date: 2012-07
* expire date: 2013-10
* subjectAltName: api.paymill.de matched
* issuer: C=GB; S
* SSL certificate verify ok.
* Server auth using Basic with user 'b94a7550bd908877cbae5d3cf0dc4b74'
> POST /v2/transactions HTTP/1.1
Authorization: Basic Yjk0YTc1NTBiZDkwODg3N2NiYWU1ZDNjZjBkYzRiNzQ6
User-Agent: libwww-perl/6.04 libcurl/7.28.0 OpenSSL/1.0.0e zlib/1.2.3.4 libidn/1.22 libssh2/1.2.8
Host: api.paymill.de
Accept: */*
Accept-Encoding: gzip
Content-Length: 92
Content-Type: application/x-www-form-urlencoded
* upload completely sent off: 92 out of 92 bytes
< HTTP/1.1 200 OK
< Server: nginx
< Date: Wed, 09 Jan 2013 17:22:54 GMT
< Content-Type: application/json
< Transfer-Encoding: chunked
< Connection: close
< Set-Cookie: PHPSESSID=rmdo5a8c6u107gma28lotmmn24; path=/
< Expires: Thu, 19 Nov 1981 08:52:00 GMT
< Cache-Control: no-store, no-cache, must-revalidate, post-check=0, pre-check=0
< Pragma: no-cache
< X-Server: hrtt-frn5-de13
<
* Closing connection #0
Printing in line 28 of paymill.pl:
\ {
data {
amount 4200,
client {
created_at 1357752174,
description undef,
email undef,
id "client_85cb0bfc837f31c81015",
payment [],
subscription undef,
updated_at 1357752174
},
created_at 1357752174,
currency "EUR",
description "Test Transaction",
id "tran_c672daa0538e2a04e919",
livemode false,
origin_amount 4200,
payment {
card_holder undef,
card_type "visa",
client "client_85cb0bfc837f31c81015",
country undef,
created_at 1357752174,
expire_month 12,
expire_year 2014,
id "pay_2732689f44928301c769",
last4 1111,
type "creditcard",
updated_at 1357752174
},
preauthorization undef,
refunds undef,
status "closed",
updated_at 1357752174
},
mode "test"
}

How can I determine if a URL redirects?

If I have a URL (eg. http://www.foo.com/alink.pl?page=2), I want to determine if I am being redirected to another link. I'd also like to know the final URL (eg. http://www.foo.com/other_link.pl). Finally, I want to be able to do this in Perl and Groovy.
In Perl:
use LWP::UserAgent;
my $ua = LWP::UserAgent->new;
my $request = HTTP::Request->new( GET => 'http://google.com/' );
my $response = $ua->request($request);
if ( $response->is_success and $response->previous ) {
print $request->url, ' redirected to ', $response->request->uri, "\n";
}
Well, I know nothing about either Perl or groovy, so I'll give you an another from an HTTP point of view, and you'll have to adapt.
Normally, you make an HTTP request, and you get back some HTML text along with a response code. The response code for Success is 200. Any response code in the 300 range is some form of a redirect.
Referring to James's answer - sample HTTP session:
$ telnet www.google.com 80
HEAD / HTTP/1.1
HOST: www.google.com
HTTP/1.1 302 Found
Location: http://www.google.it/
Cache-Control: private
Content-Type: text/html; charset=UTF-8
Set-Cookie: ##############################
Date: Thu, 30 Oct 2008 20:03:36 GMT
Server: ####
Content-Length: 218
Using HEAD instead of GET you get only the header. "302" means a temporary redirection, "Location:" is where you are redirected to.
A quick & dirty groovy script to show the concepts -- Note, this is using java.net.HttpURLConnection
In order to detect the redirect, you have to use setFollowRedirects(false). Otherwise, you end up on the redirected page anyway with a responseCode of 200. The downside is you then have to navigate the redirect yourself.
URL url = new URL ('http://google.com')
HttpURLConnection conn = url.openConnection()
conn.followRedirects = false
conn.requestMethod = 'HEAD'
println conn.responseCode
// Not ideal - should check response code too
if (conn.headerFields.'Location') {
println conn.headerFields.'Location'
}
301
["http://www.google.com/"]
In Perl you can use LWP::Useragent for that. I guess the easiest way is to add a response_redirect handler using add_handler.
I think this will work for 301 redirects.
use LWP::UserAgent;
my $ua = LWP::UserAgent->new;
my $request = HTTP::Request->new( GET => 'http://google.com/' );
my $response = $ua->request($request);
if ( $response->is_redirect ) {
print $request->url . " redirected to location " . $response->header('Location') . "\n";
}