Net::Twitter::API - Moose sugar for defining Twitter API methods

  package My::Twitter::API;
  use Moose::Role;
  use Net::Twitter::API;

  use namespace::autoclean;

  has apiurl => ( isa => 'Str', is => 'rw', default => 'http://twitter.com' );

  base_url 'apiurl';

  twitter_api_method friends_timeline => (
      description => <<'',
  Returns the 20 most recent statuses posted by the authenticating user
  and that user's friends. This is the equivalent of /home on the Web.

      aliases   => [qw/following_timeline/],
      path      => 'statuses/friends_timeline',
      method    => 'GET',
      params    => [qw/since_id max_id count page/],
      required  => [],
      returns   => 'ArrayRef[Status]',
  );

  1;

package Net::Twitter::API;
use Moose ();
use Carp;
use Moose::Exporter;
use URI::Escape;
use DateTime::Format::Strptime;

use namespace::autoclean;

Moose::Exporter->setup_import_methods(
    with_caller => [ qw/base_url authenticate datetime_parser twitter_api_method/ ],
);

my $_base_url;
sub base_url { $_base_url = $_[1] }

# kludge: This is very transient!
my $do_auth;
sub authenticate { $do_auth = $_[1] }

# provide a default: we'll use the format of the REST API
my $datetime_parser = DateTime::Format::Strptime->new(pattern => '%a %b %d %T %z %Y');
sub datetime_parser { $datetime_parser = $_[1] }

sub twitter_api_method {
    my $caller = shift;
    my $name   = shift;
    my %options = (
        authenticate    => $do_auth,
        datetime_parser => $datetime_parser,
        base_url_method => $_base_url,
        @_,
    );

    my $class = Moose::Meta::Class->initialize($caller);

    my ($arg_names, $path) = @options{qw/required path/};
    $arg_names = $options{params} if @$arg_names == 0 && @{$options{params}} == 1;

    my $code = sub {
        my $self = shift;

        # copy callers args since we may add ->{source}
        my $args = ref $_[-1] eq 'HASH' ? { %{pop @_} } : {};

        # flatten array arguments
        for ( qw/user_id screen_name/ ) {
            $args->{$_} = join ',' => @{ $args->{$_} } if ref $args->{$_} eq 'ARRAY';
        }

        croak sprintf "$name expected %d args", scalar @$arg_names if @_ > @$arg_names;

        # promote positional args to named args
        for ( my $i = 0; @_; ++$i ) {
            my $param = $arg_names->[$i];
            croak "duplicate param $param: both positional and named"
                if exists $args->{$param};

            $args->{$param} = shift;
        }

        $args->{source} ||= $self->source if $options{add_source};

        # save synthetic arguments; don't pass them to Twitter
        my $synthetic_args = $self->_extract_synthetic_args($args);

        my $authenticate = exists $synthetic_args->{authenticate}
                         ? $synthetic_args->{authenticate}
                         : $options{authenticate}
                         ;

        # promote boolean parameters
        for my $boolean_arg ( @{ $options{booleans} } ) {
            if ( exists $args->{$boolean_arg} ) {
                next if $args->{$boolean_arg} =~ /^true|false$/;
                $args->{$boolean_arg} = $args->{$boolean_arg} ? 'true' : 'false';
            }
        }

        # Workaround Twitter bug: any value passed for skip_user is treated as true.
        # The only way to get 'false' is to not pass the skip_user at all.
        delete $args->{skip_user} if exists $args->{skip_user} && $args->{skip_user} eq 'false';

        # replace placeholder arguments
        my $local_path = $path;
        $local_path =~ s,/:id$,, unless exists $args->{id}; # remove optional trailing id
        $local_path =~ s/:(\w+)/delete $args->{$1} or croak "required arg '$1' missing"/eg;

        my $uri = URI->new($self->${ \$options{base_url_method} } . "/$local_path.json");

        return $self->_json_request(
            $options{method},
            $uri,
            $args,
            $authenticate,
            $synthetic_args,
            $options{datetime_parser},
        );
    };

    $class->add_method(
        $name,
        Net::Twitter::Meta::Method->new(
            name         => $name,
            package_name => $caller,
            body         => $code,
            %options,
        ),
    );

    $class->add_method($_, $code) for @{$options{aliases} || []};
}

package Net::Twitter::Meta::Method;
use Moose;
use Carp;
extends 'Moose::Meta::Method';

use namespace::autoclean;

has description => ( isa => 'Str', is => 'ro', required => 1 );
has aliases     => ( isa => 'ArrayRef[Str]', is => 'ro', default => sub { [] } );
has path        => ( isa => 'Str', is => 'ro', required => 1 );
has method      => ( isa => 'Str', is => 'ro', default => 'GET' );
has add_source  => ( isa => 'Bool', is => 'ro', default => 0 );
has params      => ( isa => 'ArrayRef[Str]', is => 'ro', default => sub { [] } );
has required    => ( isa => 'ArrayRef[Str]', is => 'ro', default => sub { [] } );
has returns     => ( isa => 'Str', is => 'ro', predicate => 'has_returns' );
has deprecated  => ( isa => 'Bool', is => 'ro', default => 0 );
has booleans    => ( isa => 'ArrayRef[Str]', is => 'ro', default => sub { [] } );
has authenticate => ( isa => 'Bool', is => 'ro', required => 1 );
has datetime_parser => ( is => 'ro', required => 1 );
has base_url_method => ( isa => 'Str', is => 'ro', required => 1 );

# TODO: can MooseX::StrictConstructor be made to work here?
my %valid_attribute_names = map { $_->init_arg => 1 }
                            __PACKAGE__->meta->get_all_attributes;

sub new {
    my $class = shift;
    my %args  = @_;

    my @invalid_attributes = grep { !$valid_attribute_names{$_} } keys %args;
    croak "unexpected argument(s): @invalid_attributes" if @invalid_attributes;

    $class->SUPER::wrap(@_);
}

1;

__END__