File Coverage

lib/OAuthomatic/Types.pm

Criterion	Covered	Total	%
statement	1	3	33.3
branch			n/a
condition			n/a
subroutine	1	1	100.0
pod			n/a
total	2	4	50.0

## no critic (ProhibitMultiplePackages, RequireFilenameMatchesPackage, RequireUseWArnings, RequireUseStrict, RequireExplicitPackage)

=head1 NAME

OAuthomatic::Types - few helper types to make code more readable and less error-prone

=head1 DESCRIPTION

Types below are defined to make code a bit more readable and less error prone.

=cut

=head1 OAuthomatic::Types::StructCleaner

Role composed into types defined below. Handles some construction
conventions.

=over 4

=item *

Any empty or undef'ed values are dropped as if they were not specified at all.

=item *

If args C<data> and C<remap> are given, constructor can translate
field names, for example:

    Something->new(data=>{aaa=>'x', bbb=>'y'},
                   remap=>{aaa=>'token', 'bbb'=>'secret');

is equivalent to:

    Something->new(token=>'x', secret=>'y');

Partial replacements are possible too:

    Something->new(data=>{token=>'x', bbb=>'y'},
                   remap=>{'bbb'=>'secret');


=back

=cut

{
    package OAuthomatic::Types::StructCleaner;
    use Moose::Role;
    use OAuthomatic::Error;
    use namespace::sweep;

    around BUILDARGS => sub {
        my $orig  = shift;
        my $class = shift;
        my $ret = $class->$orig(@_);

        # Drop empty values  (FIXME: this is close to MooseX::UndefTolerant)
        foreach my $key (keys %$ret) {
            my $val = $ret->{$key};
            unless(defined($val) && $val =~ /./x) {
                delete $ret->{$key};
            }
        }

        # Remap names
        if(exists $ret->{remap}) {
            my $remap = $ret->{remap};
            my $data = $ret->{data} or
              OAuthomatic::Error::Generic->throw(
                  ident => "Bad call",
                  extra => "No data given in spite remap is specified");
            delete $ret->{remap};
            delete $ret->{data};
            my %data_unconsumed = %$data;  # To delete consumed keys
            foreach my $mapped (keys %$remap) {
                my $mapped_to = $remap->{$mapped};
                my $value = $data->{$mapped}
                  or OAuthomatic::Error::Generic->throw(
                      ident => "Missing parameter",
                      extra => "Missing $mapped (while constructing $class). Known keys: ") . join(", ", keys %$data) . "\n";
                delete $data_unconsumed{$mapped};
                $ret->{$mapped_to} = $value;
            }
            # Copy unmapped data verbatim
            while (my ($k, $v) = each %data_unconsumed) {
                $ret->{$k} = $v;
            }
        }
        return $ret;
    }
};

=head1 OAuthomatic::Types::ClientCred

Client (application) credentials. Fixed key and secret allocated manually
using server web interface (usually after filling some form with various
details) which identify the application.

=head2 ATTRIBUTES

=over 4

=item key

Client key - the application identifier.

=item secret

Client secret - confidential value used to sign requests, to prove key
is valid.

=back

=cut

{
    package OAuthomatic::Types::ClientCred;
    use Moose;
    with 'OAuthomatic::Types::StructCleaner';

    has 'key' => (is => 'ro', isa => 'Str', required => 1);
    has 'secret' => (is => 'ro', isa => 'Str', required => 1);

    sub as_hash {
        my ($self, $prefix) = @_;
        return (
           $prefix . '_key'     => $self->key,
           $prefix . '_secret' => $self->secret,
          );
    }

    sub equal {
        my ($class, $left, $right) = @_;
        if(defined($left)) {
            if(defined($right)) {
                ($left->isa($class) && $right->isa($class)) or
                  OAuthomatic::Error::Generic->throw(
                      ident => "Bad parameters", extra => "equal called for wrong object types");
                return ($left->key eq $right->key)
                  && ($left->secret eq $right->secret);
            } else {
                return '';
            }
        } else {
            return ! defined($right);
        }
    }
};

# Common implementation for two classes below
{
    package OAuthomatic::Types::GenericTokenCred;
    use Moose;
    with 'OAuthomatic::Types::StructCleaner';

    has 'token' => (is => 'ro', isa => 'Str', required => 1);
    has 'secret' => (is => 'ro', isa => 'Str', required => 1);

    sub as_hash {
        my $self = shift;
        return (
           token => $self->token,
           token_secret => $self->secret,
          );
    }

    sub equal {
        my ($class, $left, $right) = @_;
        if(defined($left)) {
            if(defined($right)) {
                ($left->isa($class) && $right->isa($class)) or
                  OAuthomatic::Error::Generic->throw(
                      ident => "Bad parameters", extra => "equal called for wrong object types");
                return ($left->token eq $right->token)
                  && ($left->secret eq $right->secret);
            } else {
                return '';
            }
        } else {
            return ! defined($right);
        }
    }
};

=head1 OAuthomatic::Types::TemporaryCred

Temporary (request) credentials. Used during process of allocating
token credentials.

=head2 ATTRIBUTES

=over 4

=item token

Actual token - identifier quoted in requests.

=item secret

Associated secret - confidential value used to sign requests, to prove they
are valid.

=item authorize_page

Full URL of the page end user should use to spend this temporary credential
and generate access token. Already contains the token.

=back

=cut
{
    package OAuthomatic::Types::TemporaryCred;
    use Moose;
    extends 'OAuthomatic::Types::GenericTokenCred';

    # This is rw and not required as we append it after initial object creation
    has 'authorize_page' => (is => 'rw', isa => 'URI', required => 0);
};


=head1 OAuthomatic::Types::TokenCred

Token (access) credentials. Those are used to sign actual API calls.

=cut

{
    package OAuthomatic::Types::TokenCred;
    use Moose;
    extends 'OAuthomatic::Types::GenericTokenCred';
};

=head1 OAuthomatic::Types::Verifier

Verifier info, returned from authorization.

=cut

{
    package OAuthomatic::Types::Verifier;
    use Moose;
    with 'OAuthomatic::Types::StructCleaner';

    has 'token' => (is => 'ro', isa => 'Str', required => 1);
    has 'verifier' => (is => 'ro', isa => 'Str', required => 1);

    sub equal {
        my ($class, $left, $right) = @_;
        if(defined($left)) {
            if(defined($right)) {
                ($left->isa($class) && $right->isa($class)) or
                  OAuthomatic::Error::Generic->throw(
                      ident => "Bad parameters", extra => "equal called for wrong object types");
                return ($left->token eq $right->token)
                  && ($left->verifier eq $right->verifier);
            } else {
                return '';
            }
        } else {
            return ! defined($right);
        }
    }
};

1;