File Coverage

blib/lib/WWW/Shorten/ptl.pm

Criterion	Covered	Total	%
statement	18	18	100.0
branch			n/a
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	24	24	100.0

package WWW::Shorten::ptl;
use strict;
use warnings;
our $VERSION = '0.04';

use JSON::Any;
use Carp;
use URI;

use base qw/WWW::Shorten::generic Exporter/;

our @EXPORT = qw/makeashorterlink makealongerlink/;

sub new
{
  my ($cls, @prm)= @_;

  if ( @prm % 2 ) {
    croak "parameters should be HASH form";
  }

  my %org_prm = @prm;
  my %prm;
  for my $key (qw/apikey/) {
    if (exists $org_prm{$key}) {
      $prm{$key} = delete $org_prm{$key};
    }
  }
  if ( %org_prm ) {
    carp "unknown parameter keys:", join(",", keys %org_prm);
  }

	my $ua = __PACKAGE__->ua;
	$ua->requests_redirectable([]);
  bless { ua => $ua, %prm }, $cls;
}

sub apikey
{
	my $self = shift;
	if ( @_ ) {
		$self->{apikey} = shift;
	}
	$self->{apikey};
}

sub shorten
{
	my $self = shift;
	my $url = shift;

	my $apikey = $self->apikey;
	if ( !$apikey ) {
		croak "no API-Key has been set";
	}

	if ( !$url ) {
		carp "no url passed";
		return;
	}

	my $uri = URI->new("http://p.tl/api/api_simple.php");
	$uri->query_form(
			key => $apikey,
			url => $url,
		);


	my $res = $self->{ua}->get($uri->as_string);

	if (!$res->is_success) {
		carp "failed to request : ", $res->status_line;
		return;
	}

	JSON::Any->jsonToObj($res->content);
}

sub extract
{
	my $self = shift;

	my $url = shift;
	if (!$url) {
		carp "no url passed";
		return;
	}

	if ( !$self->_check_url($url) ) {
		carp "given url is not for p.tl : ", $url;
		return;
	}

	my $res = $self->{ua}->head($url);
	$res->header( "Location" );
}

sub _check_url
{
	my $self = shift;
	my $url = shift;

	scalar $url =~ m{^http://p\.tl/.+};
}

sub makeashorterlink
{
	my $url = shift;
	my $apikey = shift;

	if ( !$url ) {
		carp "no url passed";
		return;
	}

	if ( !$apikey ) {
		carp "no apikey passed";
		return;
	}

	my $res = WWW::Shorten::ptl->new(apikey => $apikey)->shorten($url);

	return if !$res;

	if ( $res->{status} ne "ok" ) {
		carp "request failed: ", $res->{status};
		return;
	}

	return $res->{short_url};
}

sub makealongerlink
{
	my $url = shift;

	if ( !$url ) {
		carp "no url passed";
		return;
	}

	WWW::Shorten::ptl->new->extract($url);
}

1;
__END__