File Coverage

blib/lib/WWW/Shorten/Yourls.pm

Criterion	Covered	Total	%
statement	85	207	41.0
branch	23	104	22.1
condition	12	84	14.2
subroutine	19	26	73.0
pod	10	10	100.0
total	149	431	34.5

package WWW::Shorten::Yourls;

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 $VERSION = '1.001';
$VERSION = eval $VERSION;

our @EXPORT = qw(new);

# _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 @_;

    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 server signature),
        ];
        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;
}

# _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'? '_yourls': '.yourls';
        $file .= '_test' if $ENV{YOURLS_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';
                $key = 'server' if $key eq 'base';
                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 (keys %{$args}) {
        my $lc_key = lc($key);
        $lc_key = 'username' if $lc_key eq 'user';
        $lc_key = 'server' if $lc_key eq 'base';
        next unless grep {$lc_key eq $_} @{$attrs};
        $href->{$lc_key} = $args->{$key};
    }
    my $server = $href->{server} ? $href->{server} : 'https://yourls.org/yourls-api.php';
    my $self = bless $href, $class;
    return $self->server($server);
}

sub clicks {
    my $self = shift;
    Carp::croak("You must tell us which server to use.") unless my $server = $self->server();

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

    my $url = $server->clone();
    my $params = {
        shorturl => $short_url,
        format => 'json',
        action => 'url-stats',
    };
    if (my $sig = $self->signature()) {
        $params->{signature} = $sig;
    }
    else {
        my $user = $self->username();
        my $pass = $self->password();
        unless ($user && $pass) {
            Carp::croak("Username and password required when not using a signature");
        }
        $params->{username} = $user;
        $params->{password} = $pass;
    }
    $url->query_form(%$params);
    return _json_request($url);
}

sub expand {
    my $self = shift;
    Carp::croak("You must tell us which server to use.") unless my $server = $self->server();

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

    my $url = $server->clone();
    my $params = {
        shorturl => $short_url,
        format => 'json',
        action => 'expand',
    };
    if (my $sig = $self->signature()) {
        $params->{signature} = $sig;
    }
    else {
        my $user = $self->username();
        my $pass = $self->password();
        unless ($user && $pass) {
            Carp::croak("Username and password required when not using a signature");
        }
        $params->{username} = $user;
        $params->{password} = $pass;
    }
    $url->query_form(%$params);
    return _json_request($url);
}

sub makealongerlink {
    my $self;
    if ($_[0] && blessed($_[0]) && $_[0]->isa('WWW::Shorten::Yourls')) {
        $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) eq 'HASH' and $res->{longurl};
    return $res->{longurl};
}

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

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

sub server {
    my $self = shift;
    return $self->{server} unless @_;
    my $val = shift;
    if (!defined($val) || $val eq '') {
        $self->{server} = undef;
        return $self;
    }
    elsif (blessed($val) && $val->isa('URI')) {
        $self->{server} = $val->clone();
        return $self;
    }
    elsif ($val && !ref($val)) {
        $self->{server} = URI->new(_trim($val));
        return $self;
    }

    Carp::croak("The server attribute must be set to a URI object");
}

sub shorten {
    my $self = shift;
    Carp::croak("You must tell us which server to use.") unless my $server = $self->server();

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

    my $url = $server->clone();
    my $params = {
        url => $long_url,
        format => 'json',
        action => 'shorturl',
    };
    if (my $sig = $self->signature()) {
        $params->{signature} = $sig;
    }
    else {
        my $user = $self->username();
        my $pass = $self->password();
        unless ($user && $pass) {
            Carp::croak("Username and password required when not using a signature");
        }
        $params->{username} = $user;
        $params->{password} = $pass;
    }
    $url->query_form(%$params);
    return _json_request($url);
}

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

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

1;   # End of WWW::Shorten::Yourls

__END__