File Coverage

blib/lib/WWW/Shorten/Bitly.pm

Criterion	Covered	Total	%
statement	76	264	28.7
branch	13	122	10.6
condition	6	118	5.0
subroutine	21	35	60.0
pod	18	18	100.0
total	134	557	24.0

package WWW::Shorten::Bitly;

use strict;
use warnings;
use Carp ();
use File::HomeDir ();
use File::Spec ();
use JSON::MaybeXS;
use Path::Tiny qw(path);
use Scalar::Util qw(blessed);
use URI ();

use base qw( WWW::Shorten::generic Exporter );
our @EXPORT = qw(new version);

our $VERSION = '2.000';
$VERSION = eval $VERSION;

use constant BASE_BLY => $ENV{BITLY_API_URL} || 'https://api-ssl.bitly.com';

# _attr (private)
sub _attr {
    my $self = shift;
    my $attr = lc(_trim(shift) || '');
    # attribute list is small enough to just grep each time. meh.
    Carp::croak("Invalid attribute") unless grep {$attr eq $_} @{_attrs()};
    return $self->{$attr} unless @_;
    # unset the access_token if any other field is set
    # this ensures we're always connecting properly.
    $self->{access_token} = undef;
    my $val = shift;
    unless (defined($val)) {
        $self->{$attr} = undef;
        return $self;
    }
    $self->{$attr} = $val;
    return $self;
}

# _attrs (static, private)
{
    my $attrs; # mimic the state keyword
    sub _attrs {
        return [@{$attrs}] if $attrs;
        $attrs = [
            qw(username password access_token client_id client_secret),
        ];
        return [@{$attrs}];
    }
}

# _json_request (static, private)
sub _json_request {
    my $url = shift;
    Carp::croak("Invalid URI object") unless $url && blessed($url) && $url->isa('URI');
    my $ua = __PACKAGE__->ua();
    my $res = $ua->get($url);
    Carp::croak("Invalid response") unless $res;
    unless ($res->is_success) {
        Carp::croak($res->status_line);
    }

    my $content_type = $res->header('Content-Type');
    my $content = $res->decoded_content();
    unless ($content_type && $content_type =~ m{application/json}) {
        Carp::croak("Unexpected response: $content");
    }
    my $json = decode_json($content);
    Carp::croak("Invalid data returned: $content") unless $json;
    return $json->{data};
}

# _parse_args (static, private)
sub _parse_args {
    my $args;
    if ( @_ == 1 && ref $_[0] ) {
        my %copy = eval { %{ $_[0] } }; # try shallow copy
        Carp::croak("Argument to method could not be dereferenced as a hash") if $@;
        $args = \%copy;
    }
    elsif (@_==1 && !ref($_[0])) {
        $args = {single_arg => $_[0]};
    }
    elsif ( @_ % 2 == 0 ) {
        $args = {@_};
    }
    else {
        Carp::croak("Method got an odd number of elements");
    }
    return $args;
}

