WWW::Shorten::Qwer - Perl interface to qwer.org

WWW-Shorten-Qwer documentation Contained in the WWW-Shorten-Qwer distribution.

Index

Code Index:

NAME

Top

WWW::Shorten::Qwer - Perl interface to qwer.org

SYNOPSIS

Top

  use WWW::Shorten::Qwer;
  use WWW::Shorten 'Qwer';

  $short_url = makeashorterlink($long_url, $short_code);

  $long_url  = makealongerlink($short_url);

DESCRIPTION

Top

A Perl interface to the web site qwer.org. Qwer simply maintains a database of long URLs, each of which has a unique identifier.

Functions

Top

The function makeashorterlink will call the Qwer web site passing it your long URL and a mandatory short code. It will return the shorter Qwer version of the URL.

The function makealongerlink does the reverse. makealongerlink will accept as an argument either the full Qwer URL or just the Qwer identifier.

If anything goes wrong, then either function will return undef.

EXPORT

makeashorterlink, makealongerlink

SUPPORT, LICENCE, THANKS and SUCH

Top

See the main WWW::Shorten docs.

AUTHOR

Top

Dave Cross <dave@mag-sol.com>

SEE ALSO

Top

WWW::Shorten, perl, http://qwer.org/

WWW-Shorten-Qwer documentation Contained in the WWW-Shorten-Qwer distribution. 
# $Id$


package WWW::Shorten::Qwer;

use 5.006;
use strict;
use warnings;

use base qw( WWW::Shorten::generic Exporter );
our @EXPORT = qw( makeashorterlink makealongerlink );
our $VERSION = '1.00';

use Carp;


sub makeashorterlink ($$)
{
    my $url = shift or croak 'No URL passed to makeashorterlink';
    my $code = shift or croak 'No short code passed to makeashorterlink';

    my $ua = __PACKAGE__->ua();
    my $qwer = 'http://qwer.org/submit';
    my $resp = $ua->post($qwer, [
	name => $code,
	data => $url,
	]);
    return unless $resp->is_redirect;
    my $content = $resp->content;

    if (my $redir = $resp->header('Location')) {
        return $redir;
    }

    return;
}


sub makealongerlink ($)
{
    my $qwer_url = shift 
	or croak 'No Qwer key / URL passed to makealongerlink';
    my $ua = __PACKAGE__->ua();

    $qwer_url = "http://qwer.org/$qwer_url"
        unless $qwer_url =~ m!^http://!i;

    my $resp = $ua->get($qwer_url);

    return unless $resp->is_success;
    my $content = $resp->content;
    my ($url) = $content =~ m|^(\w+://.*)</td|m;

    return $url;
}

1;

__END__