Download to read offline
![• sub mcpan_query {
• my $modulename = shift;
• my $ua = LWP::UserAgent->new;
• my $req = HTTP::Request->new( 'POST',
"http://api.metacpan.org/v0/module/_search" );
• $req->header( 'Content-Type' => 'application/json' );
• $req->content(encode_json({
• query => { query_string => { query => $modulename, } },
• filter => { term => { status => 'latest', } },
• fields => [ 'release', 'author' ]
• }));
• my $res = $ua->request( $req );
• return $res->status_line unless $res->is_success;
• my $hits = decode_json $res->decoded_content;
• my @url = keys { map { 'https://metacpan.org/release/' . $_-
>{fields}->{author} . '/' . $_->{fields}->{release} => 1 } @{ $hits-
>{hits}->{hits} } };
• my $short_url = shorten(@url);
• return join ' ', @$short_url;
• }](https://image.slidesharecdn.com/weibobot-140407100053-phpapp02/75/Perl-API-18-2048.jpg)
Perl调用微博API实现自动查询应答
- 1.
- 3.
- 4.
- 5.
- 6.
- 7.
- 8.
- 9. Dancer -a weiboexp •package WeiboExp; • use Dancer ':syntax'; • use Dancer::Plugin::Deferred; • use Net::OAuth2::Client; • get '/user/login' => sub { • redirect &client->authorize; • }; • true;
- 10. • sub client{ • Net::OAuth2::Profile::WebServer->new( • name => 'weibo', • site => 'https://api.weibo.com', • client_id => config->{app_key}, • client_secret => config->{app_secret}, • authorize_path => '/oauth2/authorize', • access_token_path => '/oauth2/access_token', • access_token_method => 'POST', • token_scheme => 'uri-query:access_token', • redirect_uri => uri_for('/user/profile'), • ); • };
- 11. • get '/user/profile'=> sub { • my $session = &client->get_access_token(params->{code}); • deferred error => $session->error_description if $session->error; • my $uid_res = $session->get('/2/account/get_uid.json'); • if ( $uid_res->is_success ) { • my $uid = (decode_json $uid_res->decoded_content)->{'uid'}; • my $ushow_res = $session->get("/2/users/show.json?uid=${uid}"); • if ( $ushow_res->is_success ) { • my $user = decode_json $ushow_res->decoded_content; • session user => { name => $user->{'name'}, hdimg => $user- >{'profile_image_url'} }; • deferred success => sprintf "Welcome back, %s", $user->{name}; • template 'profile', { user => $user }; • } • } else { • deferred error => $uid_res->status_line . 'get_uid'; • redirect '/'; • }; • };
- 12. weiboexp/views/profile.tx • <img src="<:$user.avatar_large :>"/><br/> • 微博地址：<a href="http://weibo.com/<: $user.domain :>">http://weibo.com/<: $user.domain :></a><br/> • 签名档：<: $user.description :><br/> • 住址：<: $user.location :><br/> • 个人网站：<a href="<: $user.url :>"><: $user.url :></a><br/> • 最新微博：<: $user.status.text :>
- 13. Great, But whereis the bot?
- 14.
- 15.
- 16. • #!/usr/bin/env perl •use JSON; • use 5.010; • use HTTP::Request; • use LWP::UserAgent; • use URI::Escape qw(uri_escape); • # read from $session->access_token() • my $token = '2.00kSQGIB1Q6J9C3d32741b********'; • my $session = LWP::UserAgent->new; • my $api_base = 'https://api.weibo.com'; • while(1) { • get_mention(); • sleep 30; • };
- 17. • sub get_mention{ • my $mention_res = $session- >get("${api_base}/2/statuses/mentions.json?access_token=${token}"); • if ( $mention_res->is_success ) { • my $statuses = ( decode_json $mention_res->decoded_content )- >{'statuses'}; • my $regexstr = q(#cpan#); • for my $status ( @{ $statuses } ) { • my $mid = $status->{'id'}; • my $msg = $status->{'text'}; • if ( $msg =~ s{$regexstr}{}i and $msg =~ s{@ARGVs+?}{}i ) { • my $ret = uri_escape(mcpan_query($msg)); • my $create_res = $session- >post("${api_base}/2/comments/create.json?access_token=${token}&id=${ mid}&comment=${ret}"); • if ( $create_res->is_success and ! ( decode_json $create_res- >decoded_content )->{'error'} ) { • say "Create Comments OK!"; • } • } • } • } • }
- 18. • sub mcpan_query{ • my $modulename = shift; • my $ua = LWP::UserAgent->new; • my $req = HTTP::Request->new( 'POST', "http://api.metacpan.org/v0/module/_search" ); • $req->header( 'Content-Type' => 'application/json' ); • $req->content(encode_json({ • query => { query_string => { query => $modulename, } }, • filter => { term => { status => 'latest', } }, • fields => [ 'release', 'author' ] • })); • my $res = $ua->request( $req ); • return $res->status_line unless $res->is_success; • my $hits = decode_json $res->decoded_content; • my @url = keys { map { 'https://metacpan.org/release/' . $_- >{fields}->{author} . '/' . $_->{fields}->{release} => 1 } @{ $hits- >{hits}->{hits} } }; • my $short_url = shorten(@url); • return join ' ', @$short_url; • }
- 19. • sub shorten{ • my $url = shift; • my $shorten_res = $session- >get( "${api_base}/2/short_url/shorten.json?access_toke n=${token}&url_long=" . join('&url_long=', @{$url}) ); • if ( $shorten_res->is_success ) { • my $urls = ( decode_json $shorten_res- >decoded_content )->{'urls'}; • my @short_url = map { $_->{url_short} } @{$urls}; • return @short_url; • } else { • say $shorten_res->status_line; • } • }
- 20.
- 21. see More • https://github.com/CPAN-API/metacpan-developer •https://metacpan.org/pod/Net::OAuth2::Client • https://metacpan.org/pod/Search::Elasticsearch • http://www.elasticsearch.org/guide/ • http://open.weibo.com/wiki/授权机制说明 • http://open.weibo.com/wiki/微博API
- 22.