# _parse_config (static, private)
{
    my $config; # mimic the state keyword
    sub _parse_config {
        # always give back a shallow copy
        return {%{$config}} if $config;
        # only parse the file once, please.
        $config = {};
        my $file = $^O eq 'MSWin32'? '_bitly': '.bitly';
        $file .= '_test' if $ENV{BITLY_TEST_CONFIG};
        my $path = path(File::Spec->catfile(File::HomeDir->my_home(), $file));

        if ($path && $path->is_file) {
            my @lines = $path->lines_utf8({chomp => 1});
            my $attrs = _attrs();

            for my $line (@lines) {
                $line = _trim($line) || '';
                next if $line =~ /^\s*[;#]/; # skip comments
                $line =~ s/\s+[;#].*$//gm; # trim off comments
                next unless $line && $line =~ /=/; # make sure we have a =

                my ($key, $val) = split(/(?
                $key = lc(_trim($key) || '');
                $val = _trim($val);
                next unless $key && $val;
                $key = 'username' if $key eq 'user';
                next unless grep {$key eq $_} @{$attrs};
                $config->{$key} = $val;
            }
        }
        return {%{$config}};
    }
}

# _trim (static, private)
sub _trim {
    my $input = shift;
    return $input unless defined $input && !ref($input) && length($input);
    $input =~ s/\A\s*//;
    $input =~ s/\s*\z//;
    return $input;
}

sub new {
    my $class = shift;
    my $args;
    if ( @_ == 1 && ref $_[0] ) {
        my %copy = eval { %{ $_[0] } }; # try shallow copy
        Carp::croak("Argument to $class->new() could not be dereferenced as a hash") if $@;
        $args = \%copy;
    }
    elsif ( @_ % 2 == 0 ) {
        $args = {@_};
    }
    else {
        Carp::croak("$class->new() got an odd number of elements");
    }

    my $attrs = _attrs();
    # start with what's in our config file (if anything)
    my $href = _parse_config();
    # override with anything passed in
    for my $key (%{$args}) {
        my $lc_key = lc($key);
        $lc_key = 'username' if $lc_key eq 'user';
        next unless grep {$lc_key eq $_} @{$attrs};
        $href->{$lc_key} = $args->{$key};
    }
    return bless $href, $class;
}

sub access_token { return shift->_attr('access_token', @_); }

sub bitly_pro_domain {
    my $self = shift;
    $self->login() unless ($self->access_token);

    my $args = _parse_args(@_);
    my $link = $args->{domain} || $args->{url} || $args->{single_arg} || '';
    unless ($link) {
        Carp::croak("A domain parameter is required.\n");
    }

    my $url = URI->new_abs('/v3/bitly_pro_domain', BASE_BLY);
    $url->query_form(
        access_token => $self->access_token(),
        domain => $link,
        format => 'json',
    );
    return _json_request($url);
}

sub client_id { return shift->_attr('client_id', @_); }

sub client_secret { return shift->_attr('client_secret', @_); }

sub clicks {
    my $self = shift;
    $self->login() unless ($self->access_token);

    my $args = _parse_args(@_);
    my $link = $args->{link} || $args->{single_arg} || '';
    unless ($link) {
        Carp::croak("A link parameter is required.\n");
    }

    my $url = URI->new_abs('/v3/link/clicks', BASE_BLY);
    $url->query_form(
        access_token => $self->access_token(),
        link => $link,
        unit => $args->{unit} || 'day',
        units => $args->{units} || '-1',
        rollup => $args->{rollup}? 'true': 'false',
        timezone => $args->{timezone} || 'America/New_York',
        limit => $args->{limit} || 100,
        unit_reference_ts => $args->{unit_reference_ts} || 'now',
        format => 'json',
    );
    return _json_request($url);
}

sub clicks_by_day {
    my $self = shift;
    $self->login() unless ($self->access_token);

    my $args = _parse_args(@_);
    my $link = $args->{link} || $args->{single_arg} || '';
    unless ($link) {
        Carp::croak("A link parameter is required.\n");
    }
    $args->{unit} = 'day';
    $args->{units} = 7;
    $args->{link} = $link;
    return $self->clicks($args);
}

sub countries {
    my $self = shift;
    $self->login() unless ($self->access_token);

    my $args = _parse_args(@_);
    my $link = $args->{link} || $args->{single_arg} || '';
    unless ($link) {
        Carp::croak("A link parameter is required.\n");
    }

    my $url = URI->new_abs('/v3/link/countries', BASE_BLY);
    $url->query_form(
        access_token => $self->access_token(),
        link => $link,
        unit => $args->{unit} || 'day',
        units => $args->{units} || '-1',
        timezone => $args->{timezone} || 'America/New_York',
        limit => $args->{limit} || 100,
        unit_reference_ts => $args->{unit_reference_ts} || 'now',
        format => 'json',
    );
    return _json_request($url);
}

sub expand {
    my $self = shift;
    $self->login() unless ($self->access_token);

    my $args = _parse_args(@_);
    my $short_url = $args->{shortUrl} || $args->{URL} || $args->{url} || $args->{single_arg} || '';
    unless ($short_url) {
        Carp::croak("A shortUrl parameter is required.\n");
    }

    my $url = URI->new_abs('/v3/expand', BASE_BLY);
    $url->query_form(
        access_token => $self->access_token(),
        shortUrl => $short_url,
        hash => $args->{hash},
        format => 'json',
    );
    return _json_request($url);
}

sub info {
    my $self = shift;
    $self->login() unless ($self->access_token);
    my $args = _parse_args(@_);

    my $link = $args->{shortUrl} || $args->{single_arg} || '';
    unless ($link) {
        Carp::croak("A shortUrl parameter is required.\n");
    }

    my $url = URI->new_abs('/v3/info', BASE_BLY);
    $url->query_form(
        access_token => $self->access_token(),
        shortUrl => $link,
        hash => $args->{hash},
        expand_user => $args->{expand_user}? 'true': 'false',
        format => 'json',
    );
    return _json_request($url);
}

sub login {
    my $self = shift;
    return $self if $self->{access_token};

    my $username = $self->{username};
    my $password = $self->{password};
    my $id = $self->{client_id};
    my $secret = $self->{client_secret};
    my $url = URI->new_abs('/oauth/access_token', BASE_BLY);
    unless ($username && $password) {
        Carp::croak("Can't login without at least a username and password");
    }
    my $req = HTTP::Request->new(POST => $url);
    $req->header(Accept => 'application/json');
    if ($id && $secret) {
        $req->authorization_basic($id,$secret);
        my $content = URI->new();
        $content->query_form(
            grant_type=>'password',
            username=>$username,
            password=>$password,
        );
        $req->content($content->query());
    }
    else {
        $req->authorization_basic($username,$password);
    }
    my $ua = __PACKAGE__->ua();
    my $res = $ua->request($req);
    Carp::croak("Invalid response") unless $res;
    unless ($res->is_success) {
        Carp::croak($res->status_line);
    }

    my $content_type = $res->header('Content-Type');
    my $content = $res->decoded_content();
    if ($content_type && $content_type =~ m{application/json}) {
        my $json = decode_json($res->decoded_content());
        Carp::croak("Invalid data returned") unless $json;
        Carp::croak($content) unless ($json->{access_token});
        $content = $json->{access_token};
    }
    $self->access_token($content);
    return $self;
}

sub lookup {
    my $self = shift;
    $self->login() unless ($self->access_token);
    my $args = _parse_args(@_);

    my $link = $args->{url} || $args->{single_arg} || '';
    unless ($link) {
        Carp::croak("A url parameter is required.\n");
    }

    my $url = URI->new_abs('/v3/link/lookup', BASE_BLY);
    $url->query_form(
        access_token => $self->access_token(),
        link => $link,
        format => 'json',
    );
    return _json_request($url);
}

sub makeashorterlink {
    my $self;
    if ($_[0] && blessed($_[0]) && $_[0]->isa('WWW::Shorten::Bitly')) {
        $self = shift;
    }
    my $url = shift or Carp::croak('No URL passed to makeashorterlink');
    $self ||= __PACKAGE__->new(@_);
    my $res = $self->shorten(longUrl=>$url, @_);
    return $res->{url};
}

sub makealongerlink {
    my $self;
    if ($_[0] && blessed($_[0]) && $_[0]->isa('WWW::Shorten::Bitly')) {
        $self = shift;
    }
    my $url = shift or Carp::croak('No URL passed to makealongerlink');
    $self ||= __PACKAGE__->new(@_);
    my $res = $self->expand(shortUrl=>$url, @_);
    return '' unless ref($res->{expand}) eq 'ARRAY';
    for my $row (@{$res->{expand}}) {
        return $row->{long_url};
    }
    return '';
}

sub password { return shift->_attr('password', @_); }

sub referrers {
    my $self = shift;
    $self->login() unless ($self->access_token);
    my $args = _parse_args(@_);

    my $link = $args->{link} || $args->{single_arg} || '';
    unless ($link) {
        Carp::croak("A link parameter is required.\n");
    }

    my $url = URI->new_abs('/v3/link/referrers', BASE_BLY);
    $url->query_form(
        access_token => $self->access_token(),
        link => $link,
        unit => $args->{unit} || 'day',
        units => $args->{units} || -1,
        timezone => $args->{timezone} || 'America/New_York',
        limit => $args->{limit} || 100,
        unit_reference_ts => $args->{unit_reference_ts} || 'now',
        format => 'json',
    );
    return _json_request($url);
}

sub shorten {
    my $self = shift;
    $self->login() unless ($self->access_token);
    my $args = _parse_args(@_);

    my $long_url = $args->{longUrl} || $args->{single_arg} || $args->{URL} || $args->{url} || '';
    my $domain = $args->{domain} || undef;
    unless ($long_url) {
        Carp::croak("A longUrl parameter is required.\n");
    }

    my $url = URI->new_abs('/v3/shorten', BASE_BLY);
    $url->query_form(
        access_token => $self->access_token(),
        longUrl => $long_url,
        domain => $domain,
        format => 'json',
    );
    return _json_request($url);
}

sub username { return shift->_attr('username', @_); }


1; # End of WWW::Shorten::Bitly
__END__