The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package WWW::Shorten::Durl;

use 5.006;
use strict;
use warnings;
use Carp;

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

sub makeashorterlink ($) {
  my $url = shift or croak 'No URL passed to makeashorterlink';
  my $ua = __PACKAGE__->ua();
  my $durl = "http://durl.me/api/Create.do?longurl=$url";
  my $res = $ua->get($durl);
  return undef unless $res->is_success;
  my ($short_url) = $res->content =~ m!\[(http://durl.me/\w+)\]!;
  return $short_url;  
}

sub makealongerlink ($) {
  my $url = shift or croak 'No URL passed to makealongerlink';
  my ($key) = $url =~ m!http://durl.me/(\w+)!;
  my $durl = "http://durl.me/$key.status";
  my $ua = __PACKAGE__->ua();
  my $res = $ua->get($durl);
  return undef unless $res->is_success;
  my ($long_url) = $res->content =~ m/<url><\!\[CDATA\[([^<]+)\]\]><\/url>/;
  return $long_url;
}

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

  unless ($url =~ m/http%3A%2F%2Fdurl.me%2F/) {
      $url = makeashorterlink($url);
  }
  
  my ($key) = $url =~ m!http://durl.me/(\w+)!;
  return undef unless $key;
  
  my $ua = __PACKAGE__->ua();
  my $res = $ua->get("http://durl.me/$key.status");
  return undef unless $res->is_success;
  
  my ($image_url) = $res->content =~ m/<image-url-big><\!\[CDATA\[([^<]+)\]\]><\/image-url-big>/;
  return $image_url;
}

1;
__END__

=encoding utf-8

=head1 NAME

WWW::Shorten::Durl - Perl interface to durl.me

=head1 SYNOPSIS

  use WWW::Shorten::Durl;
  use WWW::Shorten 'Durl';
    
  $short_url = makeashorterlink($long_url);
  
  $long_url = makealongerlink($short_url);

  $image_url = WWW::Shorten::Durl::get_image($short_url);
  $image_url = WWW::Shorten::Durl::get_image($long_url);

=head1 DESCRIPTION

WWW::Shorten::Durl is a Perl interface to the web site durl.me, Durl maintains a database of long URLs, each of which has a unique identifier.

=head1 AUTHOR

JEEN Lee E<lt>aiatejin@gmail.comE<gt>

=head1 SEE ALSO

L<WWW::Shorten>, L<http://durl.kr/doc/OpenAPI.html>

=head1 LICENSE

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut