From 58ef90b2c07ca401a4e5e4c2d8bcf0edeea18c76 Mon Sep 17 00:00:00 2001 From: earth-tone Date: Tue, 4 Aug 2015 11:23:24 -0400 Subject: [PATCH 01/16] test --- README | 57 +-------------------------------------------------------- 1 file changed, 1 insertion(+), 56 deletions(-) diff --git a/README b/README index 1cc546b..8405060 100644 --- a/README +++ b/README @@ -1,57 +1,2 @@ -Reddit::Client -Reddit::Client provides a perl wrapper for the Reddit API, allowing -basic services such as login, retrieval of stories and comments, -voting, and publishing new links and comments. - -Please regard this software is beta. However, the following API calls -should function acceptably well: - - * Logging in - * Listing reddits - * Searching reddits - * Get links listing for reddits - * Voting - * Get/post comments - * Post link/self - * Save/unsave - * Hide/unhide - -TODO - - * Deleting submissions and comments - * Marking submissions as NSFW - * Sharing stories - * User registration - -INSTALLATION - -To install this module, run the following commands: - - perl Makefile.PL - make - make test - make install - -SUPPORT AND DOCUMENTATION - -After installing, you can find documentation for this module with the -perldoc command. - - perldoc Reddit::Client - -More information about this module may be found on github: - - https://github.com/jsober/Reddit-API - -This module is also available on CPAN: - - http://search.cpan.org/~jeffober/Reddit-Client/lib/Reddit/Client.pm - -LICENSE - -This program is free software; you can redistribute it and/or modify it -under the terms of either: the GNU General Public License as published -by the Free Software Foundation; or the Artistic License. - -See http://dev.perl.org/licenses/ for more information. +test From 5506e259ed1b4bc55bb8fd29c8cb501802427946 Mon Sep 17 00:00:00 2001 From: earth-tone Date: Tue, 4 Aug 2015 11:26:49 -0400 Subject: [PATCH 02/16] initial commit; adds get_subreddit_comments support --- README | 48 +++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 47 insertions(+), 1 deletion(-) diff --git a/README b/README index 8405060..c6d00b0 100644 --- a/README +++ b/README @@ -1,2 +1,48 @@ +Reddit::Client with Oauth support for the required switch on August 3, 2015. This version also contains a function to send private messages, and a bug fix that was preventing the me() function from working. The original Reddit::Client can be found here: https://github.com/jsober/Reddit-API. -test +Unlike the old username/password authentication where you could plug in any valid username/password, Reddit's Oauth authentication **will only work with accounts that have developer permission on the app**1. You can register an app and add developers on your preferences/apps page: https://www.reddit.com/prefs/apps. + + +# Usage + +``` +# Create Reddit::Client object +my $reddit = Reddit::Client->new( + session_file => 'session_data.json', + user_agent => 'myUserAgent v3.4', +); +my $client_id = "DFhtrhBgfhhRTd"; +my $secret = "KrDNsbeffdbILOdgbgSvSBsbfFs"; +my $username = "reddit-username"; +my $password = "reddit-password"; + +# Get token. +$reddit->get_token($client_id, $secret, $username, $password); + +############################################## +# Send private message +my $result = $reddit->send_message( + to => 'earth-tone', + subject => 'test', + text => 'i can haz PMs?' +); + +############################################## +# Get your account information +my $me = $reddit->me(); +use Data::Dumper; +print Dumper($me); +``` + +The authorization token lasts for 1 hour. If your script runs continuously for more than an hour, it will be refreshed before making the next request. + +While it is possible to get "permanent" tokens, that term is misleading because you still need to get a temporary token every time the script runs, which will also expire after an hour. They are intended for applications that are doing things on a user's behalf ("web" and "installed" app types). There is no benefit to supporting this for a "script" type app, and Reddit::Client didn't, so this doesn't, although I may add support if there is demand. + +# Installation +It can be run locally of course, or if you want to install it, you can just drop it into Perl's library directory, which is probably something like /usr/local/share/perl/5.14.2/Reddit. It can be dropped in on top of an existing Reddit::Client installation. + +--- + +1 For "script" type apps, which your Perl script presumably is if you were using the original Reddit::Client. "Script" type apps log into an account using a username and password. + +The other two app types are "web app" and "installed". They do things on behalf of a user without a password, and require a user to give them permission first. The best example is an Android app where you click "Allow" to let it act for your Reddit account, although you may have seen this type of confirmation before on a web page too (and that would be the "web app" type). Reddit::OauthClient doesn't support them, although I may add support if there is demand. From 84ce50453266c7b7e06bfd5e4a41706eafbc6c73 Mon Sep 17 00:00:00 2001 From: earth-tone Date: Tue, 4 Aug 2015 11:28:29 -0400 Subject: [PATCH 03/16] initial commit; adds get_subreddit_comments support --- README.md | 48 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 48 insertions(+) create mode 100644 README.md diff --git a/README.md b/README.md new file mode 100644 index 0000000..c6d00b0 --- /dev/null +++ b/README.md @@ -0,0 +1,48 @@ +Reddit::Client with Oauth support for the required switch on August 3, 2015. This version also contains a function to send private messages, and a bug fix that was preventing the me() function from working. The original Reddit::Client can be found here: https://github.com/jsober/Reddit-API. + +Unlike the old username/password authentication where you could plug in any valid username/password, Reddit's Oauth authentication **will only work with accounts that have developer permission on the app**1. You can register an app and add developers on your preferences/apps page: https://www.reddit.com/prefs/apps. + + +# Usage + +``` +# Create Reddit::Client object +my $reddit = Reddit::Client->new( + session_file => 'session_data.json', + user_agent => 'myUserAgent v3.4', +); +my $client_id = "DFhtrhBgfhhRTd"; +my $secret = "KrDNsbeffdbILOdgbgSvSBsbfFs"; +my $username = "reddit-username"; +my $password = "reddit-password"; + +# Get token. +$reddit->get_token($client_id, $secret, $username, $password); + +############################################## +# Send private message +my $result = $reddit->send_message( + to => 'earth-tone', + subject => 'test', + text => 'i can haz PMs?' +); + +############################################## +# Get your account information +my $me = $reddit->me(); +use Data::Dumper; +print Dumper($me); +``` + +The authorization token lasts for 1 hour. If your script runs continuously for more than an hour, it will be refreshed before making the next request. + +While it is possible to get "permanent" tokens, that term is misleading because you still need to get a temporary token every time the script runs, which will also expire after an hour. They are intended for applications that are doing things on a user's behalf ("web" and "installed" app types). There is no benefit to supporting this for a "script" type app, and Reddit::Client didn't, so this doesn't, although I may add support if there is demand. + +# Installation +It can be run locally of course, or if you want to install it, you can just drop it into Perl's library directory, which is probably something like /usr/local/share/perl/5.14.2/Reddit. It can be dropped in on top of an existing Reddit::Client installation. + +--- + +1 For "script" type apps, which your Perl script presumably is if you were using the original Reddit::Client. "Script" type apps log into an account using a username and password. + +The other two app types are "web app" and "installed". They do things on behalf of a user without a password, and require a user to give them permission first. The best example is an Android app where you click "Allow" to let it act for your Reddit account, although you may have seen this type of confirmation before on a web page too (and that would be the "web app" type). Reddit::OauthClient doesn't support them, although I may add support if there is demand. From 46b8f1ed4889b106b399f4a7e6840f7bb2056b9e Mon Sep 17 00:00:00 2001 From: earth-tone Date: Tue, 4 Aug 2015 11:28:54 -0400 Subject: [PATCH 04/16] initial commit; adds get_subreddit_comments support --- README | 48 ------------------------------------------------ 1 file changed, 48 deletions(-) delete mode 100644 README diff --git a/README b/README deleted file mode 100644 index c6d00b0..0000000 --- a/README +++ /dev/null @@ -1,48 +0,0 @@ -Reddit::Client with Oauth support for the required switch on August 3, 2015. This version also contains a function to send private messages, and a bug fix that was preventing the me() function from working. The original Reddit::Client can be found here: https://github.com/jsober/Reddit-API. - -Unlike the old username/password authentication where you could plug in any valid username/password, Reddit's Oauth authentication **will only work with accounts that have developer permission on the app**1. You can register an app and add developers on your preferences/apps page: https://www.reddit.com/prefs/apps. - - -# Usage - -``` -# Create Reddit::Client object -my $reddit = Reddit::Client->new( - session_file => 'session_data.json', - user_agent => 'myUserAgent v3.4', -); -my $client_id = "DFhtrhBgfhhRTd"; -my $secret = "KrDNsbeffdbILOdgbgSvSBsbfFs"; -my $username = "reddit-username"; -my $password = "reddit-password"; - -# Get token. -$reddit->get_token($client_id, $secret, $username, $password); - -############################################## -# Send private message -my $result = $reddit->send_message( - to => 'earth-tone', - subject => 'test', - text => 'i can haz PMs?' -); - -############################################## -# Get your account information -my $me = $reddit->me(); -use Data::Dumper; -print Dumper($me); -``` - -The authorization token lasts for 1 hour. If your script runs continuously for more than an hour, it will be refreshed before making the next request. - -While it is possible to get "permanent" tokens, that term is misleading because you still need to get a temporary token every time the script runs, which will also expire after an hour. They are intended for applications that are doing things on a user's behalf ("web" and "installed" app types). There is no benefit to supporting this for a "script" type app, and Reddit::Client didn't, so this doesn't, although I may add support if there is demand. - -# Installation -It can be run locally of course, or if you want to install it, you can just drop it into Perl's library directory, which is probably something like /usr/local/share/perl/5.14.2/Reddit. It can be dropped in on top of an existing Reddit::Client installation. - ---- - -1 For "script" type apps, which your Perl script presumably is if you were using the original Reddit::Client. "Script" type apps log into an account using a username and password. - -The other two app types are "web app" and "installed". They do things on behalf of a user without a password, and require a user to give them permission first. The best example is an Android app where you click "Allow" to let it act for your Reddit account, although you may have seen this type of confirmation before on a web page too (and that would be the "web app" type). Reddit::OauthClient doesn't support them, although I may add support if there is demand. From 4ba30dd12b0c4fe1f17678017124d70649277e81 Mon Sep 17 00:00:00 2001 From: earth-tone Date: Tue, 4 Aug 2015 11:50:36 -0400 Subject: [PATCH 05/16] initial commit --- README.md | 9 ++ lib/Reddit/Client.pm | 133 +++++++++++++++++++++++------- lib/Reddit/Client/Account.pm | 12 +-- lib/Reddit/Client/Comment.pm | 16 ++-- lib/Reddit/Client/Link.pm | 6 +- lib/Reddit/Client/Request.pm | 37 +++++++-- lib/Reddit/Client/SubReddit.pm | 6 +- lib/Reddit/Client/Thing.pm | 15 ++-- lib/Reddit/Client/VotableThing.pm | 6 +- 9 files changed, 157 insertions(+), 83 deletions(-) diff --git a/README.md b/README.md index c6d00b0..61daede 100644 --- a/README.md +++ b/README.md @@ -21,12 +21,21 @@ $reddit->get_token($client_id, $secret, $username, $password); ############################################## # Send private message +############################################## my $result = $reddit->send_message( to => 'earth-tone', subject => 'test', text => 'i can haz PMs?' ); +############################################## +# Get all comments from a subreddit or multi +############################################## +my $cmts = $reddit->get_subreddit_comments( + subreddit => 'girlsnanimals', + limit => 25, +); + ############################################## # Get your account information my $me = $reddit->me(); diff --git a/lib/Reddit/Client.pm b/lib/Reddit/Client.pm index 103f448..97fe5cb 100644 --- a/lib/Reddit/Client.pm +++ b/lib/Reddit/Client.pm @@ -1,6 +1,6 @@ package Reddit::Client; -our $VERSION = '0.9_1'; +our $VERSION = '0.92'; $VERSION = eval $VERSION; use strict; @@ -38,6 +38,7 @@ use constant VOTE_NONE => 0; use constant SUBMIT_LINK => 'link'; use constant SUBMIT_SELF => 'self'; +use constant SUBMIT_MESSAGE => 'message'; use constant API_ME => 0; use constant API_INFO => 1; @@ -54,6 +55,8 @@ use constant API_SUBREDDITS => 11; use constant API_LINKS_FRONT => 12; use constant API_LINKS_OTHER => 13; use constant API_DEL => 14; +use constant API_MESSAGE => 15; +use constant API_COMMENTS => 16; use constant SUBREDDITS_HOME => ''; use constant SUBREDDITS_MINE => 'mine'; @@ -67,11 +70,11 @@ use constant SUBREDDITS_MOD => 'moderator'; #=============================================================================== our $DEBUG = 0; -our $BASE_URL = 'http://www.reddit.com'; +our $BASE_URL = 'https://oauth.reddit.com'; our $UA = sprintf 'Reddit::Client/%f', $VERSION; our @API; -$API[API_ME ] = ['GET', '/api/me' ]; +$API[API_ME ] = ['GET', '/api/v1/me' ]; $API[API_INFO ] = ['GET', '/by_id/%s' ]; $API[API_SEARCH ] = ['GET', '/reddits/search']; $API[API_LOGIN ] = ['POST', '/api/login/%s' ]; @@ -86,7 +89,8 @@ $API[API_SUBREDDITS ] = ['GET', '/reddits/%s' ]; $API[API_LINKS_OTHER] = ['GET', '/%s' ]; $API[API_LINKS_FRONT] = ['GET', '/r/%s/%s' ]; $API[API_DEL ] = ['POST', '/api/del' ]; - +$API[API_MESSAGE ] = ['POST', '/api/compose' ]; +$API[API_COMMENTS ] = ['GET', '/r/%s/comments' ]; #=============================================================================== # Package routines #=============================================================================== @@ -123,11 +127,17 @@ sub subreddit { #=============================================================================== use fields ( - 'user', # user name when logged in, set by 'login' and 'load_session' - 'modhash', # store session modhash - 'cookie', # store user cookie - 'session_file', # path to session file - 'user_agent', # user agent string + 'modhash', # store session modhash + 'cookie', # store user cookie + 'session_file', # path to session file + 'user_agent', # user agent string + 'token', # oauth authorization token + 'tokentype', # unused but saved for reference + 'last_token', # time last token was acquired + 'client_id', # These 4 values saved for automatic token refreshing + 'secret', + 'username', + 'password', ); sub new { @@ -154,9 +164,13 @@ sub new { sub request { my ($self, $method, $path, $query, $post_data) = @_; + + if ($self->{last_token} <= time - 3600) { + $self->get_token($self->{client_id}, $self->{secret}, $self->{username}, $self->{password}); + } + # Trim leading slashes off of the path $path =~ s/^\/+//; - my $request = Reddit::Client::Request->new( user_agent => $self->{user_agent}, url => sprintf('%s/%s', $BASE_URL, $path), @@ -165,11 +179,27 @@ sub request { post_data => $post_data, modhash => $self->{modhash}, cookie => $self->{cookie}, + token => $self->{token}, + tokentype => $self->{tokentype}, ); return $request->send; } +sub get_token { + my ($self, $client_id, $secret, $username, $password) = @_; + $self->{client_id} = $client_id; # store for automatic refreshing + $self->{secret} = $secret; + $self->{username} = $username; + $self->{password} = $password; + $self->{last_token} = time; + + my $message = Reddit::Client::Request->token_request($client_id, $secret, $username, $password, $self->{user_agent}); + my $j = JSON::decode_json($message); + $self->{token} = $j->{access_token}; + $self->{tokentype} = $j->{token_type}; +} + sub json_request { my ($self, $method, $path, $query, $post_data) = @_; DEBUG('%4s JSON', $method); @@ -178,7 +208,7 @@ sub json_request { $post_data ||= {}; $post_data->{api_type} = 'json'; } else { - $path .= '.json'; + #$path .= '.json'; # the oauth api returns json by default } my $response = $self->request($method, $path, $query, $post_data); @@ -257,12 +287,7 @@ sub save_session { $self->{session_file} || $file || croak 'Expected $file'; # Prepare session and file path - my $session = { - user => $self->{user}, - modhash => $self->{modhash}, - cookie => $self->{cookie}, - }; - + my $session = { modhash => $self->{modhash}, cookie => $self->{cookie} }; my $file_path = File::Path::Expand::expand_filename( defined $file ? $file : $self->{session_file} ); @@ -296,11 +321,6 @@ sub load_session { if ($data) { my $session = JSON::from_json($data); - - warn "Old session detected - user field not present. You may need to create a new login session using 'login' to use some API calls." - unless exists $self->{user}; - - $self->{user} = $session->{user}; $self->{modhash} = $session->{modhash}; $self->{cookie} = $session->{cookie}; @@ -320,6 +340,10 @@ sub load_session { # User and account management #=============================================================================== +sub authenticate { + my ($self, $client_id, $client_secret) = @_; +} + sub login { my ($self, $usr, $pwd) = @_; !$usr && croak 'Username expected'; @@ -335,7 +359,6 @@ sub login { $self->{modhash} = $result->{data}{modhash}; $self->{cookie} = $result->{data}{cookie}; - $self->{user} = $usr; return 1; } @@ -343,9 +366,10 @@ sub login { sub me { my $self = shift; DEBUG('Request user account info'); - $self->require_login; + #$self->require_login; my $result = $self->api_json_request(api => API_ME); - return Reddit::Client::Account->new($self, $result->{data}); + #return Reddit::Client::Account->new($self, $result->{data}); + return Reddit::Client::Account->new($self, $result); } sub list_subreddits { @@ -430,6 +454,32 @@ sub fetch_links { }; } +sub get_subreddit_comments { + my ($self, %param) = @_; + my $subreddit = $param{subreddit} || 'all'; + my $view = $param{view} || VIEW_DEFAULT; + #my $limit = $param{limit} || DEFAULT_LIMIT; + + my $query = {}; + $query->{limit} = $param{limit} if $param{limit}; + # Reddit's new API defaults to 25 with max 100 + + $subreddit = subreddit($subreddit); # remove slashes and leading r/ + my $args = [$view]; + unshift @$args, $subreddit if $subreddit; + my $result = $self->api_json_request( + api => API_COMMENTS, + args => $args, + data => $query, + ); + #return $result->{data}; + return { + before => $result->{data}{before}, + after => $result->{data}{after}, + items => [ map {Reddit::Client::Comment->new($self, $_->{data})} @{$result->{data}{children}} ], + }; +} + #=============================================================================== # Deleting stories or comments #=============================================================================== @@ -523,6 +573,31 @@ sub submit_comment { return $result->{data}{things}[0]{data}{id}; } +#=============================================================================== +# Private messages +#=============================================================================== + +sub send_message { + my ($self, %param) = @_; + my $to = $param{to} || croak 'Expected "to"'; + my $subject = $param{subject} || croak 'Expected "subject"'; + my $text = $param{text} || croak 'Expected "text"'; + + croak '"subject" cannot be longer than 100 characters' if length $subject > 100; + + $self->require_login; + DEBUG('Submit message to %s: %s', $to, $subject); + + my $result = $self->api_json_request(api => API_MESSAGE, data => { + to => $to, + subject => $subject, + text => $text, + kind => SUBMIT_MESSAGE, + }); + + return $result; +} + #=============================================================================== # Voting #=============================================================================== @@ -620,8 +695,6 @@ For more information about the Reddit API, see L. - VIEW_HOT "Hot" links feed VIEW_NEW "New" links feed VIEW_CONTROVERSIAL "Controversial" links feed @@ -873,10 +946,6 @@ Jeff Ober L =head1 LICENSE -This program is free software; you can redistribute it and/or modify it -under the terms of either: the GNU General Public License as published -by the Free Software Foundation; or the Artistic License. - -See http://dev.perl.org/licenses/ for more information. +BSD license =cut diff --git a/lib/Reddit/Client/Account.pm b/lib/Reddit/Client/Account.pm index 873c088..8e196d1 100644 --- a/lib/Reddit/Client/Account.pm +++ b/lib/Reddit/Client/Account.pm @@ -7,10 +7,8 @@ use Carp; require Reddit::Client::Thing; use base qw/Reddit::Client::Thing/; -use fields qw/has_mail created modhash created_utc link_karma - gold_creddits inbox_count gold_expiration - is_friend hide_from_robots has_verified_email - comment_karma is_gold is_mod has_mod_mail over_18/; +use fields qw/has_mail created modhash created_utc link_karma over_18 + comment_karma is_gold is_mod has_mod_mail/; 1; @@ -32,10 +30,6 @@ Jeff Ober L =head1 LICENSE -This program is free software; you can redistribute it and/or modify it -under the terms of either: the GNU General Public License as published -by the Free Software Foundation; or the Artistic License. - -See http://dev.perl.org/licenses/ for more information. +BSD license =cut diff --git a/lib/Reddit/Client/Comment.pm b/lib/Reddit/Client/Comment.pm index a399eee..0de837a 100644 --- a/lib/Reddit/Client/Comment.pm +++ b/lib/Reddit/Client/Comment.pm @@ -8,15 +8,15 @@ require Reddit::Client::VotableThing; use base qw/Reddit::Client::VotableThing/; use fields qw/link_flair_text media url link_flair_css_class num_reports created_utc - banned_by subreddit title author_flair_text is_self author media_embed - permalink author_flair_css_class selftext domain num_comments clicked - saved thumbnail subreddit_id approved_by selftext_html created hidden - over_18 parent_id replies link_id body body_html/; + banned_by subreddit title author_flair_text is_self author media_embed + permalink author_flair_css_class selftext domain num_comments clicked + saved thumbnail subreddit_id approved_by selftext_html created hidden + over_18 parent_id replies link_id body body_html/; sub set_replies { my ($self, $value) = @_; if (ref $value && exists $value->{data}{children}) { - $self->{replies} = [ map { Reddit::Client::Comment->new($self->{session}, $_->{data}) } @{$value->{data}{children}} ]; + $self->{replies} = [ map { Reddit::Client::Comment->new($self->{session}, $_->{data}) } @{$value->{data}{children}} ]; } else { $self->{replies} = []; } @@ -76,10 +76,6 @@ Jeff Ober L =head1 LICENSE -This program is free software; you can redistribute it and/or modify it -under the terms of either: the GNU General Public License as published -by the Free Software Foundation; or the Artistic License. - -See http://dev.perl.org/licenses/ for more information. +BSD license =cut diff --git a/lib/Reddit/Client/Link.pm b/lib/Reddit/Client/Link.pm index d7c14e8..20ebd28 100644 --- a/lib/Reddit/Client/Link.pm +++ b/lib/Reddit/Client/Link.pm @@ -48,10 +48,6 @@ Jeff Ober L =head1 LICENSE -This program is free software; you can redistribute it and/or modify it -under the terms of either: the GNU General Public License as published -by the Free Software Foundation; or the Artistic License. - -See http://dev.perl.org/licenses/ for more information. +BSD license =cut diff --git a/lib/Reddit/Client/Request.pm b/lib/Reddit/Client/Request.pm index b3c8446..d85d557 100644 --- a/lib/Reddit/Client/Request.pm +++ b/lib/Reddit/Client/Request.pm @@ -18,6 +18,8 @@ use fields ( 'post_data', 'cookie', 'modhash', + 'token', + 'tokentype' ); sub new { @@ -29,6 +31,8 @@ sub new { $self->{post_data} = $param{post_data}; $self->{cookie} = $param{cookie}; $self->{modhash} = $param{modhash}; + $self->{token} = $param{token}; + $self->{tokentype} = $param{tokentype}; if (defined $self->{query}) { ref $self->{query} eq 'HASH' || croak 'Expected HASH ref for "query"'; @@ -56,8 +60,9 @@ sub build_request { my $request = HTTP::Request->new(); $request->uri($self->{url}); - $request->header('Cookie', sprintf('reddit_session=%s', $self->{cookie})) - if $self->{cookie}; + #$request->header('Cookie', sprintf('reddit_session=%s', $self->{cookie})) + # if $self->{cookie}; + $request->header("Authorization"=> "$self->{tokentype} $self->{token}"); if ($self->{method} eq 'POST') { my $post_data = $self->{post_data} || {}; @@ -81,6 +86,7 @@ sub send { Reddit::Client::DEBUG('%4s request to %s', $self->{method}, $self->{url}); my $ua = LWP::UserAgent->new(agent => $self->{user_agent}, env_proxy => 1); + #print $request->as_string."\n"; my $res = $ua->request($request); if ($res->is_success) { @@ -90,6 +96,27 @@ sub send { } } +sub token_request { + my ($self, $client_id, $secret, $username, $password, $useragent) = @_; + + my $url = "https://$client_id:$secret\@www.reddit.com/api/v1/access_token"; + + my $ua = LWP::UserAgent->new(user_agent => $useragent); + my $req = HTTP::Request->new(POST => $url); + $req->header('content-type' => 'application/x-www-form-urlencoded'); + + my $postdata = "grant_type=password&username=$username&password=$password"; + $req->content($postdata); + + my $res = $ua->request($req); + + if ($res->is_success) { + return $res->decoded_content; + } else { + croak sprintf('Request error: HTTP %s', $res->status_line); + } +} + 1; __END__ @@ -146,10 +173,6 @@ Jeff Ober L =head1 LICENSE -This program is free software; you can redistribute it and/or modify it -under the terms of either: the GNU General Public License as published -by the Free Software Foundation; or the Artistic License. - -See http://dev.perl.org/licenses/ for more information. +BSD license =cut diff --git a/lib/Reddit/Client/SubReddit.pm b/lib/Reddit/Client/SubReddit.pm index adc306d..3cc5b9d 100644 --- a/lib/Reddit/Client/SubReddit.pm +++ b/lib/Reddit/Client/SubReddit.pm @@ -63,10 +63,6 @@ Jeff Ober L =head1 LICENSE -This program is free software; you can redistribute it and/or modify it -under the terms of either: the GNU General Public License as published -by the Free Software Foundation; or the Artistic License. - -See http://dev.perl.org/licenses/ for more information. +BSD license =cut diff --git a/lib/Reddit/Client/Thing.pm b/lib/Reddit/Client/Thing.pm index 2e1afcd..1789f92 100644 --- a/lib/Reddit/Client/Thing.pm +++ b/lib/Reddit/Client/Thing.pm @@ -7,7 +7,6 @@ use Carp; use List::Util qw/first/; our @BOOL_FIELDS = qw/is_self likes clicked saved hidden over_18 over18 - has_verified_email hide_from_robots is_friend has_mail has_mod_mail is_mod is_gold/; @@ -23,7 +22,7 @@ sub new { sub load_from_source_data { require Reddit::Client; - + my ($self, $source_data) = @_; if ($source_data) { foreach my $field (keys %$source_data) { @@ -34,9 +33,9 @@ sub load_from_source_data { } elsif (first {$_ eq $field} @BOOL_FIELDS) { $self->set_bool($field, $source_data->{$field}); } else { - eval { $self->{$field} = $source_data->{$field} }; - Reddit::Client::DEBUG("Field %s is missing from package %s\n", $field, ref $self) - if $@; + eval { $self->{$field} = $source_data->{$field} }; + Reddit::Client::DEBUG("Field %s is missing from package %s\n", $field, ref $self) + if $@; } # Add getter for field @@ -111,10 +110,6 @@ Jeff Ober L =head1 LICENSE -This program is free software; you can redistribute it and/or modify it -under the terms of either: the GNU General Public License as published -by the Free Software Foundation; or the Artistic License. - -See http://dev.perl.org/licenses/ for more information. +BSD license =cut diff --git a/lib/Reddit/Client/VotableThing.pm b/lib/Reddit/Client/VotableThing.pm index 5350f0a..f6c6eb8 100644 --- a/lib/Reddit/Client/VotableThing.pm +++ b/lib/Reddit/Client/VotableThing.pm @@ -95,10 +95,6 @@ Jeff Ober L =head1 LICENSE -This program is free software; you can redistribute it and/or modify it -under the terms of either: the GNU General Public License as published -by the Free Software Foundation; or the Artistic License. - -See http://dev.perl.org/licenses/ for more information. +BSD license =cut From e95a83155cb5016cf2027c5386cc1b673b126094 Mon Sep 17 00:00:00 2001 From: earth-tone Date: Tue, 4 Aug 2015 11:56:35 -0400 Subject: [PATCH 06/16] initial commit --- README.md | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 61daede..9025aea 100644 --- a/README.md +++ b/README.md @@ -30,14 +30,16 @@ my $result = $reddit->send_message( ############################################## # Get all comments from a subreddit or multi +# -Reddit's API now defaults to 25 with max of 100 ############################################## my $cmts = $reddit->get_subreddit_comments( - subreddit => 'girlsnanimals', + subreddit => 'all+test', limit => 25, ); ############################################## # Get your account information +############################################## my $me = $reddit->me(); use Data::Dumper; print Dumper($me); @@ -48,7 +50,7 @@ The authorization token lasts for 1 hour. If your script runs continuously for m While it is possible to get "permanent" tokens, that term is misleading because you still need to get a temporary token every time the script runs, which will also expire after an hour. They are intended for applications that are doing things on a user's behalf ("web" and "installed" app types). There is no benefit to supporting this for a "script" type app, and Reddit::Client didn't, so this doesn't, although I may add support if there is demand. # Installation -It can be run locally of course, or if you want to install it, you can just drop it into Perl's library directory, which is probably something like /usr/local/share/perl/5.14.2/Reddit. It can be dropped in on top of an existing Reddit::Client installation. +It can be run locally of course, or if you want to install it, you can just drop it into Perl's library directory, which is probably something like /usr/local/share/perl/5.14.2/Reddit. It can be dropped in on top of an existing Reddit::Client installation. To do that, you would only copy the lib/Reddit directory (not the top level directory with the Makefile, etc). --- From 69554194e042b2870d72a0e9e52f38cc353683de Mon Sep 17 00:00:00 2001 From: earth-tone Date: Tue, 4 Aug 2015 12:23:32 -0400 Subject: [PATCH 07/16] updated readme --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 9025aea..bb331f3 100644 --- a/README.md +++ b/README.md @@ -50,7 +50,7 @@ The authorization token lasts for 1 hour. If your script runs continuously for m While it is possible to get "permanent" tokens, that term is misleading because you still need to get a temporary token every time the script runs, which will also expire after an hour. They are intended for applications that are doing things on a user's behalf ("web" and "installed" app types). There is no benefit to supporting this for a "script" type app, and Reddit::Client didn't, so this doesn't, although I may add support if there is demand. # Installation -It can be run locally of course, or if you want to install it, you can just drop it into Perl's library directory, which is probably something like /usr/local/share/perl/5.14.2/Reddit. It can be dropped in on top of an existing Reddit::Client installation. To do that, you would only copy the lib/Reddit directory (not the top level directory with the Makefile, etc). +The Reddit directory can be dropped right onto the Reddit directory in your existing Reddit::Client installation, which is probably somewhere like /usr/local/share/perl/5.14.2/Reddit. The installer resumably works but is untested. --- From 89cada1297e08c9c0a6015e7313f8f9e1b32c5a8 Mon Sep 17 00:00:00 2001 From: earth-tone Date: Tue, 4 Aug 2015 12:24:19 -0400 Subject: [PATCH 08/16] updated readme --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index bb331f3..3038225 100644 --- a/README.md +++ b/README.md @@ -50,7 +50,7 @@ The authorization token lasts for 1 hour. If your script runs continuously for m While it is possible to get "permanent" tokens, that term is misleading because you still need to get a temporary token every time the script runs, which will also expire after an hour. They are intended for applications that are doing things on a user's behalf ("web" and "installed" app types). There is no benefit to supporting this for a "script" type app, and Reddit::Client didn't, so this doesn't, although I may add support if there is demand. # Installation -The Reddit directory can be dropped right onto the Reddit directory in your existing Reddit::Client installation, which is probably somewhere like /usr/local/share/perl/5.14.2/Reddit. The installer resumably works but is untested. +The Reddit directory can be dropped right onto the Reddit directory in your existing Reddit::Client installation, which is probably somewhere like /usr/local/share/perl/5.14.2/Reddit. The installer presumably works but is untested. --- From 0b631d636239de070f2d842a8d6889c198e3126f Mon Sep 17 00:00:00 2001 From: earth-tone Date: Tue, 4 Aug 2015 21:06:30 -0400 Subject: [PATCH 09/16] updated get_subreddit_comments to allow omitting of the subreddit-- i.e. your Reddit front page, which is different than /r/all, the default if subreddit was omitted before --- lib/Reddit/Client.pm | 42 ++++++++++++++++++++++-------------------- 1 file changed, 22 insertions(+), 20 deletions(-) diff --git a/lib/Reddit/Client.pm b/lib/Reddit/Client.pm index 97fe5cb..4dd75d9 100644 --- a/lib/Reddit/Client.pm +++ b/lib/Reddit/Client.pm @@ -56,7 +56,8 @@ use constant API_LINKS_FRONT => 12; use constant API_LINKS_OTHER => 13; use constant API_DEL => 14; use constant API_MESSAGE => 15; -use constant API_COMMENTS => 16; +use constant API_COMMENTS_FRONT => 16; +use constant API_COMMENTS => 17; use constant SUBREDDITS_HOME => ''; use constant SUBREDDITS_MINE => 'mine'; @@ -74,23 +75,24 @@ our $BASE_URL = 'https://oauth.reddit.com'; our $UA = sprintf 'Reddit::Client/%f', $VERSION; our @API; -$API[API_ME ] = ['GET', '/api/v1/me' ]; -$API[API_INFO ] = ['GET', '/by_id/%s' ]; -$API[API_SEARCH ] = ['GET', '/reddits/search']; -$API[API_LOGIN ] = ['POST', '/api/login/%s' ]; -$API[API_SUBMIT ] = ['POST', '/api/submit' ]; -$API[API_COMMENT ] = ['POST', '/api/comment' ]; -$API[API_VOTE ] = ['POST', '/api/vote' ]; -$API[API_SAVE ] = ['POST', '/api/save' ]; -$API[API_UNSAVE ] = ['POST', '/api/unsave' ]; -$API[API_HIDE ] = ['POST', '/api/hide' ]; -$API[API_UNHIDE ] = ['POST', '/api/unhide' ]; -$API[API_SUBREDDITS ] = ['GET', '/reddits/%s' ]; -$API[API_LINKS_OTHER] = ['GET', '/%s' ]; -$API[API_LINKS_FRONT] = ['GET', '/r/%s/%s' ]; -$API[API_DEL ] = ['POST', '/api/del' ]; -$API[API_MESSAGE ] = ['POST', '/api/compose' ]; -$API[API_COMMENTS ] = ['GET', '/r/%s/comments' ]; +$API[API_ME ] = ['GET', '/api/v1/me' ]; +$API[API_INFO ] = ['GET', '/by_id/%s' ]; +$API[API_SEARCH ] = ['GET', '/reddits/search']; +$API[API_LOGIN ] = ['POST', '/api/login/%s' ]; +$API[API_SUBMIT ] = ['POST', '/api/submit' ]; +$API[API_COMMENT ] = ['POST', '/api/comment' ]; +$API[API_VOTE ] = ['POST', '/api/vote' ]; +$API[API_SAVE ] = ['POST', '/api/save' ]; +$API[API_UNSAVE ] = ['POST', '/api/unsave' ]; +$API[API_HIDE ] = ['POST', '/api/hide' ]; +$API[API_UNHIDE ] = ['POST', '/api/unhide' ]; +$API[API_SUBREDDITS ] = ['GET', '/reddits/%s' ]; +$API[API_LINKS_OTHER ] = ['GET', '/%s' ]; +$API[API_LINKS_FRONT ] = ['GET', '/r/%s/%s' ]; +$API[API_DEL ] = ['POST', '/api/del' ]; +$API[API_MESSAGE ] = ['POST', '/api/compose' ]; +$API[API_COMMENTS ] = ['GET', '/r/%s/comments' ]; +$API[API_COMMENTS_FRONT] = ['GET', '/comments' ]; #=============================================================================== # Package routines #=============================================================================== @@ -456,7 +458,7 @@ sub fetch_links { sub get_subreddit_comments { my ($self, %param) = @_; - my $subreddit = $param{subreddit} || 'all'; + my $subreddit = $param{subreddit} || ''; my $view = $param{view} || VIEW_DEFAULT; #my $limit = $param{limit} || DEFAULT_LIMIT; @@ -468,7 +470,7 @@ sub get_subreddit_comments { my $args = [$view]; unshift @$args, $subreddit if $subreddit; my $result = $self->api_json_request( - api => API_COMMENTS, + api => ($subreddit ? API_COMMENTS : API_COMMENTS_FRONT), args => $args, data => $query, ); From f85702fdda399945da78dd391a62ccb7f67d2459 Mon Sep 17 00:00:00 2001 From: earth-tone Date: Wed, 5 Aug 2015 21:46:19 -0400 Subject: [PATCH 10/16] removed login requirement from send_message \n\n added unit tests --- lib/Reddit/Client.pm | 21 ++++++++----- unit_tests | 74 ++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 88 insertions(+), 7 deletions(-) create mode 100755 unit_tests diff --git a/lib/Reddit/Client.pm b/lib/Reddit/Client.pm index 4dd75d9..6a36573 100644 --- a/lib/Reddit/Client.pm +++ b/lib/Reddit/Client.pm @@ -190,16 +190,18 @@ sub request { sub get_token { my ($self, $client_id, $secret, $username, $password) = @_; - $self->{client_id} = $client_id; # store for automatic refreshing - $self->{secret} = $secret; - $self->{username} = $username; - $self->{password} = $password; + $self->{client_id} = $client_id || croak "need client_id"; + $self->{secret} = $secret || croak "need secret"; + $self->{username} = $username || croak "need username"; + $self->{password} = $password || croak "need password"; $self->{last_token} = time; my $message = Reddit::Client::Request->token_request($client_id, $secret, $username, $password, $self->{user_agent}); my $j = JSON::decode_json($message); $self->{token} = $j->{access_token}; $self->{tokentype} = $j->{token_type}; + + if (!$self->{token}) { croak "Unable to get or parse token."; } } sub json_request { @@ -463,8 +465,13 @@ sub get_subreddit_comments { #my $limit = $param{limit} || DEFAULT_LIMIT; my $query = {}; - $query->{limit} = $param{limit} if $param{limit}; - # Reddit's new API defaults to 25 with max 100 + # if limit exists but is false (for "no limit"), get as many as possible + # this will probably be 100 but ask for a ridiculous amount anyway + if (exists $param{limit}) { + $query->{limit} = $param{limit} || 500; + } else { + $query->{limit} = 25; + } $subreddit = subreddit($subreddit); # remove slashes and leading r/ my $args = [$view]; @@ -587,7 +594,7 @@ sub send_message { croak '"subject" cannot be longer than 100 characters' if length $subject > 100; - $self->require_login; + #$self->require_login; DEBUG('Submit message to %s: %s', $to, $subject); my $result = $self->api_json_request(api => API_MESSAGE, data => { diff --git a/unit_tests b/unit_tests new file mode 100755 index 0000000..3ce00ce --- /dev/null +++ b/unit_tests @@ -0,0 +1,74 @@ +#!/usr/bin/perl + +use warnings; use strict; use v5.14; use lib '/home/bubs/perl/lib'; +use Reddit::Client; +use Test::Simple tests => 7; +use Data::Dumper; + + +# Account and oauth details ############################3 +my $client_id = '2ySDQtixv44PiQ'; +my $secret = 'oMRYIMl9qL-QIgrzLrvDjwjkAvc'; +my $user = 'earth-tone'; +my $pass = 'batmanlives'; +########################################################3 + +# +# Reddit::Client Object +# +my $reddit = new Reddit::Client( + session_file => '/home/bubs/perl/reddit/session_data.json', + user_agent => 'inboxcheck', +); + +$reddit->get_token($client_id, $secret, $user, $pass); + + +print "Create Reddit::Client object: "; +ok(ref $reddit eq 'Reddit::Client'); + +print "Token exists: "; +ok($reddit->{token}); + +# +# me() +# +my $me = $reddit->me(); +print "me(): "; +ok(ref $me eq 'Reddit::Client::Account'); + +# +# send_message() +# +my $result = $reddit->send_message( + to=>'lecherous_hump', + subject=>'test msg'.time, + text=>'test'.time); + +print "send_message(): "; +ok(!scalar @{$result->{errors}}); + +# +# get_subreddit_comments() +# +my $sub = "test+all"; +my $limit = 5; + +my $cmts = $reddit->get_subreddit_comments( + subreddit=>$sub, + limit=>$limit); + +print "get_subreddit_comments():\n"; +print " provided subreddit and limit: "; +ok($cmts); + +$cmts = $reddit->get_subreddit_comments( + limit=>$limit); +print " no sub provided: "; +ok($cmts); + + +$cmts = $reddit->get_subreddit_comments(); + +print " no limit or sub provided: "; +ok($cmts); From 12b0a9a51ce8ed97afbfdecdc3160f6f27280298 Mon Sep 17 00:00:00 2001 From: earth-tone Date: Wed, 5 Aug 2015 21:47:16 -0400 Subject: [PATCH 11/16] removed login requirement from send_message \n\n added unit tests --- unit_tests | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/unit_tests b/unit_tests index 3ce00ce..cf62bc7 100755 --- a/unit_tests +++ b/unit_tests @@ -7,10 +7,10 @@ use Data::Dumper; # Account and oauth details ############################3 -my $client_id = '2ySDQtixv44PiQ'; -my $secret = 'oMRYIMl9qL-QIgrzLrvDjwjkAvc'; -my $user = 'earth-tone'; -my $pass = 'batmanlives'; +my $client_id = ''; +my $secret = ''; +my $user = ''; +my $pass = ''; ########################################################3 # @@ -41,7 +41,7 @@ ok(ref $me eq 'Reddit::Client::Account'); # send_message() # my $result = $reddit->send_message( - to=>'lecherous_hump', + to=>'earth-tone', subject=>'test msg'.time, text=>'test'.time); From b6a29ba41dd8e42215c46bea9459fe3a9840b571 Mon Sep 17 00:00:00 2001 From: earth-tone Date: Fri, 7 Aug 2015 22:19:32 -0400 Subject: [PATCH 12/16] added before and after args to get_subreddit_comments --- lib/Reddit/Client.pm | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/lib/Reddit/Client.pm b/lib/Reddit/Client.pm index 6a36573..79244c7 100644 --- a/lib/Reddit/Client.pm +++ b/lib/Reddit/Client.pm @@ -1,6 +1,6 @@ package Reddit::Client; -our $VERSION = '0.92'; +our $VERSION = '0.93'; $VERSION = eval $VERSION; use strict; @@ -211,7 +211,7 @@ sub json_request { if ($method eq 'POST') { $post_data ||= {}; $post_data->{api_type} = 'json'; - } else { + } else { #$path .= '.json'; # the oauth api returns json by default } @@ -434,7 +434,7 @@ sub fetch_links { DEBUG('Fetch %d link(s): %s/%s?before=%s&after=%s', $limit, $subreddit, $view, ($before || '-'), ($after || '-')); my $query = {}; - if ($before || $after || $limit) { + if ($before || $after || $limit) { # limit is always defined $query->{limit} = $limit if defined $limit; $query->{before} = $before if defined $before; $query->{after} = $after if defined $after; @@ -462,11 +462,15 @@ sub get_subreddit_comments { my ($self, %param) = @_; my $subreddit = $param{subreddit} || ''; my $view = $param{view} || VIEW_DEFAULT; - #my $limit = $param{limit} || DEFAULT_LIMIT; + my $before = $param{before}; + my $after = $param{after}; my $query = {}; + $query->{before} = $before if defined $before; + $query->{after} = $after if defined $after; # if limit exists but is false (for "no limit"), get as many as possible # this will probably be 100 but ask for a ridiculous amount anyway + # if we don't provide a limit, Reddit will give us 25 if (exists $param{limit}) { $query->{limit} = $param{limit} || 500; } else { @@ -476,12 +480,13 @@ sub get_subreddit_comments { $subreddit = subreddit($subreddit); # remove slashes and leading r/ my $args = [$view]; unshift @$args, $subreddit if $subreddit; + my $result = $self->api_json_request( api => ($subreddit ? API_COMMENTS : API_COMMENTS_FRONT), args => $args, data => $query, ); - #return $result->{data}; + return { before => $result->{data}{before}, after => $result->{data}{after}, @@ -555,7 +560,7 @@ sub submit_text { # Comments #=============================================================================== -sub get_comments { +sub get_comments { # currently broken my ($self, %param) = @_; my $permalink = $param{permalink} || croak 'Expected "permalink"'; From 3c900ab5d932a22cd223fc90f8089def30bffe4b Mon Sep 17 00:00:00 2001 From: earth-tone Date: Sat, 8 Aug 2015 16:11:44 -0400 Subject: [PATCH 13/16] updated testing process --- lib/Reddit/Client.pm | 2 +- lib/Reddit/Client/Request.pm | 9 +++-- t/request.t | 6 +-- unit_tests | 74 ------------------------------------ 4 files changed, 9 insertions(+), 82 deletions(-) delete mode 100755 unit_tests diff --git a/lib/Reddit/Client.pm b/lib/Reddit/Client.pm index 79244c7..00afa06 100644 --- a/lib/Reddit/Client.pm +++ b/lib/Reddit/Client.pm @@ -167,7 +167,7 @@ sub new { sub request { my ($self, $method, $path, $query, $post_data) = @_; - if ($self->{last_token} <= time - 3600) { + if (!$self->{last_token} || $self->{last_token} <= time - 3600) { $self->get_token($self->{client_id}, $self->{secret}, $self->{username}, $self->{password}); } diff --git a/lib/Reddit/Client/Request.pm b/lib/Reddit/Client/Request.pm index d85d557..190e1e5 100644 --- a/lib/Reddit/Client/Request.pm +++ b/lib/Reddit/Client/Request.pm @@ -18,8 +18,8 @@ use fields ( 'post_data', 'cookie', 'modhash', - 'token', - 'tokentype' + 'token', + 'tokentype' ); sub new { @@ -62,7 +62,7 @@ sub build_request { $request->uri($self->{url}); #$request->header('Cookie', sprintf('reddit_session=%s', $self->{cookie})) # if $self->{cookie}; - $request->header("Authorization"=> "$self->{tokentype} $self->{token}"); + $request->header("Authorization"=> "$self->{tokentype} $self->{token}") if $self->{tokentype} && $self->{token}; if ($self->{method} eq 'POST') { my $post_data = $self->{post_data} || {}; @@ -82,11 +82,12 @@ sub build_request { sub send { my $self = shift; my $request = $self->build_request; + #use Data::Dumper; + #print Dumper($request)."\n"; Reddit::Client::DEBUG('%4s request to %s', $self->{method}, $self->{url}); my $ua = LWP::UserAgent->new(agent => $self->{user_agent}, env_proxy => 1); - #print $request->as_string."\n"; my $res = $ua->request($request); if ($res->is_success) { diff --git a/t/request.t b/t/request.t index 5566e1a..47dfd69 100644 --- a/t/request.t +++ b/t/request.t @@ -3,7 +3,7 @@ use warnings; use Carp; use HTTP::Response; use Test::MockModule; -use Test::More tests => 16; +use Test::More tests => 15; use Reddit::Client::Request; @@ -43,7 +43,7 @@ my $rq = Reddit::Client::Request->new( ok($request->method eq 'POST', 'build_request'); ok($request->uri eq 'http://www.example.com?foo=bar', 'build_request'); ok($request->content eq 'baz=bat&modhash=test&uh=test', 'build_request'); - ok($request->header('Cookie') eq 'reddit_session=test', 'build_request'); + #ok($request->header('Cookie') eq 'reddit_session=test', 'build_request'); ok($request->content_type eq 'application/x-www-form-urlencoded', 'build_request'); } @@ -63,4 +63,4 @@ my $rq = Reddit::Client::Request->new( $lwp->unmock_all; } -1; \ No newline at end of file +1; diff --git a/unit_tests b/unit_tests deleted file mode 100755 index cf62bc7..0000000 --- a/unit_tests +++ /dev/null @@ -1,74 +0,0 @@ -#!/usr/bin/perl - -use warnings; use strict; use v5.14; use lib '/home/bubs/perl/lib'; -use Reddit::Client; -use Test::Simple tests => 7; -use Data::Dumper; - - -# Account and oauth details ############################3 -my $client_id = ''; -my $secret = ''; -my $user = ''; -my $pass = ''; -########################################################3 - -# -# Reddit::Client Object -# -my $reddit = new Reddit::Client( - session_file => '/home/bubs/perl/reddit/session_data.json', - user_agent => 'inboxcheck', -); - -$reddit->get_token($client_id, $secret, $user, $pass); - - -print "Create Reddit::Client object: "; -ok(ref $reddit eq 'Reddit::Client'); - -print "Token exists: "; -ok($reddit->{token}); - -# -# me() -# -my $me = $reddit->me(); -print "me(): "; -ok(ref $me eq 'Reddit::Client::Account'); - -# -# send_message() -# -my $result = $reddit->send_message( - to=>'earth-tone', - subject=>'test msg'.time, - text=>'test'.time); - -print "send_message(): "; -ok(!scalar @{$result->{errors}}); - -# -# get_subreddit_comments() -# -my $sub = "test+all"; -my $limit = 5; - -my $cmts = $reddit->get_subreddit_comments( - subreddit=>$sub, - limit=>$limit); - -print "get_subreddit_comments():\n"; -print " provided subreddit and limit: "; -ok($cmts); - -$cmts = $reddit->get_subreddit_comments( - limit=>$limit); -print " no sub provided: "; -ok($cmts); - - -$cmts = $reddit->get_subreddit_comments(); - -print " no limit or sub provided: "; -ok($cmts); From 56a6446af9822eefbf651af23c561906d06237da Mon Sep 17 00:00:00 2001 From: earth-tone Date: Sun, 30 Aug 2015 10:17:07 -0400 Subject: [PATCH 14/16] readme --- lib/Reddit/Client.pm | 965 ------------------------------ lib/Reddit/Client/Account.pm | 35 -- lib/Reddit/Client/Comment.pm | 81 --- lib/Reddit/Client/Link.pm | 53 -- lib/Reddit/Client/Request.pm | 178 ------ lib/Reddit/Client/SubReddit.pm | 68 --- lib/Reddit/Client/Thing.pm | 115 ---- lib/Reddit/Client/VotableThing.pm | 100 ---- t/request.t | 6 +- unit_tests | 74 --- 10 files changed, 3 insertions(+), 1672 deletions(-) delete mode 100644 lib/Reddit/Client.pm delete mode 100644 lib/Reddit/Client/Account.pm delete mode 100644 lib/Reddit/Client/Comment.pm delete mode 100644 lib/Reddit/Client/Link.pm delete mode 100644 lib/Reddit/Client/Request.pm delete mode 100644 lib/Reddit/Client/SubReddit.pm delete mode 100644 lib/Reddit/Client/Thing.pm delete mode 100644 lib/Reddit/Client/VotableThing.pm delete mode 100755 unit_tests diff --git a/lib/Reddit/Client.pm b/lib/Reddit/Client.pm deleted file mode 100644 index 79244c7..0000000 --- a/lib/Reddit/Client.pm +++ /dev/null @@ -1,965 +0,0 @@ -package Reddit::Client; - -our $VERSION = '0.93'; -$VERSION = eval $VERSION; - -use strict; -use warnings; -use Carp; - -use Data::Dumper qw/Dumper/; -use JSON qw//; -use File::Spec qw//; -use Digest::MD5 qw/md5_hex/; -use POSIX qw/strftime/; -use File::Path::Expand qw//; - -require Reddit::Client::Account; -require Reddit::Client::Comment; -require Reddit::Client::Link; -require Reddit::Client::SubReddit; -require Reddit::Client::Request; - -#=============================================================================== -# Constants -#=============================================================================== - -use constant DEFAULT_LIMIT => 25; - -use constant VIEW_HOT => ''; -use constant VIEW_NEW => 'new'; -use constant VIEW_CONTROVERSIAL => 'controversial'; -use constant VIEW_TOP => 'top'; -use constant VIEW_DEFAULT => VIEW_HOT; - -use constant VOTE_UP => 1; -use constant VOTE_DOWN => -1; -use constant VOTE_NONE => 0; - -use constant SUBMIT_LINK => 'link'; -use constant SUBMIT_SELF => 'self'; -use constant SUBMIT_MESSAGE => 'message'; - -use constant API_ME => 0; -use constant API_INFO => 1; -use constant API_SEARCH => 2; -use constant API_LOGIN => 3; -use constant API_SUBMIT => 4; -use constant API_COMMENT => 5; -use constant API_VOTE => 6; -use constant API_SAVE => 7; -use constant API_UNSAVE => 8; -use constant API_HIDE => 9; -use constant API_UNHIDE => 10; -use constant API_SUBREDDITS => 11; -use constant API_LINKS_FRONT => 12; -use constant API_LINKS_OTHER => 13; -use constant API_DEL => 14; -use constant API_MESSAGE => 15; -use constant API_COMMENTS_FRONT => 16; -use constant API_COMMENTS => 17; - -use constant SUBREDDITS_HOME => ''; -use constant SUBREDDITS_MINE => 'mine'; -use constant SUBREDDITS_POPULAR => 'popular'; -use constant SUBREDDITS_NEW => 'new'; -use constant SUBREDDITS_CONTRIB => 'contributor'; -use constant SUBREDDITS_MOD => 'moderator'; - -#=============================================================================== -# Parameters -#=============================================================================== - -our $DEBUG = 0; -our $BASE_URL = 'https://oauth.reddit.com'; -our $UA = sprintf 'Reddit::Client/%f', $VERSION; - -our @API; -$API[API_ME ] = ['GET', '/api/v1/me' ]; -$API[API_INFO ] = ['GET', '/by_id/%s' ]; -$API[API_SEARCH ] = ['GET', '/reddits/search']; -$API[API_LOGIN ] = ['POST', '/api/login/%s' ]; -$API[API_SUBMIT ] = ['POST', '/api/submit' ]; -$API[API_COMMENT ] = ['POST', '/api/comment' ]; -$API[API_VOTE ] = ['POST', '/api/vote' ]; -$API[API_SAVE ] = ['POST', '/api/save' ]; -$API[API_UNSAVE ] = ['POST', '/api/unsave' ]; -$API[API_HIDE ] = ['POST', '/api/hide' ]; -$API[API_UNHIDE ] = ['POST', '/api/unhide' ]; -$API[API_SUBREDDITS ] = ['GET', '/reddits/%s' ]; -$API[API_LINKS_OTHER ] = ['GET', '/%s' ]; -$API[API_LINKS_FRONT ] = ['GET', '/r/%s/%s' ]; -$API[API_DEL ] = ['POST', '/api/del' ]; -$API[API_MESSAGE ] = ['POST', '/api/compose' ]; -$API[API_COMMENTS ] = ['GET', '/r/%s/comments' ]; -$API[API_COMMENTS_FRONT] = ['GET', '/comments' ]; -#=============================================================================== -# Package routines -#=============================================================================== - -sub DEBUG { - if ($DEBUG) { - my ($format, @args) = @_; - my $ts = strftime "%Y-%m-%d %H:%M:%S", localtime; - my $msg = sprintf $format, @args; - chomp $msg; - printf STDERR "[%s] [ %s ]\n", $ts, $msg; - } -} - -sub subreddit { - my $subject = shift; - $subject =~ s/^\/r//; # trim leading /r - $subject =~ s/^\///; # trim leading slashes - $subject =~ s/\/$//; # trim trailing slashes - - if ($subject !~ /\//) { # no slashes in name - it's probably good - if ($subject eq '') { # front page - return ''; - } else { # subreddit - return $subject; - } - } else { # fail - return; - } -} - -#=============================================================================== -# Class methods -#=============================================================================== - -use fields ( - 'modhash', # store session modhash - 'cookie', # store user cookie - 'session_file', # path to session file - 'user_agent', # user agent string - 'token', # oauth authorization token - 'tokentype', # unused but saved for reference - 'last_token', # time last token was acquired - 'client_id', # These 4 values saved for automatic token refreshing - 'secret', - 'username', - 'password', -); - -sub new { - my ($class, %param) = @_; - my $self = fields::new($class); - - if (not exists $param{user_agent}) { - carp "Reddit::Client->new: user_agent required in future version."; - $param{user_agent} = $UA; - } - $self->{user_agent} = $param{user_agent}; - - if ($param{session_file}) { - $self->{session_file} = $param{session_file}; - $self->load_session; - } - - return $self; -} - -#=============================================================================== -# Internal management -#=============================================================================== - -sub request { - my ($self, $method, $path, $query, $post_data) = @_; - - if ($self->{last_token} <= time - 3600) { - $self->get_token($self->{client_id}, $self->{secret}, $self->{username}, $self->{password}); - } - - # Trim leading slashes off of the path - $path =~ s/^\/+//; - my $request = Reddit::Client::Request->new( - user_agent => $self->{user_agent}, - url => sprintf('%s/%s', $BASE_URL, $path), - method => $method, - query => $query, - post_data => $post_data, - modhash => $self->{modhash}, - cookie => $self->{cookie}, - token => $self->{token}, - tokentype => $self->{tokentype}, - ); - - return $request->send; -} - -sub get_token { - my ($self, $client_id, $secret, $username, $password) = @_; - $self->{client_id} = $client_id || croak "need client_id"; - $self->{secret} = $secret || croak "need secret"; - $self->{username} = $username || croak "need username"; - $self->{password} = $password || croak "need password"; - $self->{last_token} = time; - - my $message = Reddit::Client::Request->token_request($client_id, $secret, $username, $password, $self->{user_agent}); - my $j = JSON::decode_json($message); - $self->{token} = $j->{access_token}; - $self->{tokentype} = $j->{token_type}; - - if (!$self->{token}) { croak "Unable to get or parse token."; } -} - -sub json_request { - my ($self, $method, $path, $query, $post_data) = @_; - DEBUG('%4s JSON', $method); - - if ($method eq 'POST') { - $post_data ||= {}; - $post_data->{api_type} = 'json'; - } else { - #$path .= '.json'; # the oauth api returns json by default - } - - my $response = $self->request($method, $path, $query, $post_data); - my $json = JSON::from_json($response); - - if (ref $json eq 'HASH' && $json->{json}) { - my $result = $json->{json}; - if (@{$result->{errors}}) { - DEBUG('API Errors: %s', Dumper($result->{errors})); - my @errors = map { - sprintf '[%s] %s', $_->[0], $_->[1] - } @{$result->{errors}}; - croak sprintf("Error(s): %s", join('|', @errors)); - } else { - return $result; - } - } else { - return $json; - } -} - -sub api_json_request { - my ($self, %param) = @_; - my $args = $param{args} || []; - my $api = $param{api}; - my $data = $param{data}; - my $callback = $param{callback}; - - croak 'Expected "api"' unless defined $api; - - DEBUG('API call %d', $api); - - my $info = $API[$api] || croak "Unknown API: $api"; - my ($method, $path) = @$info; - $path = sprintf $path, @$args; - - my ($query, $post_data); - if ($method eq 'GET') { - $query = $data; - } else { - $post_data = $data; - } - - my $result = $self->json_request($method, $path, $query, $post_data); - - if (exists $result->{errors}) { - my @errors = @{$result->{errors}}; - - if (@errors) { - DEBUG("ERRORS: @errors"); - my $message = join(' | ', map { join(', ', @$_) } @errors); - croak $message; - } - } - - if (defined $callback && ref $callback eq 'CODE') { - return $callback->($result); - } else { - return $result; - } -} - -sub is_logged_in { - return defined $_[0]->{modhash}; -} - -sub require_login { - my $self = shift; - croak 'You must be logged in to perform this action' - unless $self->is_logged_in; -} - -sub save_session { - my ($self, $file) = @_; - $self->require_login; - $self->{session_file} || $file || croak 'Expected $file'; - - # Prepare session and file path - my $session = { modhash => $self->{modhash}, cookie => $self->{cookie} }; - my $file_path = File::Path::Expand::expand_filename( - defined $file ? $file : $self->{session_file} - ); - - DEBUG('Save session to %s', $file_path); - - # Write out session - open(my $fh, '>', $file_path) or croak $!; - print $fh JSON::to_json($session); - close $fh; - - # If session file was updated, replace the field - $self->{session_file} = $file_path; - - return 1; -} - -sub load_session { - my ($self, $file) = @_; - $self->{session_file} || $file || croak 'Expected $file'; - my $file_path = File::Path::Expand::expand_filename( - defined $file ? $file : $self->{session_file} - ); - - DEBUG('Load session from %s', $file_path); - - if (-f $file_path) { - open(my $fh, '<', $file_path) or croak $!; - my $data = do { local $/; <$fh> }; - close $fh; - - if ($data) { - my $session = JSON::from_json($data); - $self->{modhash} = $session->{modhash}; - $self->{cookie} = $session->{cookie}; - - DEBUG('Session loaded successfully'); - - return 1; - } else { - return 0; - } - } else { - DEBUG('Session file not found'); - return 0; - } -} - -#=============================================================================== -# User and account management -#=============================================================================== - -sub authenticate { - my ($self, $client_id, $client_secret) = @_; -} - -sub login { - my ($self, $usr, $pwd) = @_; - !$usr && croak 'Username expected'; - !$pwd && croak 'Password expected'; - - DEBUG('Log in user %s', $usr); - - my $result = $self->api_json_request( - api => API_LOGIN, - args => [$usr], - data => { user => $usr, passwd => $pwd }, - ); - - $self->{modhash} = $result->{data}{modhash}; - $self->{cookie} = $result->{data}{cookie}; - - return 1; -} - -sub me { - my $self = shift; - DEBUG('Request user account info'); - #$self->require_login; - my $result = $self->api_json_request(api => API_ME); - #return Reddit::Client::Account->new($self, $result->{data}); - return Reddit::Client::Account->new($self, $result); -} - -sub list_subreddits { - my ($self, $type) = @_; - DEBUG('List subreddits [%s]', $type); - defined $type || croak 'Expected $type"'; - - $self->require_login - if $type eq SUBREDDITS_MOD - || $type eq SUBREDDITS_MINE - || $type eq SUBREDDITS_CONTRIB; - - my $result = $self->api_json_request(api => API_SUBREDDITS, args => [$type]); - return { - map { $_->{data}{display_name} => Reddit::Client::SubReddit->new($self, $_->{data}) } - @{$result->{data}{children}} - }; -} - -sub mod_subreddits { $_[0]->require_login; return $_[0]->list_subreddits(SUBREDDITS_MOD) } -sub my_subreddits { $_[0]->require_login; return $_[0]->list_subreddits(SUBREDDITS_MINE) } -sub contrib_subreddits { $_[0]->require_login; return $_[0]->list_subreddits(SUBREDDITS_CONTRIB) } - -sub home_subreddits { return $_[0]->list_subreddits(SUBREDDITS_HOME) } -sub popular_subreddits { return $_[0]->list_subreddits(SUBREDDITS_POPULAR) } -sub new_subreddits { return $_[0]->list_subreddits(SUBREDDITS_NEW) } - -#=============================================================================== -# Finding subreddits and listings -#=============================================================================== - -sub info { - my ($self, $id) = @_; - DEBUG('Get info for id %s', $id); - defined $id || croak 'Expected $id'; - return $self->api_json_request(api => API_INFO, args => [$id]); -} - -sub find_subreddits { - my ($self, $query) = @_; - defined $query || croak 'Expected $query'; - DEBUG('Search subreddits: %s', $query); - my $result = $self->api_json_request(api => API_SEARCH, data => { q => $query }); - return { - map { $_->{data}{display_name} => Reddit::Client::SubReddit->new($self, $_->{data}) } - @{$result->{data}{children}} - }; -} - -sub fetch_links { - my ($self, %param) = @_; - my $subreddit = $param{subreddit} || ''; - my $view = $param{view} || VIEW_DEFAULT; - my $limit = $param{limit} || DEFAULT_LIMIT; - my $before = $param{before}; - my $after = $param{after}; - - DEBUG('Fetch %d link(s): %s/%s?before=%s&after=%s', $limit, $subreddit, $view, ($before || '-'), ($after || '-')); - - my $query = {}; - if ($before || $after || $limit) { # limit is always defined - $query->{limit} = $limit if defined $limit; - $query->{before} = $before if defined $before; - $query->{after} = $after if defined $after; - } - - $subreddit = subreddit($subreddit); - - my $args = [$view]; - unshift @$args, $subreddit if $subreddit; - - my $result = $self->api_json_request( - api => ($subreddit ? API_LINKS_FRONT : API_LINKS_OTHER), - args => $args, - data => $query, - ); - - return { - before => $result->{data}{before}, - after => $result->{data}{after}, - items => [ map {Reddit::Client::Link->new($self, $_->{data})} @{$result->{data}{children}} ], - }; -} - -sub get_subreddit_comments { - my ($self, %param) = @_; - my $subreddit = $param{subreddit} || ''; - my $view = $param{view} || VIEW_DEFAULT; - my $before = $param{before}; - my $after = $param{after}; - - my $query = {}; - $query->{before} = $before if defined $before; - $query->{after} = $after if defined $after; - # if limit exists but is false (for "no limit"), get as many as possible - # this will probably be 100 but ask for a ridiculous amount anyway - # if we don't provide a limit, Reddit will give us 25 - if (exists $param{limit}) { - $query->{limit} = $param{limit} || 500; - } else { - $query->{limit} = 25; - } - - $subreddit = subreddit($subreddit); # remove slashes and leading r/ - my $args = [$view]; - unshift @$args, $subreddit if $subreddit; - - my $result = $self->api_json_request( - api => ($subreddit ? API_COMMENTS : API_COMMENTS_FRONT), - args => $args, - data => $query, - ); - - return { - before => $result->{data}{before}, - after => $result->{data}{after}, - items => [ map {Reddit::Client::Comment->new($self, $_->{data})} @{$result->{data}{children}} ], - }; -} - -#=============================================================================== -# Deleting stories or comments -#=============================================================================== - -# TODO unit test -sub delete_item { - my ($self, %param) = @_; - my $name = $param{name} || croak 'Expected "name"'; - $self->require_login; - - DEBUG('Delete post/comment %s', $name); - - my $result = $self->api_json_request(api => API_DEL, data => { id => $name }); - return 1; -} - -#=============================================================================== -# Submitting links -#=============================================================================== - -sub submit_link { - my ($self, %param) = @_; - my $subreddit = $param{subreddit} || ''; - my $title = $param{title} || croak 'Expected "title"'; - my $url = $param{url} || croak 'Expected "url"'; - $self->require_login; - - DEBUG('Submit link to %s: %s', $subreddit, $title, $url); - - $subreddit = subreddit($subreddit); - - my $result = $self->api_json_request(api => API_SUBMIT, data => { - title => $title, - url => $url, - sr => $subreddit, - kind => SUBMIT_LINK, - }); - - return $result->{data}{name}; -} - -sub submit_text { - my ($self, %param) = @_; - my $subreddit = $param{subreddit} || ''; - my $title = $param{title} || croak 'Expected "title"'; - my $text = $param{text} || croak 'Expected "text"'; - $self->require_login; - - DEBUG('Submit text to %s: %s', $subreddit, $title); - - $subreddit = subreddit($subreddit); - - my $result = $self->api_json_request(api => API_SUBMIT, data => { - title => $title, - text => $text, - sr => $subreddit, - kind => SUBMIT_SELF, - }); - - return $result->{data}{name}; -} - -#=============================================================================== -# Comments -#=============================================================================== - -sub get_comments { # currently broken - my ($self, %param) = @_; - my $permalink = $param{permalink} || croak 'Expected "permalink"'; - - DEBUG('Retrieve comments for %s', $permalink); - - my $result = $self->json_request('GET', $permalink); - my $comments = $result->[1]{data}{children}; - return [ map { Reddit::Client::Comment->new($self, $_->{data}) } @$comments ]; -} - -sub submit_comment { - my ($self, %param) = @_; - my $parent_id = $param{parent_id} || croak 'Expected "parent_id"'; - my $comment = $param{text} || croak 'Expected "text"'; - - DEBUG('Submit comment under %s', $parent_id); - - $self->require_login; - my $result = $self->api_json_request(api => API_COMMENT, data => { - thing_id => $parent_id, - text => $comment, - }); - - return $result->{data}{things}[0]{data}{id}; -} - -#=============================================================================== -# Private messages -#=============================================================================== - -sub send_message { - my ($self, %param) = @_; - my $to = $param{to} || croak 'Expected "to"'; - my $subject = $param{subject} || croak 'Expected "subject"'; - my $text = $param{text} || croak 'Expected "text"'; - - croak '"subject" cannot be longer than 100 characters' if length $subject > 100; - - #$self->require_login; - DEBUG('Submit message to %s: %s', $to, $subject); - - my $result = $self->api_json_request(api => API_MESSAGE, data => { - to => $to, - subject => $subject, - text => $text, - kind => SUBMIT_MESSAGE, - }); - - return $result; -} - -#=============================================================================== -# Voting -#=============================================================================== - -sub vote { - my ($self, $name, $direction) = @_; - defined $name || croak 'Expected $name'; - defined $direction || croak 'Expected $direction'; - DEBUG('Vote %d for %s', $direction, $name); - croak 'Invalid vote direction' unless "$direction" =~ /^(-1|0|1)$/; - $self->require_login; - $self->api_json_request(api => API_VOTE, data => { dir => $direction, id => $name }); -} - -#=============================================================================== -# Saving and hiding -#=============================================================================== - -sub save { - my $self = shift; - my $name = shift || croak 'Expected $name'; - DEBUG('Save %s', $name); - $self->require_login; - $self->api_json_request(api => API_SAVE, data => { id => $name }); -} - -sub unsave { - my $self = shift; - my $name = shift || croak 'Expected $name'; - DEBUG('Unsave %s', $name); - $self->require_login; - $self->api_json_request(api => API_UNSAVE, data => { id => $name }); -} - -sub hide { - my $self = shift; - my $name = shift || croak 'Expected $name'; - DEBUG('Hide %s', $name); - $self->require_login; - $self->api_json_request(api => API_HIDE, data => { id => $name }); -} - -sub unhide { - my $self = shift; - my $name = shift || croak 'Expected $name'; - DEBUG('Unhide %s', $name); - $self->require_login; - $self->api_json_request(api => API_UNHIDE, data => { id => $name }); -} - -1; - -__END__ - -=pod - -=head1 NAME - -Reddit::Client - A perl wrapper for Reddit - -=head1 SYNOPSIS - - use Reddit::Client; - - my $session_file = '~/.reddit'; - my $reddit = Reddit::Client->new( - session_file => $session_file, - user_agent => 'MyApp/1.0', - ); - - unless ($reddit->is_logged_in) { - $reddit->login('someone', 'secret'); - $reddit->save_session(); - } - - $reddit->submit_link( - subreddit => 'perl', - title => 'Perl is still alive!', - url => 'http://www.perl.org' - ); - - my $links = $reddit->fetch_links(subreddit => '/r/perl', limit => 10); - foreach (@{$links->{items}}) { - ... - } - -=head1 DESCRIPTION - -Reddit::Client provides methods and simple object wrappers for objects exposed -by the Reddit API. This module handles HTTP communication, basic session -management (e.g. storing an active login session), and communication with -Reddit's external API. - -For more information about the Reddit API, see L. - -=head1 CONSTANTS - - VIEW_HOT "Hot" links feed - VIEW_NEW "New" links feed - VIEW_CONTROVERSIAL "Controversial" links feed - VIEW_TOP "Top" links feed - - VIEW_DEFAULT Default feed if not specified (VIEW_HOT) - DEFAULT_LIMIT The default number of links to be retried (25) - - VOTE_UP Up vote - VOTE_DOWN Down vote - VOTE_NONE "Un" vote - - SUBREDDITS_HOME List reddits on the homepage - SUBREDDITS_POPULAR List popular reddits - SUBREDDITS_NEW List new reddits - SUBREDDITS_MINE List reddits for which the logged in user is subscribed - SUBREDDITS_CONTRIB List reddits for which the logged in user is a contributor - SUBREDDITS_MOD List reddits for which the logged in user is a moderator - -=head1 GLOBALS - -=over - -=item $UA - -This is the user agent string, and defaults to C. -NOTE: This is now deprecated in favor of the user_agent argument to new(). - - -=item $DEBUG - -When set to true, outputs a small amount of debugging information. - - -=back - -=head1 SUBROUTINES/METHODS - -=over - -=item new(user_agent => ..., session_file => ...) - -Begins a new or loads an existing reddit session. The C argument -will be required in a future release. Omitting it will generate a warning. -If C is provided, it will be read and parsed as JSON. If -session data is found, it is restored. Otherwise, a new session is started. -Session data does not restore the user_agent string of the original session. - -=item is_logged_in - -Returns true(ish) if there is an active login session. No attempt is made to -validate the current session against the server. - - -=item save_session($path) - -Saves the current session to C<$path>. Throws an error if the user is not logged -in. C<$path> is only required if the Reddit::Client instance was created without -the C parameter. - - -=item load_session($path) - -Attempts to load the session from C<$path>. When successful, returns true and -stores the session file path for future use. - - -=item login($usr, $pwd) - -Attempts to log the user in. Throws an error on failure. - - -=item me - -Returns a Reddit::Client::Account object. - - -=item list_subreddits($type) - -Returns a list of Reddit::Client::SubReddit objects for C<$type>, where C<$type> -is a C constant. - - -=item my_subreddits - -Syntactic sugar for C. Throws an error if -the user is not logged in. - - -=item home_subreddits - -Syntactic sugar for C. Throws an error if -the user is not logged in. - - -=item mod_subreddits - -Syntactic sugar for C. Throws an error if -the user is not logged in. - - -=item contrib_subreddits - -Syntactic sugar for C. - - -=item popular_subreddits - -Syntactic sugar for C. - - -=item new_subreddits - -Syntactic sugar for C. - - -=item info($item_id) - -Returns a has of information about C<$item_id>, which must be a complete name -(e.g., t3_xxxxx). - - -=item find_subreddits($query) - -Returns a list of SubReddit objects matching C<$query>. - - -=item fetch_links(subreddit => ..., view => ..., limit => ..., before => ..., after => ...) - -Returns a list of links from a reddit page. If C is specified, -the list of links is returned from the desired subreddit. Otherwise, the -links will be from the front page. C specifieds the feed (e.g. -C or C). C may be used to limit the number of -objects returned, and C and C denote the placeholders for -slicing the feed up, just as the reddit urls themselves do. Data is returned -as a hash with three keys, I, I, and I. - - -=item delete_item(name => ...) - -Deletes a post or comment. The object's full name is required. - - -=item submit_link(subreddit => ..., title => ..., url => ...) - -Submits a link to a reddit. Returns the id of the new link. - - -=item submit_text(subreddit => ..., title => ..., text => ...) - -Submits a self-post to a reddit. Returns the id of the new post. - - -=item get_comments($permalink) - -Returns a list ref of Reddit::Client::Comment objects underneath the -the specified URL C<$permalink>. Unfortunately, this is the only -method available via the API. Comments may be more easily accessed -via the Link object, which implicitly provides the C<$permalink> -parameter. - - my $links = $reddit->fetch_links(...); - foreach (@{$links->{items}}) { - my $comments = $_->comments(); - } - - -=item submit_comment(parent_id => ..., text => ...) - -Submits a new comment underneath C. - - -=item vote(item_id => ..., direction => ...) - -Votes for C. C is one of C, C, -or C. - - -=item save($item_id) - -Saves C<$item_id> under the user's account. - - -=item unsave($item_id) - -Unsaves C<$item_id> under the user's account. - - -=item hide($item_id) - -Hides $. Throws an error if the user does not have permission to hide -the item in question. - - -=item unhide($item_id) - -Unhides $. Throws an error if the user does not have permission to -unhide the item in question. - - -=back - -=head1 INTERNAL ROUTINES - -=over - -=item DEBUG - -When C<$Reddit::Client::DEBUG> is true, acts as syntactic sugar for -warn(sprintf(@_)). Used to provided logging. - - -=item require_login - -Throws an error if the user is not logged in. - - -=item subreddit - -Strips slashes and leading /r from a subreddit to ensure that only -the "display name" of the subreddit is returned. - - -=item request - -Performs a request to reddit's servers using LWP. If the user is -logged in, adds the "uh" and "modhash" parameters to POST queries -as well as adding the reddit-specified cookie value for reddit_session. - - -=item json_request - -Wraps C, configuring the parameters to perform the request -with an api_type of "json". After the request is complete, parses the -JSON result and throws and error if one is specified in the result -contents. Otherwise, returns the json data portion of the result. - - -=item api_json_request - -Wraps C, getting method and path from an API_CONSTANT. - - -=back - -=head1 AUTHOR - -Jeff Ober L - -=head1 LICENSE - -BSD license - -=cut diff --git a/lib/Reddit/Client/Account.pm b/lib/Reddit/Client/Account.pm deleted file mode 100644 index 8e196d1..0000000 --- a/lib/Reddit/Client/Account.pm +++ /dev/null @@ -1,35 +0,0 @@ -package Reddit::Client::Account; - -use strict; -use warnings; -use Carp; - -require Reddit::Client::Thing; - -use base qw/Reddit::Client::Thing/; -use fields qw/has_mail created modhash created_utc link_karma over_18 - comment_karma is_gold is_mod has_mod_mail/; - -1; - -__END__ - -=pod - -=head1 NAME - -Reddit::Client::Account - -=head1 DESCRIPTION - -Stores information about the logged in user account. - -=head1 AUTHOR - -Jeff Ober L - -=head1 LICENSE - -BSD license - -=cut diff --git a/lib/Reddit/Client/Comment.pm b/lib/Reddit/Client/Comment.pm deleted file mode 100644 index 0de837a..0000000 --- a/lib/Reddit/Client/Comment.pm +++ /dev/null @@ -1,81 +0,0 @@ -package Reddit::Client::Comment; - -use strict; -use warnings; -use Carp; - -require Reddit::Client::VotableThing; - -use base qw/Reddit::Client::VotableThing/; -use fields qw/link_flair_text media url link_flair_css_class num_reports created_utc - banned_by subreddit title author_flair_text is_self author media_embed - permalink author_flair_css_class selftext domain num_comments clicked - saved thumbnail subreddit_id approved_by selftext_html created hidden - over_18 parent_id replies link_id body body_html/; - -sub set_replies { - my ($self, $value) = @_; - if (ref $value && exists $value->{data}{children}) { - $self->{replies} = [ map { Reddit::Client::Comment->new($self->{session}, $_->{data}) } @{$value->{data}{children}} ]; - } else { - $self->{replies} = []; - } -} - -sub replies { - return shift->{replies}; -} - -sub reply { - my $self = shift; - return $self->SUPER::submit_comment(@_); -} - -1; - -__END__ - -=pod - -=head1 NAME - -Reddit::Client::Comment - -=head1 DESCRIPTION - -Wraps a posted comment. - -=head1 SUBROUTINES/METHODS - -=over - -=item replies() - -Returns a list ref of replies underneath this comment. - -=item reply(...) - -Syntactic sugar for C. - -=back - -=head1 INTERNAL ROUTINES - -=over - -=item set_replies - -Wraps the list of children in Comment class instances and ensures that comments -with no replies return an empty array for C. - -=back - -=head1 AUTHOR - -Jeff Ober L - -=head1 LICENSE - -BSD license - -=cut diff --git a/lib/Reddit/Client/Link.pm b/lib/Reddit/Client/Link.pm deleted file mode 100644 index 20ebd28..0000000 --- a/lib/Reddit/Client/Link.pm +++ /dev/null @@ -1,53 +0,0 @@ -package Reddit::Client::Link; - -use strict; -use warnings; -use Carp; - -require Reddit::Client::VotableThing; - -use base qw/Reddit::Client::VotableThing/; -use fields qw/link_flair_text media url link_flair_css_class num_reports - created_utc banned_by subreddit title author_flair_text is_self - author media_embed author_flair_css_class selftext domain - num_comments clicked saved thumbnail subreddit_id approved_by - selftext_html created hidden over_18 permalink/; - -sub comments { - my $self = shift; - return $self->{session}->get_comments(permalink => $self->{permalink}); -} - -1; - -__END__ - -=pod - -=head1 NAME - -Reddit::Client::Link - -=head1 DESCRIPTION - -Wraps a posted link or "self-post". - -=head1 SUBROUTINES/METHODS - -=over - -=item comments() - -Wraps C, implicitly providing the permalink parameter. - -=back - -=head1 AUTHOR - -Jeff Ober L - -=head1 LICENSE - -BSD license - -=cut diff --git a/lib/Reddit/Client/Request.pm b/lib/Reddit/Client/Request.pm deleted file mode 100644 index d85d557..0000000 --- a/lib/Reddit/Client/Request.pm +++ /dev/null @@ -1,178 +0,0 @@ -package Reddit::Client::Request; - -use strict; -use warnings; -use Carp; - -use LWP::UserAgent qw//; -use HTTP::Request qw//; -use URI::Encode qw/uri_encode/; - -require Reddit::Client; - -use fields ( - 'user_agent', - 'method', - 'url', - 'query', - 'post_data', - 'cookie', - 'modhash', - 'token', - 'tokentype' -); - -sub new { - my ($class, %param) = @_; - my $self = fields::new($class); - $self->{user_agent} = $param{user_agent} || croak 'Expected "user_agent"'; - $self->{url} = $param{url} || croak 'Expected "url"'; - $self->{query} = $param{query}; - $self->{post_data} = $param{post_data}; - $self->{cookie} = $param{cookie}; - $self->{modhash} = $param{modhash}; - $self->{token} = $param{token}; - $self->{tokentype} = $param{tokentype}; - - if (defined $self->{query}) { - ref $self->{query} eq 'HASH' || croak 'Expected HASH ref for "query"'; - $self->{url} = sprintf('%s?%s', $self->{url}, build_query($self->{query})) - } - - if (defined $self->{post_data}) { - ref $self->{post_data} eq 'HASH' || croak 'Expected HASH ref for "post_data"'; - } - - $self->{method} = $param{method} || 'GET'; - $self->{method} = uc $self->{method}; - - return $self; -} - -sub build_query { - my $param = shift or return ''; - my $opt = { encode_reserved => 1 }; - join '&', map {uri_encode($_, $opt) . '=' . uri_encode($param->{$_}, $opt)} sort keys %$param; -} - -sub build_request { - my $self = shift; - my $request = HTTP::Request->new(); - - $request->uri($self->{url}); - #$request->header('Cookie', sprintf('reddit_session=%s', $self->{cookie})) - # if $self->{cookie}; - $request->header("Authorization"=> "$self->{tokentype} $self->{token}"); - - if ($self->{method} eq 'POST') { - my $post_data = $self->{post_data} || {}; - $post_data->{modhash} = $self->{modhash} if $self->{modhash}; - $post_data->{uh} = $self->{modhash} if $self->{modhash}; - - $request->method('POST'); - $request->content_type('application/x-www-form-urlencoded'); - $request->content(build_query($post_data)); - } else { - $request->method('GET'); - } - - return $request; -} - -sub send { - my $self = shift; - my $request = $self->build_request; - - Reddit::Client::DEBUG('%4s request to %s', $self->{method}, $self->{url}); - - my $ua = LWP::UserAgent->new(agent => $self->{user_agent}, env_proxy => 1); - #print $request->as_string."\n"; - my $res = $ua->request($request); - - if ($res->is_success) { - return $res->content; - } else { - croak sprintf('Request error: HTTP %s', $res->status_line); - } -} - -sub token_request { - my ($self, $client_id, $secret, $username, $password, $useragent) = @_; - - my $url = "https://$client_id:$secret\@www.reddit.com/api/v1/access_token"; - - my $ua = LWP::UserAgent->new(user_agent => $useragent); - my $req = HTTP::Request->new(POST => $url); - $req->header('content-type' => 'application/x-www-form-urlencoded'); - - my $postdata = "grant_type=password&username=$username&password=$password"; - $req->content($postdata); - - my $res = $ua->request($req); - - if ($res->is_success) { - return $res->decoded_content; - } else { - croak sprintf('Request error: HTTP %s', $res->status_line); - } -} - -1; - -__END__ - -=pod - -=head1 NAME - -Reddit::Client::Request - -=head1 DESCRIPTION - -HTTP request driver for Reddit::Client. Uses LWP to perform GET and POST requests -to the reddit.com servers. This module is used internally by the Reddit::Client -and is not designed for external use. - -=head1 SUBROUTINES/METHODS - -=over - -=item new(%params) - -Creates a new Reddit::Request::API instance. Parameters: - - user_agent User agent string - url Target URL - query Hash of query parameters - post_data Hash of POST parameters - cookie Reddit session cookie - modhash Reddit session modhash - - -=item build_query($query) - -Builds a URI-escaped query string from a hash of query parameters. This is *not* -a method of the class, but a package routine. - - -=item build_request - -Builds an HTTP::Request object for LWP::UserAgent. - - -=item send - -Performs the HTTP request and returns the result. Croaks on HTTP error. - - -=back - -=head1 AUTHOR - -Jeff Ober L - -=head1 LICENSE - -BSD license - -=cut diff --git a/lib/Reddit/Client/SubReddit.pm b/lib/Reddit/Client/SubReddit.pm deleted file mode 100644 index 3cc5b9d..0000000 --- a/lib/Reddit/Client/SubReddit.pm +++ /dev/null @@ -1,68 +0,0 @@ -package Reddit::Client::SubReddit; - -use strict; -use warnings; -use Carp; - -require Reddit::Client::Thing; - -use base qw/Reddit::Client::Thing/; -use fields qw/over18 header_img created_utc header_title header_size - description display_name created url title subscribers - public_description/; - -sub links { - my ($self, %param) = @_; - return $self->{session}->fetch_links(subreddit => $self->{url}, %param); -} - -sub submit_link { - my ($self, $title, $url) = @_; - $self->{session}->submit_link(title => $title, url => $url, sr => $self->{title}, kind => 'link'); -} - -sub submit_text { - my ($self, $title, $text) = @_; - $self->{session}->submit_text(title => $title, text => $text, sr => $self->{title}, kind => 'text'); -} - -1; -__END__ - -=pod - -=head1 NAME - -Reddit::Client::SubReddit - -=head1 DESCRIPTION - -Provides convenience methods for interacting with SubReddits. - -=head1 SUBROUTINES/METHODS - -=over - -=item links(...) - -Wraps C, providing the subreddit parameter implicitly. - -=item submit_link($title, $url) - -Wraps C, providing the subreddit parameter implicitly. - -=item submit_text($title, $text) - -Wraps C, providing the subreddit parameter implicitly. - -=back - -=head1 AUTHOR - -Jeff Ober L - -=head1 LICENSE - -BSD license - -=cut diff --git a/lib/Reddit/Client/Thing.pm b/lib/Reddit/Client/Thing.pm deleted file mode 100644 index 1789f92..0000000 --- a/lib/Reddit/Client/Thing.pm +++ /dev/null @@ -1,115 +0,0 @@ -package Reddit::Client::Thing; - -use strict; -use warnings; -use Carp; - -use List::Util qw/first/; - -our @BOOL_FIELDS = qw/is_self likes clicked saved hidden over_18 over18 - has_mail has_mod_mail is_mod is_gold/; - - -use fields qw/session name id/; - -sub new { - my ($class, $reddit, $source_data) = @_; - my $self = fields::new($class); - $self->{session} = $reddit; - $self->load_from_source_data($source_data) if $source_data; - return $self; -} - -sub load_from_source_data { - require Reddit::Client; - - my ($self, $source_data) = @_; - if ($source_data) { - foreach my $field (keys %$source_data) { - # Set data fields - my $setter = sprintf 'set_%s', $field; - if ($self->can($setter)) { - $self->can($setter)->($self, $source_data->{$field}); - } elsif (first {$_ eq $field} @BOOL_FIELDS) { - $self->set_bool($field, $source_data->{$field}); - } else { - eval { $self->{$field} = $source_data->{$field} }; - Reddit::Client::DEBUG("Field %s is missing from package %s\n", $field, ref $self) - if $@; - } - - # Add getter for field - my $getter = sub { $_[0]->{$field} }; - my $class = ref $self; - my $method = sprintf '%s::get_%s', $class, $field; - - unless ($self->can($method)) { - no strict 'refs'; - *{$method} = \&$getter; - } - } - } -} - -sub set_bool { - my ($self, $field, $value) = @_; - $self->{$field} = $value ? 1 : 0; -} - -1; - -__END__ - -=pod - -=head1 NAME - -Reddit::Client::Thing - -=head1 DESCRIPTION - -A "Thing" is the base class of all Reddit objects. Do not blame the author -for this. This is specified by the API documentation. The author just -perpetuated it. - -Generally, consumers of the Reddit::Client module do not instantiate these -objects directly. Things offer a bit of syntactic sugar around the data -returned by reddit's servers, such as the ability to comment directly on -a Link object. - -=head1 SUBROUTINES/METHODS - -=over - -=item new($session, $data) - -Creates a new Thing. C<$session> must be an instance of Reddit::Client. -C<$data>, when present, must be a hash reference of key/value pairs. - -=back - -=head1 INTERNAL ROUTINES - -=over - -=item set_bool($field, $value) - -Sets a field to a boolean value of 1 or 0, rather than the JSON -module's boolean type. - -=item load_from_source_data($data) - -Populates an instances field with data directly from JSON data returned -by reddit's servers. - -=back - -=head1 AUTHOR - -Jeff Ober L - -=head1 LICENSE - -BSD license - -=cut diff --git a/lib/Reddit/Client/VotableThing.pm b/lib/Reddit/Client/VotableThing.pm deleted file mode 100644 index f6c6eb8..0000000 --- a/lib/Reddit/Client/VotableThing.pm +++ /dev/null @@ -1,100 +0,0 @@ -package Reddit::Client::VotableThing; - -use strict; -use warnings; -use Carp; - -require Reddit::Client::Thing; - -use base qw/Reddit::Client::Thing/; -use fields qw/ups downs likes score edited/; - -# likes may be true, false, or null, based on user vote -sub set_likes { - my ($self, $value) = @_; - $self->set_bool('likes', $value) if defined $value; -} - -sub vote { - my ($self, $direction) = @_; - $self->{session}->vote($self->{name}, $direction); -} - -sub comment { - my ($self, $comment) = @_; - $self->{session}->submit_comment(parent_id => $self->{name}, text => $comment); -} - -sub save { - my $self = shift; - $self->{session}->save($self->{name}); -} - -sub unsave { - my $self = shift; - $self->{session}->unsave($self->{name}); -} - -sub hide { - my $self = shift; - $self->{session}->hide($self->{name}); -} - -sub unhide { - my $self = shift; - $self->{session}->unhide($self->{name}); -} - -1; - -__END__ - -=pod - -=head1 NAME - -Reddit::Client::VotableThing - -=head1 DESCRIPTION - -A Thing object, such as a Comment or Link, that may be voted on, -commented against, hidden, or saved. - -=head1 SUBROUTINES/METHODS - -=over - -=item vote($direction) - -=item comment($text) - -=item save() - -=item unsave() - -=item hide() - -=item unhide() - -=back - -=head1 INTERNAL ROUTINES - -=over - -=item set_likes - -Conditionally sets the value of "likes" since it may validly be true, false, or -neither, in the case of no vote being cast. - -=back - -=head1 AUTHOR - -Jeff Ober L - -=head1 LICENSE - -BSD license - -=cut diff --git a/t/request.t b/t/request.t index 5566e1a..47dfd69 100644 --- a/t/request.t +++ b/t/request.t @@ -3,7 +3,7 @@ use warnings; use Carp; use HTTP::Response; use Test::MockModule; -use Test::More tests => 16; +use Test::More tests => 15; use Reddit::Client::Request; @@ -43,7 +43,7 @@ my $rq = Reddit::Client::Request->new( ok($request->method eq 'POST', 'build_request'); ok($request->uri eq 'http://www.example.com?foo=bar', 'build_request'); ok($request->content eq 'baz=bat&modhash=test&uh=test', 'build_request'); - ok($request->header('Cookie') eq 'reddit_session=test', 'build_request'); + #ok($request->header('Cookie') eq 'reddit_session=test', 'build_request'); ok($request->content_type eq 'application/x-www-form-urlencoded', 'build_request'); } @@ -63,4 +63,4 @@ my $rq = Reddit::Client::Request->new( $lwp->unmock_all; } -1; \ No newline at end of file +1; diff --git a/unit_tests b/unit_tests deleted file mode 100755 index cf62bc7..0000000 --- a/unit_tests +++ /dev/null @@ -1,74 +0,0 @@ -#!/usr/bin/perl - -use warnings; use strict; use v5.14; use lib '/home/bubs/perl/lib'; -use Reddit::Client; -use Test::Simple tests => 7; -use Data::Dumper; - - -# Account and oauth details ############################3 -my $client_id = ''; -my $secret = ''; -my $user = ''; -my $pass = ''; -########################################################3 - -# -# Reddit::Client Object -# -my $reddit = new Reddit::Client( - session_file => '/home/bubs/perl/reddit/session_data.json', - user_agent => 'inboxcheck', -); - -$reddit->get_token($client_id, $secret, $user, $pass); - - -print "Create Reddit::Client object: "; -ok(ref $reddit eq 'Reddit::Client'); - -print "Token exists: "; -ok($reddit->{token}); - -# -# me() -# -my $me = $reddit->me(); -print "me(): "; -ok(ref $me eq 'Reddit::Client::Account'); - -# -# send_message() -# -my $result = $reddit->send_message( - to=>'earth-tone', - subject=>'test msg'.time, - text=>'test'.time); - -print "send_message(): "; -ok(!scalar @{$result->{errors}}); - -# -# get_subreddit_comments() -# -my $sub = "test+all"; -my $limit = 5; - -my $cmts = $reddit->get_subreddit_comments( - subreddit=>$sub, - limit=>$limit); - -print "get_subreddit_comments():\n"; -print " provided subreddit and limit: "; -ok($cmts); - -$cmts = $reddit->get_subreddit_comments( - limit=>$limit); -print " no sub provided: "; -ok($cmts); - - -$cmts = $reddit->get_subreddit_comments(); - -print " no limit or sub provided: "; -ok($cmts); From d0c0d80013550ca0db4e9774cff74c1ddb7bd284 Mon Sep 17 00:00:00 2001 From: earth-tone Date: Sun, 30 Aug 2015 10:17:41 -0400 Subject: [PATCH 15/16] readme --- lib/Reddit/Client.pm | 1027 +++++++++++++++++++++++++++++ lib/Reddit/Client/Account.pm | 37 ++ lib/Reddit/Client/Comment.pm | 83 +++ lib/Reddit/Client/Link.pm | 55 ++ lib/Reddit/Client/Request.pm | 181 +++++ lib/Reddit/Client/SubReddit.pm | 70 ++ lib/Reddit/Client/Thing.pm | 117 ++++ lib/Reddit/Client/VotableThing.pm | 100 +++ 8 files changed, 1670 insertions(+) create mode 100755 lib/Reddit/Client.pm create mode 100644 lib/Reddit/Client/Account.pm create mode 100644 lib/Reddit/Client/Comment.pm create mode 100644 lib/Reddit/Client/Link.pm create mode 100755 lib/Reddit/Client/Request.pm create mode 100644 lib/Reddit/Client/SubReddit.pm create mode 100644 lib/Reddit/Client/Thing.pm create mode 100644 lib/Reddit/Client/VotableThing.pm diff --git a/lib/Reddit/Client.pm b/lib/Reddit/Client.pm new file mode 100755 index 0000000..5df627c --- /dev/null +++ b/lib/Reddit/Client.pm @@ -0,0 +1,1027 @@ +package Reddit::Client; + +our $VERSION = '0.93'; +$VERSION = eval $VERSION; + +use strict; +use warnings; +use Carp; + +use Data::Dumper qw/Dumper/; +use JSON qw//; +use File::Spec qw//; +use Digest::MD5 qw/md5_hex/; +use POSIX qw/strftime/; +use File::Path::Expand qw//; + +require Reddit::Client::Account; +require Reddit::Client::Comment; +require Reddit::Client::Link; +require Reddit::Client::SubReddit; +require Reddit::Client::Request; + +#=============================================================================== +# Constants +#=============================================================================== + +use constant DEFAULT_LIMIT => 25; + +use constant VIEW_HOT => ''; +use constant VIEW_NEW => 'new'; +use constant VIEW_CONTROVERSIAL => 'controversial'; +use constant VIEW_TOP => 'top'; +use constant VIEW_RISING => 'rising'; +use constant VIEW_DEFAULT => VIEW_HOT; + +use constant VOTE_UP => 1; +use constant VOTE_DOWN => -1; +use constant VOTE_NONE => 0; + +use constant SUBMIT_LINK => 'link'; +use constant SUBMIT_SELF => 'self'; +use constant SUBMIT_MESSAGE => 'message'; + +use constant API_ME => 0; +use constant API_INFO => 1; +use constant API_SEARCH => 2; +use constant API_LOGIN => 3; +use constant API_SUBMIT => 4; +use constant API_COMMENT => 5; +use constant API_VOTE => 6; +use constant API_SAVE => 7; +use constant API_UNSAVE => 8; +use constant API_HIDE => 9; +use constant API_UNHIDE => 10; +use constant API_SUBREDDITS => 11; +use constant API_LINKS_FRONT => 12; +use constant API_LINKS_OTHER => 13; +use constant API_DEL => 14; +use constant API_MESSAGE => 15; +use constant API_COMMENTS_FRONT => 16; +use constant API_COMMENTS => 17; + +use constant SUBREDDITS_HOME => ''; +use constant SUBREDDITS_MINE => 'mine'; +use constant SUBREDDITS_POPULAR => 'popular'; +use constant SUBREDDITS_NEW => 'new'; +use constant SUBREDDITS_CONTRIB => 'contributor'; +use constant SUBREDDITS_MOD => 'moderator'; + +#=============================================================================== +# Parameters +#=============================================================================== + +our $DEBUG = 0; +our $BASE_URL = 'https://oauth.reddit.com'; +our $LINK_URL = 'https://www.reddit.com'; +our $UA = sprintf 'Reddit::Client/%f', $VERSION; + +our @API; +$API[API_ME ] = ['GET', '/api/v1/me' ]; +$API[API_INFO ] = ['GET', '/api/info' ]; +#$API[API_INFO ] = ['GET', '/by_id/%s' ]; +$API[API_SEARCH ] = ['GET', '/reddits/search']; +$API[API_LOGIN ] = ['POST', '/api/login/%s' ]; +$API[API_SUBMIT ] = ['POST', '/api/submit' ]; +$API[API_COMMENT ] = ['POST', '/api/comment' ]; +$API[API_VOTE ] = ['POST', '/api/vote' ]; +$API[API_SAVE ] = ['POST', '/api/save' ]; +$API[API_UNSAVE ] = ['POST', '/api/unsave' ]; +$API[API_HIDE ] = ['POST', '/api/hide' ]; +$API[API_UNHIDE ] = ['POST', '/api/unhide' ]; +$API[API_SUBREDDITS ] = ['GET', '/reddits/%s' ]; +$API[API_LINKS_OTHER ] = ['GET', '/%s' ]; +$API[API_LINKS_FRONT ] = ['GET', '/r/%s/%s' ]; +$API[API_DEL ] = ['POST', '/api/del' ]; +$API[API_MESSAGE ] = ['POST', '/api/compose' ]; +$API[API_COMMENTS ] = ['GET', '/r/%s/comments' ]; +$API[API_COMMENTS_FRONT] = ['GET', '/comments' ]; +#=============================================================================== +# Package routines +#=============================================================================== + +sub DEBUG { + if ($DEBUG) { + my ($format, @args) = @_; + my $ts = strftime "%Y-%m-%d %H:%M:%S", localtime; + my $msg = sprintf $format, @args; + chomp $msg; + printf STDERR "[%s] [ %s ]\n", $ts, $msg; + } +} + +sub subreddit { + my $subject = shift; + $subject =~ s/^\/r//; # trim leading /r + $subject =~ s/^\///; # trim leading slashes + $subject =~ s/\/$//; # trim trailing slashes + + if ($subject !~ /\//) { # no slashes in name - it's probably good + if ($subject eq '') { # front page + return ''; + } else { # subreddit + return $subject; + } + } else { # fail + return; + } +} + +#=============================================================================== +# Class methods +#=============================================================================== + +use fields ( + 'modhash', # store session modhash + 'cookie', # store user cookie + 'session_file', # path to session file + 'user_agent', # user agent string + 'token', # oauth authorization token + 'tokentype', # unused but saved for reference + 'last_token', # time last token was acquired + 'client_id', # These 4 values saved for automatic token refreshing + 'secret', + 'username', + 'password', +); + +sub new { + my ($class, %param) = @_; + my $self = fields::new($class); + + if (not exists $param{user_agent}) { + carp "Reddit::Client->new: user_agent required in future version."; + $param{user_agent} = $UA; + } + $self->{user_agent} = $param{user_agent}; + + #if ($param{session_file}) { + # $self->{session_file} = $param{session_file}; + # $self->load_session; + #} + + if ($param{username} || $param{password} || $param{client_id} || $param{secret}) { + if (!$param{username} || !$param{password} || !$param{client_id} || !$param{secret}) { + croak "If any of username, password, client_id, or secret are provided, all are required."; + } else { + $self->get_token( + client_id => $param{client_id}, + secret => $param{secret}, + username => $param{username}, + password => $param{password}, + ); + } + } + + return $self; +} + +#=============================================================================== +# Internal management +#=============================================================================== + +sub request { + my ($self, $method, $path, $query, $post_data) = @_; + + if (!$self->{last_token} || $self->{last_token} <= time - 3600) { + $self->get_token(client_id=>$self->{client_id}, secret=>$self->{secret}, username=>$self->{username}, password=>$self->{password}); + } + + # Trim leading slashes off of the path + $path =~ s/^\/+//; + my $request = Reddit::Client::Request->new( + user_agent => $self->{user_agent}, + url => sprintf('%s/%s', $BASE_URL, $path), + method => $method, + query => $query, + post_data => $post_data, + modhash => $self->{modhash}, + cookie => $self->{cookie}, + token => $self->{token}, + tokentype => $self->{tokentype}, + ); + + return $request->send; +} + +sub get_token { + my ($self, %param) = @_; + $self->{client_id} = $param{client_id} || croak "need client_id"; + $self->{secret} = $param{secret} || croak "need secret"; + $self->{username} = $param{username} || croak "need username"; + $self->{password} = $param{password} || croak "need password"; + $self->{last_token} = time; + + my $message = Reddit::Client::Request->token_request($self->{client_id}, $self->{secret}, $self->{username}, $self->{password}, $self->{user_agent}); + my $j = JSON::decode_json($message); + $self->{token} = $j->{access_token}; + $self->{tokentype} = $j->{token_type}; + + if (!$self->{token}) { croak "Unable to get or parse token."; } +} + +# alias for get_token +sub authorize { + my ($self, %rest) = @_; + return $self->get_token(%rest); +} + +sub json_request { + my ($self, $method, $path, $query, $post_data) = @_; + DEBUG('%4s JSON', $method); + + if ($method eq 'POST') { + $post_data ||= {}; + $post_data->{api_type} = 'json'; + } else { + #$path .= '.json'; # the oauth api returns json by default + } + + my $response = $self->request($method, $path, $query, $post_data); + my $json = JSON::from_json($response); + #use Data::Dump::Color; + #dd $json; + + if (ref $json eq 'HASH' && $json->{json}) { + my $result = $json->{json}; + if (@{$result->{errors}}) { + DEBUG('API Errors: %s', Dumper($result->{errors})); + my @errors = map { + sprintf '[%s] %s', $_->[0], $_->[1] + } @{$result->{errors}}; + croak sprintf("Error(s): %s", join('|', @errors)); + } else { + return $result; + } + } else { + return $json; + } +} + +sub api_json_request { + my ($self, %param) = @_; + my $args = $param{args} || []; + my $api = $param{api}; + my $data = $param{data}; + my $callback = $param{callback}; + + croak 'Expected "api"' unless defined $api; + + DEBUG('API call %d', $api); + + my $info = $API[$api] || croak "Unknown API: $api"; + my ($method, $path) = @$info; + $path = sprintf $path, @$args; + + my ($query, $post_data); + if ($method eq 'GET') { + $query = $data; + } else { + $post_data = $data; + } + + my $result = $self->json_request($method, $path, $query, $post_data); + #use Data::Dump::Color; + #dd $result; + + if (exists $result->{errors}) { + my @errors = @{$result->{errors}}; + + if (@errors) { + DEBUG("ERRORS: @errors"); + my $message = join(' | ', map { join(', ', @$_) } @errors); + croak $message; + } + } + #use Data::Dump::Color; + #dd $result; + + if (defined $callback && ref $callback eq 'CODE') { + return $callback->($result); + } else { + return $result; + } +} + +sub is_logged_in { + return defined $_[0]->{modhash}; +} + +sub require_login { + my $self = shift; + return; + croak 'You must be logged in to perform this action' + unless $self->is_logged_in; +} + +sub save_session { + my ($self, $file) = @_; + $self->require_login; + $self->{session_file} || $file || croak 'Expected $file'; + + # Prepare session and file path + my $session = { modhash => $self->{modhash}, cookie => $self->{cookie} }; + my $file_path = File::Path::Expand::expand_filename( + defined $file ? $file : $self->{session_file} + ); + + DEBUG('Save session to %s', $file_path); + + # Write out session + open(my $fh, '>', $file_path) or croak $!; + print $fh JSON::to_json($session); + close $fh; + + # If session file was updated, replace the field + $self->{session_file} = $file_path; + + return 1; +} + +sub load_session { + my ($self, $file) = @_; + $self->{session_file} || $file || croak 'Expected $file'; + my $file_path = File::Path::Expand::expand_filename( + defined $file ? $file : $self->{session_file} + ); + + DEBUG('Load session from %s', $file_path); + + if (-f $file_path) { + open(my $fh, '<', $file_path) or croak $!; + my $data = do { local $/; <$fh> }; + close $fh; + + if ($data) { + my $session = JSON::from_json($data); + $self->{modhash} = $session->{modhash}; + $self->{cookie} = $session->{cookie}; + + DEBUG('Session loaded successfully'); + + return 1; + } else { + return 0; + } + } else { + DEBUG('Session file not found'); + return 0; + } +} + +#=============================================================================== +# User and account management +#=============================================================================== + +sub authenticate { + my ($self, $client_id, $client_secret) = @_; +} + +sub login { + my ($self, $usr, $pwd) = @_; + !$usr && croak 'Username expected'; + !$pwd && croak 'Password expected'; + + DEBUG('Log in user %s', $usr); + + my $result = $self->api_json_request( + api => API_LOGIN, + args => [$usr], + data => { user => $usr, passwd => $pwd }, + ); + + $self->{modhash} = $result->{data}{modhash}; + $self->{cookie} = $result->{data}{cookie}; + + return 1; +} + +sub me { + my $self = shift; + DEBUG('Request user account info'); + #$self->require_login; + my $result = $self->api_json_request(api => API_ME); + #return Reddit::Client::Account->new($self, $result->{data}); + return Reddit::Client::Account->new($self, $result); +} + +sub list_subreddits { + my ($self, $type) = @_; + DEBUG('List subreddits [%s]', $type); + defined $type || croak 'Expected $type"'; + + $self->require_login + if $type eq SUBREDDITS_MOD + || $type eq SUBREDDITS_MINE + || $type eq SUBREDDITS_CONTRIB; + + my $result = $self->api_json_request(api => API_SUBREDDITS, args => [$type]); + return { + map { $_->{data}{display_name} => Reddit::Client::SubReddit->new($self, $_->{data}) } + @{$result->{data}{children}} + }; +} + +sub mod_subreddits { $_[0]->require_login; return $_[0]->list_subreddits(SUBREDDITS_MOD) } +sub my_subreddits { $_[0]->require_login; return $_[0]->list_subreddits(SUBREDDITS_MINE) } +sub contrib_subreddits { $_[0]->require_login; return $_[0]->list_subreddits(SUBREDDITS_CONTRIB) } + +sub home_subreddits { return $_[0]->list_subreddits(SUBREDDITS_HOME) } +sub popular_subreddits { return $_[0]->list_subreddits(SUBREDDITS_POPULAR) } +sub new_subreddits { return $_[0]->list_subreddits(SUBREDDITS_NEW) } + +#=============================================================================== +# Finding subreddits and listings +#=============================================================================== + +sub info { + my ($self, $id) = @_; + DEBUG('Get info for id %s', $id); + defined $id || croak 'Expected $id'; + my $query->{id} = $id; + + my $info = $self->api_json_request( + api => API_INFO, + args => [$id], + data=>$query); + return $info->{data}->{children}[0]->{data}; +} + +# shortcut to get permalink from info() object +sub get_permalink { + # the naming convention is inconsistent here; a comment "id" has no + # prefix, and its "name" is the id prefixed with "t1_". All other ids + # have a prefix. + my ($self, $commentid, $link_id) = @_; + my $info = $self->info($link_id); + return sprintf "%s%s%s", $LINK_URL, $info->{permalink}, $commentid; +} + +sub find_subreddits { + my ($self, $query) = @_; + defined $query || croak 'Expected $query'; + DEBUG('Search subreddits: %s', $query); + my $result = $self->api_json_request(api => API_SEARCH, data => { q => $query }); + return { + map { $_->{data}{display_name} => Reddit::Client::SubReddit->new($self, $_->{data}) } + @{$result->{data}{children}} + }; +} + +sub fetch_links { + my ($self, %param) = @_; + my $subreddit = $param{subreddit} || ''; + my $view = $param{view} || VIEW_DEFAULT; + my $limit = $param{limit} || DEFAULT_LIMIT; + my $before = $param{before}; + my $after = $param{after}; + + DEBUG('Fetch %d link(s): %s/%s?before=%s&after=%s', $limit, $subreddit, $view, ($before || '-'), ($after || '-')); + + my $query = {}; + if ($before || $after || $limit) { # limit is always defined + $query->{limit} = $limit if defined $limit; + $query->{before} = $before if defined $before; + $query->{after} = $after if defined $after; + } + + $subreddit = subreddit($subreddit); + + my $args = [$view]; + unshift @$args, $subreddit if $subreddit; + + my $result = $self->api_json_request( + api => ($subreddit ? API_LINKS_FRONT : API_LINKS_OTHER), + args => $args, + data => $query, + ); + + return { + before => $result->{data}{before}, + after => $result->{data}{after}, + items => [ map {Reddit::Client::Link->new($self, $_->{data})} @{$result->{data}{children}} ], + }; +} + +sub get_subreddit_comments { + my ($self, %param) = @_; + my $subreddit = $param{subreddit} || ''; + my $view = $param{view} || VIEW_DEFAULT; + my $before = $param{before}; + my $after = $param{after}; + + my $query = {}; + $query->{before} = $before if defined $before; + $query->{after} = $after if defined $after; + # if limit exists but is false (for "no limit"), get as many as possible + # this will probably be 100 but ask for a ridiculous amount anyway + # if we don't provide a limit, Reddit will give us 25 + if (exists $param{limit}) { + $query->{limit} = $param{limit} || 500; + } else { + $query->{limit} = 25; + } + + $subreddit = subreddit($subreddit); # remove slashes and leading r/ + my $args = [$view]; + unshift @$args, $subreddit if $subreddit; + + my $result = $self->api_json_request( + api => ($subreddit ? API_COMMENTS : API_COMMENTS_FRONT), + args => $args, + data => $query, + ); + #use Data::Dump::Color; + #dd $result; + + return { + before => $result->{data}{before}, + after => $result->{data}{after}, + items => [ map {Reddit::Client::Comment->new($self, $_->{data})} @{$result->{data}{children}} ], + }; +} + +#=============================================================================== +# Deleting stories or comments +#=============================================================================== + +# TODO unit test +sub delete_item { + my ($self, %param) = @_; + my $name = $param{name} || croak 'Expected "name"'; + $self->require_login; + + DEBUG('Delete post/comment %s', $name); + + my $result = $self->api_json_request(api => API_DEL, data => { id => $name }); + return 1; +} + +#=============================================================================== +# Submitting links +#=============================================================================== + +sub submit_link { + my ($self, %param) = @_; + my $subreddit = $param{subreddit} || ''; + my $title = $param{title} || croak 'Expected "title"'; + my $url = $param{url} || croak 'Expected "url"'; + $self->require_login; + + DEBUG('Submit link to %s: %s', $subreddit, $title, $url); + + $subreddit = subreddit($subreddit); + + my $result = $self->api_json_request(api => API_SUBMIT, data => { + title => $title, + url => $url, + sr => $subreddit, + kind => SUBMIT_LINK, + }); + + return $result->{data}{name}; +} + +sub submit_text { + my ($self, %param) = @_; + my $subreddit = $param{subreddit} || ''; + my $title = $param{title} || croak 'Expected "title"'; + my $text = $param{text} || croak 'Expected "text"'; + $self->require_login; + + DEBUG('Submit text to %s: %s', $subreddit, $title); + + $subreddit = subreddit($subreddit); + + my $result = $self->api_json_request(api => API_SUBMIT, data => { + title => $title, + text => $text, + sr => $subreddit, + kind => SUBMIT_SELF, + }); + + return $result->{data}{name}; +} + +#=============================================================================== +# Comments +#=============================================================================== + +sub get_comments { # currently broken + my ($self, %param) = @_; + my $permalink = $param{permalink} || croak 'Expected "permalink"'; + + DEBUG('Retrieve comments for %s', $permalink); + + my $result = $self->json_request('GET', $permalink); + my $comments = $result->[1]{data}{children}; + return [ map { Reddit::Client::Comment->new($self, $_->{data}) } @$comments ]; +} + +sub submit_comment { + my ($self, %param) = @_; + my $parent_id = $param{parent_id} || croak 'Expected "parent_id"'; + my $comment = $param{text} || croak 'Expected "text"'; + + DEBUG('Submit comment under %s', $parent_id); + + $self->require_login; + my $result = $self->api_json_request(api => API_COMMENT, data => { + thing_id => $parent_id, + text => $comment, + }); + + return $result->{data}{things}[0]{data}{id}; +} + +#=============================================================================== +# Private messages +#=============================================================================== + +sub send_message { + my ($self, %param) = @_; + my $to = $param{to} || croak 'Expected "to"'; + my $subject = $param{subject} || croak 'Expected "subject"'; + my $text = $param{text} || croak 'Expected "text"'; + + croak '"subject" cannot be longer than 100 characters' if length $subject > 100; + + #$self->require_login; + DEBUG('Submit message to %s: %s', $to, $subject); + + my $result = $self->api_json_request(api => API_MESSAGE, data => { + to => $to, + subject => $subject, + text => $text, + kind => SUBMIT_MESSAGE, + }); + + return $result; +} + +#=============================================================================== +# Voting +#=============================================================================== + +sub vote { + my ($self, $name, $direction) = @_; + defined $name || croak 'Expected $name'; + defined $direction || croak 'Expected $direction'; + DEBUG('Vote %d for %s', $direction, $name); + croak 'Invalid vote direction' unless "$direction" =~ /^(-1|0|1)$/; + $self->require_login; + $self->api_json_request(api => API_VOTE, data => { dir => $direction, id => $name }); +} + +#=============================================================================== +# Saving and hiding +#=============================================================================== + +sub save { + my $self = shift; + my $name = shift || croak 'Expected $name'; + DEBUG('Save %s', $name); + $self->require_login; + $self->api_json_request(api => API_SAVE, data => { id => $name }); +} + +sub unsave { + my $self = shift; + my $name = shift || croak 'Expected $name'; + DEBUG('Unsave %s', $name); + $self->require_login; + $self->api_json_request(api => API_UNSAVE, data => { id => $name }); +} + +sub hide { + my $self = shift; + my $name = shift || croak 'Expected $name'; + DEBUG('Hide %s', $name); + $self->require_login; + $self->api_json_request(api => API_HIDE, data => { id => $name }); +} + +sub unhide { + my $self = shift; + my $name = shift || croak 'Expected $name'; + DEBUG('Unhide %s', $name); + $self->require_login; + $self->api_json_request(api => API_UNHIDE, data => { id => $name }); +} + +1; + +__END__ + +=pod + +=head1 NAME + +Reddit::Client - A perl wrapper for Reddit + +=head1 SYNOPSIS + + use Reddit::Client; + + # You'll need these 4 pieces of information for every script: + my $client_id = "DFhtrhBgfhhRTd"; + my $secret = "KrDNsbeffdbILOdgbgSvSBsbfFs"; + my $username = "reddit-username"; + my $password = "reddit-password"; + + + # Create a Reddit::Client object and authorize in one step + my $reddit = new Reddit::Client( + user_agent => 'MyScriptName 0.5 by /u/earth-tone', + client_id => $client_id, + secret => $secret, + username => $username, + password => $password, + ); + + # Or create object then authenticate. Useful if you need to authenticate more than once, for example if you were to check the inboxes of several accounts + my $reddit = Reddit::Client->new( + user_agent => 'MyApp/1.0', + ); + + # Get oauth token. This replaces the "login" method. + $reddit->authorize( + client_id => $client_id, + secret => $secret, + username => $username, + password => $password, + ); + + + $reddit->submit_link( + subreddit => 'perl', + title => 'Perl is still alive!', + url => 'http://www.perl.org' + ); + + my $links = $reddit->fetch_links(subreddit => '/r/perl', limit => 10); + foreach (@{$links->{items}}) { + ... + } + +=head1 DESCRIPTION + +Reddit::Client provides methods and simple object wrappers for objects exposed +by the Reddit API. This module handles HTTP communication, oauth session management, and communication with Reddit's external API. + +For more information about the Reddit API, see L. + +=head1 CONSTANTS + + VIEW_HOT "Hot" links feed + VIEW_NEW "New" links feed + VIEW_RISING "Rising" links feed + VIEW_CONTROVERSIAL "Controversial" links feed + VIEW_TOP "Top" links feed + + VIEW_DEFAULT Default feed if not specified (VIEW_HOT) + DEFAULT_LIMIT The default number of links to be retried (25) + + VOTE_UP Up vote + VOTE_DOWN Down vote + VOTE_NONE Remove any vote + + SUBREDDITS_HOME List reddits on the homepage + SUBREDDITS_POPULAR List popular reddits + SUBREDDITS_NEW List new reddits + SUBREDDITS_MINE List reddits for which the logged in user is subscribed + SUBREDDITS_CONTRIB List reddits for which the logged in user is a contributor + SUBREDDITS_MOD List reddits for which the logged in user is a moderator + +=head1 GLOBALS + +=over + + +=item $DEBUG + +When set to true, outputs a small amount of debugging information. + + +=back + +=head1 SUBROUTINES/METHODS + +=over + +=item new(user_agent => , [client_id =>, secret =>, username=>, password =>]) + +Begins a new reddit session. +If C is provided, it will be read and parsed as JSON. If +session data is found, it is restored. Otherwise, a new session is started. +Session data does not restore the user_agent string of the original session. + +=item authenticated + +Returns true if there is an oauth token. + + +=item save_session($path) + +Saves the current session to C<$path>. Throws an error if the user is not logged +in. C<$path> is only required if the Reddit::Client instance was created without +the C parameter. + + +=item load_session($path) + +Attempts to load the session from C<$path>. When successful, returns true and +stores the session file path for future use. + + +=item login($usr, $pwd) + +Attempts to log the user in. Throws an error on failure. + + +=item me + +Returns a Reddit::Client::Account object. + + +=item list_subreddits($type) + +Returns a list of Reddit::Client::SubReddit objects for C<$type>, where C<$type> +is a C constant. + + +=item my_subreddits + +Syntactic sugar for C. + + +=item home_subreddits + +Syntactic sugar for C. + + +=item mod_subreddits + +Syntactic sugar for C. + + +=item contrib_subreddits + +Syntactic sugar for C. + + +=item popular_subreddits + +Syntactic sugar for C. + + +=item new_subreddits + +Syntactic sugar for C. + + +=item info($item_id) + +Returns a has of information about C<$item_id>, which must be a complete name +(e.g., t3_xxxxx). + + +=item find_subreddits($query) + +Returns a list of SubReddit objects matching C<$query>. + + +=item fetch_links(subreddit => ..., view => ..., limit => ..., before => ..., after => ...) + +Returns a list of links from a reddit page. If C is specified, +the list of links is returned from the desired subreddit. Otherwise, the +links will be from the front page. C specifieds the feed (e.g. +C or C). C may be used to limit the number of +objects returned, and C and C denote the placeholders for +slicing the feed up, just as the reddit urls themselves do. Data is returned +as a hash with three keys, I, I, and I. + + +=item delete_item(name => ...) + +Deletes a post or comment. The object's full name is required. + + +=item submit_link(subreddit => ..., title => ..., url => ...) + +Submits a link to a reddit. Returns the id of the new link. + + +=item submit_text(subreddit => ..., title => ..., text => ...) + +Submits a self-post to a reddit. Returns the id of the new post. + +=item get_subreddit_comments([subreddit => ...][before => ...][after => ...][limit => ...]) + +Return a list of Reddit::Client::Comment objects from a subreddit or multi. All arguments are optional. If subreddit is ommitted, a multi of the subscribed subreddits from the authenticating account will be returned (i.e. what you see when you visit reddit.com's from page and are logged in). If limit is ommitted, Reddit's default limit of 25 is used. If limit is present but false, this is interpreted as no limit and the maximum is returned (100). + +=item get_comments($permalink) + +Disabled in the current version (0.93). + +Returns a list ref of Reddit::Client::Comment objects underneath the +the specified URL C<$permalink>. Unfortunately, this is the only +method available via the API. Comments may be more easily accessed +via the Link object, which implicitly provides the C<$permalink> +parameter. + + my $links = $reddit->fetch_links(...); + foreach (@{$links->{items}}) { + my $comments = $_->comments(); + } + + +=item submit_comment(parent_id => ..., text => ...) + +Submits a new comment underneath C. + + +=item vote(item_id => ..., direction => ...) + +Votes for C. C is one of C, C, +or C. + + +=item save($item_id) + +Saves C<$item_id> under the user's account. + + +=item unsave($item_id) + +Unsaves C<$item_id> under the user's account. + + +=item hide($item_id) + +Hides $. Throws an error if the user does not have permission to hide +the item in question. + + +=item unhide($item_id) + +Unhides $. Throws an error if the user does not have permission to +unhide the item in question. + + +=back + +=head1 INTERNAL ROUTINES + +=over + +=item DEBUG + +When C<$Reddit::Client::DEBUG> is true, acts as syntactic sugar for +warn(sprintf(@_)). Used to provided logging. + + +=item require_login + +Throws an error if the user is not logged in. No longer used. + + +=item subreddit + +Strips slashes and leading /r from a subreddit to ensure that only +the "display name" of the subreddit is returned. + + +=item request + +Performs a request to reddit's servers using LWP. If the user is +logged in, adds the "uh" and "modhash" parameters to POST queries +as well as adding the reddit-specified cookie value for reddit_session. + + +=item json_request + +Wraps C, configuring the parameters to perform the request +with an api_type of "json". After the request is complete, parses the +JSON result and throws and error if one is specified in the result +contents. Otherwise, returns the json data portion of the result. + + +=item api_json_request + +Wraps C, getting method and path from an API_CONSTANT. + + +=back + +=head1 AUTHOR + + + +Jeff Ober L + +=head1 LICENSE + +BSD license + +=cut diff --git a/lib/Reddit/Client/Account.pm b/lib/Reddit/Client/Account.pm new file mode 100644 index 0000000..0983a28 --- /dev/null +++ b/lib/Reddit/Client/Account.pm @@ -0,0 +1,37 @@ +package Reddit::Client::Account; + +use strict; +use warnings; +use Carp; + +require Reddit::Client::Thing; + +use base qw/Reddit::Client::Thing/; +use fields qw/has_mail created modhash created_utc link_karma over_18 + comment_karma is_gold is_mod has_mod_mail/; + +1; + +__END__ + +=pod + +=head1 NAME + +Reddit::Client::Account + +=head1 DESCRIPTION + +Stores information about the logged in user account. + +=head1 AUTHOR + + + +Jeff Ober L + +=head1 LICENSE + +BSD license + +=cut diff --git a/lib/Reddit/Client/Comment.pm b/lib/Reddit/Client/Comment.pm new file mode 100644 index 0000000..25a7dad --- /dev/null +++ b/lib/Reddit/Client/Comment.pm @@ -0,0 +1,83 @@ +package Reddit::Client::Comment; + +use strict; +use warnings; +use Carp; + +require Reddit::Client::VotableThing; + +use base qw/Reddit::Client::VotableThing/; +use fields qw/link_flair_text media url link_url link_flair_css_class num_reports created_utc + banned_by subreddit title author_flair_text is_self author media_embed + permalink author_flair_css_class selftext domain num_comments clicked + saved thumbnail subreddit_id approved_by selftext_html created hidden + over_18 parent_id replies link_id body body_html/; + +sub set_replies { + my ($self, $value) = @_; + if (ref $value && exists $value->{data}{children}) { + $self->{replies} = [ map { Reddit::Client::Comment->new($self->{session}, $_->{data}) } @{$value->{data}{children}} ]; + } else { + $self->{replies} = []; + } +} + +sub replies { + return shift->{replies}; +} + +sub reply { + my $self = shift; + return $self->SUPER::submit_comment(@_); +} + +1; + +__END__ + +=pod + +=head1 NAME + +Reddit::Client::Comment + +=head1 DESCRIPTION + +Wraps a posted comment. + +=head1 SUBROUTINES/METHODS + +=over + +=item replies() + +Returns a list ref of replies underneath this comment. + +=item reply(...) + +Syntactic sugar for C. + +=back + +=head1 INTERNAL ROUTINES + +=over + +=item set_replies + +Wraps the list of children in Comment class instances and ensures that comments +with no replies return an empty array for C. + +=back + +=head1 AUTHOR + + + +Jeff Ober L + +=head1 LICENSE + +BSD license + +=cut diff --git a/lib/Reddit/Client/Link.pm b/lib/Reddit/Client/Link.pm new file mode 100644 index 0000000..c4655ea --- /dev/null +++ b/lib/Reddit/Client/Link.pm @@ -0,0 +1,55 @@ +package Reddit::Client::Link; + +use strict; +use warnings; +use Carp; + +require Reddit::Client::VotableThing; + +use base qw/Reddit::Client::VotableThing/; +use fields qw/link_flair_text media url link_flair_css_class num_reports + created_utc banned_by subreddit title author_flair_text is_self + author media_embed author_flair_css_class selftext domain + num_comments clicked saved thumbnail subreddit_id approved_by + selftext_html created hidden over_18 permalink/; + +sub comments { + my $self = shift; + return $self->{session}->get_comments(permalink => $self->{permalink}); +} + +1; + +__END__ + +=pod + +=head1 NAME + +Reddit::Client::Link + +=head1 DESCRIPTION + +Wraps a posted link or "self-post". + +=head1 SUBROUTINES/METHODS + +=over + +=item comments() + +Wraps C, implicitly providing the permalink parameter. + +=back + +=head1 AUTHOR + + + +Jeff Ober L + +=head1 LICENSE + +BSD license + +=cut diff --git a/lib/Reddit/Client/Request.pm b/lib/Reddit/Client/Request.pm new file mode 100755 index 0000000..30fb3c3 --- /dev/null +++ b/lib/Reddit/Client/Request.pm @@ -0,0 +1,181 @@ +package Reddit::Client::Request; + +use strict; +use warnings; +use Carp; + +use LWP::UserAgent qw//; +use HTTP::Request qw//; +use URI::Encode qw/uri_encode/; + +require Reddit::Client; + +use fields ( + 'user_agent', + 'method', + 'url', + 'query', + 'post_data', + 'cookie', + 'modhash', + 'token', + 'tokentype' +); + +sub new { + my ($class, %param) = @_; + my $self = fields::new($class); + $self->{user_agent} = $param{user_agent} || croak 'Expected "user_agent"'; + $self->{url} = $param{url} || croak 'Expected "url"'; + $self->{query} = $param{query}; + $self->{post_data} = $param{post_data}; + $self->{cookie} = $param{cookie}; + $self->{modhash} = $param{modhash}; + $self->{token} = $param{token}; + $self->{tokentype} = $param{tokentype}; + + if (defined $self->{query}) { + ref $self->{query} eq 'HASH' || croak 'Expected HASH ref for "query"'; + $self->{url} = sprintf('%s?%s', $self->{url}, build_query($self->{query})) + } + + if (defined $self->{post_data}) { + ref $self->{post_data} eq 'HASH' || croak 'Expected HASH ref for "post_data"'; + } + + $self->{method} = $param{method} || 'GET'; + $self->{method} = uc $self->{method}; + + return $self; +} + +sub build_query { + my $param = shift or return ''; + my $opt = { encode_reserved => 1 }; + join '&', map {uri_encode($_, $opt) . '=' . uri_encode($param->{$_}, $opt)} sort keys %$param; +} + +sub build_request { + my $self = shift; + my $request = HTTP::Request->new(); + + $request->uri($self->{url}); + #$request->header('Cookie', sprintf('reddit_session=%s', $self->{cookie})) + # if $self->{cookie}; + $request->header("Authorization"=> "$self->{tokentype} $self->{token}") if $self->{tokentype} && $self->{token}; + + if ($self->{method} eq 'POST') { + my $post_data = $self->{post_data} || {}; + $post_data->{modhash} = $self->{modhash} if $self->{modhash}; + $post_data->{uh} = $self->{modhash} if $self->{modhash}; + + $request->method('POST'); + $request->content_type('application/x-www-form-urlencoded'); + $request->content(build_query($post_data)); + } else { + $request->method('GET'); + } + + #use Data::Dump::Color; + #dd $request; + return $request; +} + +sub send { + my $self = shift; + my $request = $self->build_request; + + Reddit::Client::DEBUG('%4s request to %s', $self->{method}, $self->{url}); + + my $ua = LWP::UserAgent->new(agent => $self->{user_agent}, env_proxy => 1); + my $res = $ua->request($request); + + if ($res->is_success) { + #use Data::Dump::Color; + #dd $res->content; + return $res->content; + } else { + croak sprintf('Request error: HTTP %s', $res->status_line); + } +} + +sub token_request { + my ($self, $client_id, $secret, $username, $password, $useragent) = @_; + + my $url = "https://$client_id:$secret\@www.reddit.com/api/v1/access_token"; + + my $ua = LWP::UserAgent->new(user_agent => $useragent); + my $req = HTTP::Request->new(POST => $url); + $req->header('content-type' => 'application/x-www-form-urlencoded'); + + my $postdata = "grant_type=password&username=$username&password=$password"; + $req->content($postdata); + + my $res = $ua->request($req); + + if ($res->is_success) { + return $res->decoded_content; + } else { + croak sprintf('Request error: HTTP %s', $res->status_line); + } +} + +1; + +__END__ + +=pod + +=head1 NAME + +Reddit::Client::Request + +=head1 DESCRIPTION + +HTTP request driver for Reddit::Client. Uses LWP to perform GET and POST requests +to the reddit.com servers. This module is used internally by the Reddit::Client +and is not designed for external use. + +=head1 SUBROUTINES/METHODS + +=over + +=item new(%params) + +Creates a new Reddit::Request::API instance. Parameters: + + user_agent User agent string + url Target URL + query Hash of query parameters + post_data Hash of POST parameters + cookie Reddit session cookie + modhash Reddit session modhash + + +=item build_query($query) + +Builds a URI-escaped query string from a hash of query parameters. This is *not* +a method of the class, but a package routine. + + +=item build_request + +Builds an HTTP::Request object for LWP::UserAgent. + + +=item send + +Performs the HTTP request and returns the result. Croaks on HTTP error. + + +=back + +=head1 AUTHOR + +Jeff Ober L + +=head1 LICENSE + +BSD license + +=cut diff --git a/lib/Reddit/Client/SubReddit.pm b/lib/Reddit/Client/SubReddit.pm new file mode 100644 index 0000000..de8ee3c --- /dev/null +++ b/lib/Reddit/Client/SubReddit.pm @@ -0,0 +1,70 @@ +package Reddit::Client::SubReddit; + +use strict; +use warnings; +use Carp; + +require Reddit::Client::Thing; + +use base qw/Reddit::Client::Thing/; +use fields qw/over18 header_img created_utc header_title header_size + description display_name created url title subscribers + public_description/; + +sub links { + my ($self, %param) = @_; + return $self->{session}->fetch_links(subreddit => $self->{url}, %param); +} + +sub submit_link { + my ($self, $title, $url) = @_; + $self->{session}->submit_link(title => $title, url => $url, sr => $self->{title}, kind => 'link'); +} + +sub submit_text { + my ($self, $title, $text) = @_; + $self->{session}->submit_text(title => $title, text => $text, sr => $self->{title}, kind => 'text'); +} + +1; +__END__ + +=pod + +=head1 NAME + +Reddit::Client::SubReddit + +=head1 DESCRIPTION + +Provides convenience methods for interacting with SubReddits. + +=head1 SUBROUTINES/METHODS + +=over + +=item links(...) + +Wraps C, providing the subreddit parameter implicitly. + +=item submit_link($title, $url) + +Wraps C, providing the subreddit parameter implicitly. + +=item submit_text($title, $text) + +Wraps C, providing the subreddit parameter implicitly. + +=back + +=head1 AUTHOR + + + +Jeff Ober L + +=head1 LICENSE + +BSD license + +=cut diff --git a/lib/Reddit/Client/Thing.pm b/lib/Reddit/Client/Thing.pm new file mode 100644 index 0000000..7e80155 --- /dev/null +++ b/lib/Reddit/Client/Thing.pm @@ -0,0 +1,117 @@ +package Reddit::Client::Thing; + +use strict; +use warnings; +use Carp; + +use List::Util qw/first/; + +our @BOOL_FIELDS = qw/is_self likes clicked saved hidden over_18 over18 + has_mail has_mod_mail is_mod is_gold/; + + +use fields qw/session name id/; + +sub new { + my ($class, $reddit, $source_data) = @_; + my $self = fields::new($class); + $self->{session} = $reddit; + $self->load_from_source_data($source_data) if $source_data; + return $self; +} + +sub load_from_source_data { + require Reddit::Client; + + my ($self, $source_data) = @_; + if ($source_data) { + foreach my $field (keys %$source_data) { + # Set data fields + my $setter = sprintf 'set_%s', $field; + if ($self->can($setter)) { + $self->can($setter)->($self, $source_data->{$field}); + } elsif (first {$_ eq $field} @BOOL_FIELDS) { + $self->set_bool($field, $source_data->{$field}); + } else { + eval { $self->{$field} = $source_data->{$field} }; + Reddit::Client::DEBUG("Field %s is missing from package %s\n", $field, ref $self) + if $@; + } + + # Add getter for field + my $getter = sub { $_[0]->{$field} }; + my $class = ref $self; + my $method = sprintf '%s::get_%s', $class, $field; + + unless ($self->can($method)) { + no strict 'refs'; + *{$method} = \&$getter; + } + } + } +} + +sub set_bool { + my ($self, $field, $value) = @_; + $self->{$field} = $value ? 1 : 0; +} + +1; + +__END__ + +=pod + +=head1 NAME + +Reddit::Client::Thing + +=head1 DESCRIPTION + +A "Thing" is the base class of all Reddit objects. Do not blame the author +for this. This is specified by the API documentation. The author just +perpetuated it. + +Generally, consumers of the Reddit::Client module do not instantiate these +objects directly. Things offer a bit of syntactic sugar around the data +returned by reddit's servers, such as the ability to comment directly on +a Link object. + +=head1 SUBROUTINES/METHODS + +=over + +=item new($session, $data) + +Creates a new Thing. C<$session> must be an instance of Reddit::Client. +C<$data>, when present, must be a hash reference of key/value pairs. + +=back + +=head1 INTERNAL ROUTINES + +=over + +=item set_bool($field, $value) + +Sets a field to a boolean value of 1 or 0, rather than the JSON +module's boolean type. + +=item load_from_source_data($data) + +Populates an instances field with data directly from JSON data returned +by reddit's servers. + +=back + +=head1 AUTHOR + + + +Jeff Ober L + +=head1 LICENSE + +BSD license + +=cut diff --git a/lib/Reddit/Client/VotableThing.pm b/lib/Reddit/Client/VotableThing.pm new file mode 100644 index 0000000..f6c6eb8 --- /dev/null +++ b/lib/Reddit/Client/VotableThing.pm @@ -0,0 +1,100 @@ +package Reddit::Client::VotableThing; + +use strict; +use warnings; +use Carp; + +require Reddit::Client::Thing; + +use base qw/Reddit::Client::Thing/; +use fields qw/ups downs likes score edited/; + +# likes may be true, false, or null, based on user vote +sub set_likes { + my ($self, $value) = @_; + $self->set_bool('likes', $value) if defined $value; +} + +sub vote { + my ($self, $direction) = @_; + $self->{session}->vote($self->{name}, $direction); +} + +sub comment { + my ($self, $comment) = @_; + $self->{session}->submit_comment(parent_id => $self->{name}, text => $comment); +} + +sub save { + my $self = shift; + $self->{session}->save($self->{name}); +} + +sub unsave { + my $self = shift; + $self->{session}->unsave($self->{name}); +} + +sub hide { + my $self = shift; + $self->{session}->hide($self->{name}); +} + +sub unhide { + my $self = shift; + $self->{session}->unhide($self->{name}); +} + +1; + +__END__ + +=pod + +=head1 NAME + +Reddit::Client::VotableThing + +=head1 DESCRIPTION + +A Thing object, such as a Comment or Link, that may be voted on, +commented against, hidden, or saved. + +=head1 SUBROUTINES/METHODS + +=over + +=item vote($direction) + +=item comment($text) + +=item save() + +=item unsave() + +=item hide() + +=item unhide() + +=back + +=head1 INTERNAL ROUTINES + +=over + +=item set_likes + +Conditionally sets the value of "likes" since it may validly be true, false, or +neither, in the case of no vote being cast. + +=back + +=head1 AUTHOR + +Jeff Ober L + +=head1 LICENSE + +BSD license + +=cut From cd6702e144e383f5673439c660ad4397bcd51858 Mon Sep 17 00:00:00 2001 From: earth-tone Date: Mon, 31 Aug 2015 03:24:43 -0400 Subject: [PATCH 16/16] version 1.0 --- lib/Reddit/Client.pm | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/lib/Reddit/Client.pm b/lib/Reddit/Client.pm index b29b916..e08d098 100755 --- a/lib/Reddit/Client.pm +++ b/lib/Reddit/Client.pm @@ -1,6 +1,6 @@ package Reddit::Client; -our $VERSION = '0.93'; +our $VERSION = '1.0'; $VERSION = eval $VERSION; use strict; @@ -184,11 +184,7 @@ sub request { my ($self, $method, $path, $query, $post_data) = @_; if (!$self->{last_token} || $self->{last_token} <= time - 3600) { -<<<<<<< HEAD $self->get_token(client_id=>$self->{client_id}, secret=>$self->{secret}, username=>$self->{username}, password=>$self->{password}); -======= - $self->get_token($self->{client_id}, $self->{secret}, $self->{username}, $self->{password}); ->>>>>>> origin } # Trim leading slashes off of the path