URI圧縮サービスを叩くwrapper

URIShorten.pm

package URIShorten;

use strict;
use warnings;

use LWP::UserAgent;
use JSON::XS qw(decode_json);
use URI::Escape;

sub new
{
    my $class = shift;
	my $self = bless {}, $class;
	$self->init(@_);
	return $self;
}

sub init
{
	my($self, %args) = @_;

	$self->{ua} = LWP::UserAgent->new(
    	agent => 'Mozilla/1.0',
	);
	$self->{googl} = $args{googl};
	$self->{bitly} = $args{bitly};
	$self->{ptl}   = $args{ptl};
}	

sub shorten
{
	my($self,$longuri) = @_;
	return $self->bitly($longuri) if defined $self->{bitly};
	return $self->googl($longuri) if defined $self->{googl};
	return $self->ptl($longuri) if defined $self->{ptl};
	
	$self->uxnu($longuri);
}

sub bitly
{
	my($self,$longuri) = @_;
	return $longuri unless defined $self->{bitly};

	my $req = sprintf('https://api-ssl.bitly.com//v3/shorten?login=%s&apiKey=%s&longUrl=%s&format=txt',
    	$self->{bitly}{name},$self->{bitly}{key},uri_escape($longuri));
	$req .= "&domain=$self->{bitly}{domain}" if defined $self->{bitly}{domain};

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

	return $longuri unless ($res->is_success);

	my $body = $res->decoded_content;
	chomp $body;
	(defined($body) && length($body)) ? $body : $longuri;
}

=pod
sub bitly
{
	my($self,$longuri) = @_;
	return $longuri unless defined $self->{bitly};

	my $req = sprintf('https://api-ssl.bitly.com//v3/shorten?login=%s&apiKey=%s&longUrl=%s',
    	$self->{bitly}{name},$self->{bitly}{key},uri_escape($longuri));

	$req .= "&domain=$self->{bitly}{domain}" if defined $self->{bitly}{domain};

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

	return $longuri unless $res->is_success;
	my $data = eval{decode_json($res->decoded_content);};

	return $longuri unless defined $data;
	return $longuri unless defined $data->{data};
	return $longuri unless defined $data->{data}{url};
	
	$data->{data}{url};
}
=cut

sub googl
{
	my ($self,$longuri) = @_;
	return $longuri unless defined $self->{googl};
	
	my $res = $self->{ua}->post(
    	'https://www.googleapis.com/urlshortener/v1/url?key='.$self->{googl},
    	'Content-Type' => 'application/json',
    	Content => qq({"longUrl":"$longuri"})
	);
	
	return $longuri unless $res->is_success;
	my $data = eval{decode_json($res->decoded_content);};

	return $longuri unless defined $data;
	return $longuri unless defined $data->{id};
	
	$data->{id};
}

sub ptl
{
	my ($self,$longuri) = @_;
	return $longuri unless defined $self->{ptl};
	
	my $res = $self->{ua}->get('http://p.tl/api/api_simple.php?key='.$self->{ptl}.'&url='.uri_escape($longuri));
	
	return $longuri unless $res->is_success;

	my $data = eval{decode_json($res->decoded_content);};
	return $longuri unless defined $data;
	return $longuri unless defined $data->{status};
	return $longuri if $data->{status} ne 'ok';
	return $longuri unless defined $data->{short_url};

	$data->{short_url};

}

sub uxnu
{
	my ($self,$longuri) = @_;

	my $res = $self->{ua}->get('http://ux.nu/api/short?format=plain&url='.uri_escape($longuri));

	return $longuri unless $res->is_success;
	my $body = $res->decoded_content;
	chomp $body;
	(defined($body) && length($body)) ? $body : $longuri;
}
=pod
sub uxnu
{
	my ($self,$longuri) = @_;
	
	my $res = $self->{ua}->get('http://ux.nu/api/short?url='.uri_escape($longuri));

	return $longuri unless $res->is_success;

	my $data = eval{decode_json($res->decoded_content);};
	
	return $longuri unless defined $data;
	return $longuri unless defined $data->{data};
	return $longuri unless defined $data->{data}{url};

	$data->{data}{url};

}
=cut

1;

=pod
=head1 NAME
 
URIShorten  shortend URI.
 
=head1 SYNOPSIS

use URIShorten;

my $u = URIShorten->new(
    bitly => {
      name=>'user name',
      key=>'bitly API Key',
      domain=>'j.mp',
    },
    googl => 'Google API key',
    ptl => 'p.tl api key',
);

my $short_url =  $u->shorten('http://www.google.com');

=head1 DESCRIPTION

The C<URIShorten> is a wrapper library for some uri-shorten Web APIs.

This code supports I<bit.ly>,I<goo.gl>,I<p.tl> and I<ux.nu>.

=head1 CONSTRUCTOR METHODS
=over 4
=item $u = URIShorten->new(%params);

This method constructs a new C<URIShorten> object and returns it.
Key/valur pair is Web API Keys.

=back
=head1 METHODS
=over 4
=item $u->shorten($longuri);
Get shorten URI.

=item $u->bitly($longuri);
=item $u->googl($longuri);
=item $u->ptl($longuri);
=item $u->uxnu($longuri);
Get shorten URI by specific web service.

=head1 GET API Key
=over 4
=item bit.ly
http://bitly.com/a/your_api_key
=item goo.gl
https://code.google.com/apis/console#access
=item p.tl
http://p.tl/api.php
=back

=cut