diff --git a/README b/README deleted file mode 100644 index 1cc546b..0000000 --- a/README +++ /dev/null @@ -1,57 +0,0 @@ -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. diff --git a/README.md b/README.md new file mode 100644 index 0000000..3038225 --- /dev/null +++ b/README.md @@ -0,0 +1,59 @@ +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 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 => 'all+test', + limit => 25, +); + +############################################## +# 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 +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. + +--- + +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. diff --git a/lib/Reddit/Client.pm b/lib/Reddit/Client.pm old mode 100644 new mode 100755 index 103f448..e08d098 --- a/lib/Reddit/Client.pm +++ b/lib/Reddit/Client.pm @@ -1,6 +1,6 @@ package Reddit::Client; -our $VERSION = '0.9_1'; +our $VERSION = '1.0'; $VERSION = eval $VERSION; use strict; @@ -30,6 +30,7 @@ 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; @@ -38,6 +39,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 +56,9 @@ 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'; @@ -67,26 +72,30 @@ use constant SUBREDDITS_MOD => 'moderator'; #=============================================================================== our $DEBUG = 0; -our $BASE_URL = 'http://www.reddit.com'; +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/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_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 #=============================================================================== @@ -123,11 +132,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 { @@ -140,10 +155,23 @@ sub new { } $self->{user_agent} = $param{user_agent}; - if ($param{session_file}) { - $self->{session_file} = $param{session_file}; - $self->load_session; - } + #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; } @@ -154,9 +182,13 @@ sub new { 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), @@ -165,11 +197,35 @@ 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, %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); @@ -177,12 +233,14 @@ sub json_request { if ($method eq 'POST') { $post_data ||= {}; $post_data->{api_type} = 'json'; - } else { - $path .= '.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}; @@ -223,6 +281,8 @@ sub api_json_request { } my $result = $self->json_request($method, $path, $query, $post_data); + #use Data::Dump::Color; + #dd $result; if (exists $result->{errors}) { my @errors = @{$result->{errors}}; @@ -233,6 +293,8 @@ sub api_json_request { croak $message; } } + #use Data::Dump::Color; + #dd $result; if (defined $callback && ref $callback eq 'CODE') { return $callback->($result); @@ -247,6 +309,7 @@ sub is_logged_in { sub require_login { my $self = shift; + return; croak 'You must be logged in to perform this action' unless $self->is_logged_in; } @@ -257,12 +320,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 +354,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 +373,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 +392,6 @@ sub login { $self->{modhash} = $result->{data}{modhash}; $self->{cookie} = $result->{data}{cookie}; - $self->{user} = $usr; return 1; } @@ -343,9 +399,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 { @@ -381,7 +438,23 @@ 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]); + 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 { @@ -406,7 +479,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; @@ -430,6 +503,44 @@ sub fetch_links { }; } +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 #=============================================================================== @@ -496,7 +607,7 @@ sub submit_text { # Comments #=============================================================================== -sub get_comments { +sub get_comments { # currently broken my ($self, %param) = @_; my $permalink = $param{permalink} || croak 'Expected "permalink"'; @@ -523,6 +634,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 #=============================================================================== @@ -587,16 +723,35 @@ Reddit::Client - A perl wrapper for Reddit use Reddit::Client; - my $session_file = '~/.reddit'; + # 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( - session_file => $session_file, user_agent => 'MyApp/1.0', ); - unless ($reddit->is_logged_in) { - $reddit->login('someone', 'secret'); - $reddit->save_session(); - } + # 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', @@ -612,18 +767,15 @@ Reddit::Client - A perl wrapper for Reddit =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. +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 -Note that none of these constants are exported by C. - 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 @@ -632,7 +784,7 @@ Note that none of these constants are exported by C. VOTE_UP Up vote VOTE_DOWN Down vote - VOTE_NONE "Un" vote + VOTE_NONE Remove any vote SUBREDDITS_HOME List reddits on the homepage SUBREDDITS_POPULAR List popular reddits @@ -645,11 +797,6 @@ Note that none of these constants are exported by C. =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 @@ -662,18 +809,16 @@ When set to true, outputs a small amount of debugging information. =over -=item new(user_agent => ..., session_file => ...) +=item new(user_agent => , [client_id =>, secret =>, username=>, password =>]) -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. +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 is_logged_in +=item authenticated -Returns true(ish) if there is an active login session. No attempt is made to -validate the current session against the server. +Returns true if there is an oauth token. =item save_session($path) @@ -707,20 +852,17 @@ is a C constant. =item my_subreddits -Syntactic sugar for C. Throws an error if -the user is not logged in. +Syntactic sugar for C. =item home_subreddits -Syntactic sugar for C. Throws an error if -the user is not logged in. +Syntactic sugar for C. =item mod_subreddits -Syntactic sugar for C. Throws an error if -the user is not logged in. +Syntactic sugar for C. =item contrib_subreddits @@ -774,9 +916,14 @@ Submits a link to a reddit. Returns the id of the new link. 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 @@ -836,7 +983,7 @@ warn(sprintf(@_)). Used to provided logging. =item require_login -Throws an error if the user is not logged in. +Throws an error if the user is not logged in. No longer used. =item subreddit @@ -869,14 +1016,12 @@ Wraps C, getting method and path from an API_CONSTANT. =head1 AUTHOR + + 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..0983a28 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; @@ -28,14 +26,12 @@ Stores information about the logged in user account. =head1 AUTHOR + + 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..25a7dad 100644 --- a/lib/Reddit/Client/Comment.pm +++ b/lib/Reddit/Client/Comment.pm @@ -7,16 +7,16 @@ 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/; +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}} ]; + $self->{replies} = [ map { Reddit::Client::Comment->new($self->{session}, $_->{data}) } @{$value->{data}{children}} ]; } else { $self->{replies} = []; } @@ -72,14 +72,12 @@ with no replies return an empty array for C. =head1 AUTHOR + + 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..c4655ea 100644 --- a/lib/Reddit/Client/Link.pm +++ b/lib/Reddit/Client/Link.pm @@ -44,14 +44,12 @@ Wraps C, implicitly providing the permalink parame =head1 AUTHOR + + 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 old mode 100644 new mode 100755 index b3c8446..30fb3c3 --- 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->{tokentype} && $self->{token}; if ($self->{method} eq 'POST') { my $post_data = $self->{post_data} || {}; @@ -71,6 +76,8 @@ sub build_request { $request->method('GET'); } + #use Data::Dump::Color; + #dd $request; return $request; } @@ -84,12 +91,35 @@ sub send { 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__ @@ -146,10 +176,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..de8ee3c 100644 --- a/lib/Reddit/Client/SubReddit.pm +++ b/lib/Reddit/Client/SubReddit.pm @@ -59,14 +59,12 @@ Wraps C, providing the subreddit parameter implicit =head1 AUTHOR + + 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..7e80155 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 @@ -107,14 +106,12 @@ by reddit's servers. =head1 AUTHOR + + 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 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;