view release on metacpan or  search on metacpan

examples/test-validate-json-body/app/lib/Dwarf/Module/SocialMedia/Facebook.pm  view on Meta::CPAN

	my $result = $self->call('method/fql.query', 'GET', {
		query => "SELECT uid2 FROM friend WHERE uid1 = me()"
	});
	$result = [] if ref $result ne 'ARRAY';

	return [ map { $_->{uid2} } @{ $result } ];
}

sub lookup_users {
	my ($self, $ids, $rows, $offset) = @_;
	$ids = join ',', @{ $ids };

	my $fql = "SELECT uid, name, pic_square FROM user WHERE uid IN";
	$fql .= " (" . $ids . ")";
	$fql .= " LIMIT $rows" if defined $rows;
	$fql .= " OFFSET $offset" if defined $offset;

	my $result = $self->call('method/fql.query', 'GET', { query => $fql });
	$result = [] if ref $result ne 'ARRAY';

	return @{ $result };
}

sub get_authorization_url {
	my ($self, %params) = @_;

	die 'key must be specified.' unless defined $self->key;
	die 'secret must be specified.' unless defined $self->secret;
	die "redirect_uri must be specified." unless defined $params{redirect_uri};

	$params{client_id} ||= $self->key;
	$params{scope}     ||= 'publish_stream,read_stream,user_photos,user_likes';

	my $uri = URI->new($self->urls->{authorization});
	$uri->query_form(%params);
	return $uri;
}

sub request_access_token {
	my ($self, %params) = @_;

	die 'key must be specified.' unless defined $self->key;
	die 'secret must be specified.' unless defined $self->secret;
	die "redirect_uri must be specified." unless defined $params{redirect_uri};
	die "code must be specified." unless defined $params{code};

	$params{client_id}     ||= $self->key;
	$params{client_secret} ||= $self->secret;

	my $uri = URI->new($self->urls->{access_token});
	$uri->query_form(%params);

	my $res = $self->ua->get($uri);

	if ($res->code !~ /^2/) {
		$self->on_error->('Facebook OAuth Error: Could not get access token.');
		return;
	}

	my $access_token = $res->decoded_content;
	$access_token =~ s/^access_token=//;
	$access_token =~ s/&expires=[0-9]+$//;

	$self->access_token($access_token);
}

sub _make_request {
	my ($self, $command, $method, $params) = @_;

	$method = uc $method;
	$params->{access_token} ||= $self->access_token;
	$params->{format}       ||= 'json';

	my $base_url = $command =~ /^method\//
			? $self->urls->{'old_api'}
			: $self->urls->{'api'};

	my $uri = URI->new($base_url . '/' . $command);
	$uri->query_form(%{ $params }) if $method =~ /^(GET|DELETE)$/;

	my %data = %{ $params };

	if ($method eq 'MULTIPART_POST') {
		$method = 'POST';
		my $source = $params->{source};
		delete $params->{source};
		$uri->query_form(%{ $params });
		%data = (
			Content_Type => 'multipart/form-data',
			Content      => [ source => $source ],
		);
	} elsif ($method eq 'POST') {
		%data = (Content => $params)
	}

	no strict 'refs';
	my $req = &{"HTTP::Request::Common::$method"}($uri, %data);
	$req->header("Content-Length", 0) if $method eq 'DELETE';

	return $req;
}

sub call {
	my ($self, $command, $method, $params) = @_;
	$self->authorized;
	my $req = $self->_make_request($command, $method, $params);
	my $res = $self->ua->request($req);
	return $self->validate($res);
}

sub call_async {
	my $self = shift;
	return if @_ == 0;

	$self->authorized;

	my @requests;
	for my $row (@_) {
		push @requests, $self->_make_request(@{ $row });
	}

	my @responses = $self->ua_async->request_in_parallel(@requests);

	my @contents;
	for my $res (@responses) {
		push @contents, $self->validate($res);
	}

	return @contents;
}

sub validate {
	my ($self, $res) = @_;
	my $content = eval { decode_json($res->decoded_content) };
	if ($@) {
		warn "Couldn't decode JSON: $@";
		$content = $res->decoded_content;
	}

	if ($res->code !~ /^2/) {
		if ($content) {
			if (ref $content) {
				my $error_code = $content->{error}->{code} // '';

				# 506 = 二重投稿
				if ($error_code eq '506') {
					warn 'Facebook API Error: ', $content->{error}->{message};
					return $content;
				}

				$self->on_error->($content->{error}->{message});
			} else {
				$self->on_error->($content);
			}
		}

		$self->on_error->("Invalid Response Header");
	}

	return $content;
}

sub parse_date {
	my ($self, $value) = @_;
	return DateTime::Format::HTTP
		->parse_datetime($value)
		->set_time_zone('Asia/Tokyo');
}

1;