File Coverage

blib/lib/Reddit/Client.pm
Criterion Covered Total %
statement 334 1217 27.4
branch 1 462 0.2
condition 0 388 0.0
subroutine 112 217 51.6
pod 68 106 64.1
total 515 2390 21.5


line stmt bran cond sub pod time code
1             package Reddit::Client;
2              
3             our $VERSION = '1.388';
4              
5             # 1.388 added approve and ignore_reports to Comment
6             # Needs doc:
7             # report, modmail_mute, modmail_action, Modm...->archive, sticky_post
8              
9             # 1.387 Added approve and ignore_report functions to Link.pm
10              
11             # 1.3865 fixed bug that was showing up for testers but not for me for some reason
12             # it was using shift ambiguously before a ternary operator. return shift ? true : false
13             # 1.3863 fixed bug in get_subreddit_info that prevented some pages from working
14              
15             # 1.386 2/19/21
16             # updated get_subreddit_info, now takes second arg for specific page
17             # added approve_user
18              
19             # 1.385 11/23/20
20             # added modmail_action, ModmConv...->archive
21             # 1.384
22             # added invite_mod, arg-only version of invite_moderator
23             # 1.384 10/11/20 update
24             # added report
25             #
26             # 1.384 9/29/20
27             # added modmail_mute
28             # submit_text: field 'text' is no longer required
29             # added more fields to Link
30              
31             # 1.383 added sticky_post
32              
33             # next big version can be when we put in the new mute
34             # 1.382 (should be big ver?) added friend function - no we didn't
35              
36             # 1.381 changed default max request from 500 to 100
37             # 1.38 7/27/20
38             # added ModmailConversation and ModmailMessage classes
39             # added function new_modmail_conversation
40             # 1.375 7/2/20 added sr_detail to Link
41             # 1.374 added nsfw option to submit_link
42              
43             # 1.373 2/3/20 edit now returns the edited thing's id
44             # 1.372
45             # -get_link now gets its links in a proper way, by calling get_links_by_ids and
46             # taking the first element
47             # -Link class now has many more keys; should now reflect most or all of the keys
48             # Reddit returns, minus 'downs' and 'ups' because they are deprecated and can
49             # cause confusion
50              
51              
52             $VERSION = eval $VERSION;
53              
54 5     5   137185 use strict;
  5         36  
  5         159  
55 5     5   26 use Carp;
  5         10  
  5         357  
56              
57 5     5   2550 use Data::Dumper qw/Dumper/;
  5         30837  
  5         353  
58 5     5   715 use JSON qw/decode_json/;
  5         11975  
  5         37  
59 5     5   769 use File::Spec qw//;
  5         11  
  5         93  
60 5     5   24 use Digest::MD5 qw/md5_hex/;
  5         10  
  5         326  
61 5     5   2731 use POSIX qw/strftime/;
  5         32059  
  5         32  
62             #use File::Path::Expand qw//; # Does nothing?
63              
64             require Reddit::Client::Account;
65             require Reddit::Client::Comment;
66             require Reddit::Client::Link;
67             require Reddit::Client::SubReddit;
68             require Reddit::Client::Request;
69             require Reddit::Client::Message;
70             require Reddit::Client::MoreComments;
71             require Reddit::Client::ModmailConversation;
72             require Reddit::Client::ModmailMessage;
73              
74             #===============================================================================
75             # Constants
76             #===============================================================================
77              
78 5     5   7835 use constant DEFAULT_LIMIT => 25;
  5         19  
  5         390  
79              
80 5     5   32 use constant VIEW_HOT => '';
  5         11  
  5         263  
81 5     5   47 use constant VIEW_NEW => 'new';
  5         10  
  5         273  
82 5     5   32 use constant VIEW_CONTROVERSIAL => 'controversial';
  5         8  
  5         228  
83 5     5   48 use constant VIEW_TOP => 'top';
  5         14  
  5         267  
84 5     5   32 use constant VIEW_RISING => 'rising';
  5         9  
  5         232  
85 5     5   26 use constant VIEW_DEFAULT => VIEW_HOT;
  5         9  
  5         227  
86              
87 5     5   26 use constant VOTE_UP => 1;
  5         8  
  5         262  
88 5     5   32 use constant VOTE_DOWN => -1;
  5         10  
  5         233  
89 5     5   28 use constant VOTE_NONE => 0;
  5         11  
  5         247  
90              
91 5     5   29 use constant SUBMIT_LINK => 'link';
  5         7  
  5         245  
92 5     5   31 use constant SUBMIT_SELF => 'self';
  5         11  
  5         214  
93 5     5   29 use constant SUBMIT_MESSAGE => 'message';
  5         9  
  5         259  
94 5     5   33 use constant SUBMIT_CROSSPOST => 'crosspost';
  5         8  
  5         250  
95              
96 5     5   40 use constant MESSAGES_INBOX => 'inbox';
  5         8  
  5         322  
97 5     5   34 use constant MESSAGES_UNREAD => 'unread';
  5         10  
  5         285  
98 5     5   32 use constant MESSAGES_SENT => 'sent';
  5         15  
  5         281  
99 5     5   37 use constant MESSAGES_MESSAGES => 'messages';
  5         10  
  5         248  
100 5     5   30 use constant MESSAGES_COMMENTREPLIES => 'comments';
  5         7  
  5         254  
101 5     5   31 use constant MESSAGES_POSTREPLIES => 'selfreply';
  5         7  
  5         248  
102 5     5   30 use constant MESSAGES_MENTIONS => 'mentions';
  5         9  
  5         280  
103              
104 5     5   29 use constant SUBREDDITS_HOME => '';
  5         8  
  5         243  
105 5     5   30 use constant SUBREDDITS_MINE => 'subscriber';
  5         8  
  5         291  
106 5     5   30 use constant SUBREDDITS_POPULAR => 'popular';
  5         23  
  5         253  
107 5     5   29 use constant SUBREDDITS_NEW => 'new';
  5         17  
  5         280  
108 5     5   32 use constant SUBREDDITS_CONTRIB => 'contributor';
  5         8  
  5         224  
109 5     5   29 use constant SUBREDDITS_MOD => 'moderator';
  5         10  
  5         246  
110              
111 5     5   31 use constant USER_OVERVIEW => 'overview';
  5         7  
  5         218  
112 5     5   27 use constant USER_COMMENTS => 'comments';
  5         10  
  5         263  
113 5     5   29 use constant USER_SUBMITTED => 'submitted';
  5         8  
  5         266  
114 5     5   34 use constant USER_GILDED => 'gilded';
  5         8  
  5         269  
115 5     5   27 use constant USER_UPVOTED => 'upvoted';
  5         9  
  5         256  
116 5     5   30 use constant USER_DOWNVOTED => 'downvoted';
  5         8  
  5         289  
117 5     5   32 use constant USER_HIDDEN => 'hidden';
  5         9  
  5         237  
118 5     5   27 use constant USER_SAVED => 'saved';
  5         8  
  5         266  
119 5     5   52 use constant USER_ABOUT => 'about';
  5         9  
  5         251  
120              
121 5     5   29 use constant API_ME => 0;
  5         9  
  5         249  
122 5     5   30 use constant API_INFO => 1;
  5         8  
  5         252  
123 5     5   32 use constant API_SUB_SEARCH => 2;
  5         15  
  5         241  
124 5     5   28 use constant API_LOGIN => 3;
  5         9  
  5         249  
125 5     5   27 use constant API_SUBMIT => 4;
  5         10  
  5         283  
126 5     5   32 use constant API_COMMENT => 5;
  5         8  
  5         236  
127 5     5   28 use constant API_VOTE => 6;
  5         7  
  5         339  
128 5     5   33 use constant API_SAVE => 7;
  5         9  
  5         224  
129 5     5   28 use constant API_UNSAVE => 8;
  5         10  
  5         255  
130 5     5   31 use constant API_HIDE => 9;
  5         9  
  5         253  
131 5     5   28 use constant API_UNHIDE => 10;
  5         9  
  5         225  
132 5     5   44 use constant API_SUBREDDITS => 11;
  5         13  
  5         248  
133 5     5   30 use constant API_LINKS_FRONT => 12;
  5         8  
  5         252  
134 5     5   38 use constant API_LINKS_OTHER => 13;
  5         10  
  5         237  
135 5     5   27 use constant API_DEL => 14;
  5         8  
  5         240  
136 5     5   30 use constant API_MESSAGE => 15;
  5         10  
  5         202  
137 5     5   28 use constant API_COMMENTS_FRONT => 16;
  5         9  
  5         294  
138 5     5   36 use constant API_COMMENTS => 17;
  5         10  
  5         301  
139 5     5   32 use constant API_MESSAGES => 18;
  5         7  
  5         237  
140 5     5   28 use constant API_MARK_READ => 19;
  5         8  
  5         247  
141 5     5   28 use constant API_MARKALL => 20;
  5         10  
  5         256  
142 5     5   38 use constant API_MY_SUBREDDITS => 21;
  5         150  
  5         275  
143 5     5   33 use constant API_USER => 22;
  5         8  
  5         238  
144 5     5   28 use constant API_SELECTFLAIR => 23;
  5         10  
  5         205  
145 5     5   26 use constant API_FLAIROPTS => 24;
  5         9  
  5         368  
146 5     5   33 use constant API_EDITWIKI => 25;
  5         9  
  5         233  
147 5     5   29 use constant API_CREATEMULTI => 26;
  5         9  
  5         245  
148 5     5   30 use constant API_DELETEMULTI => 27;
  5         9  
  5         262  
149 5     5   31 use constant API_GETMULTI => 28;
  5         8  
  5         233  
150 5     5   37 use constant API_EDITMULTI => 29;
  5         9  
  5         255  
151 5     5   73 use constant API_SUBREDDIT_INFO => 30;
  5         11  
  5         276  
152 5     5   31 use constant API_SEARCH => 31;
  5         14  
  5         223  
153 5     5   25 use constant API_MODQ => 32;
  5         11  
  5         252  
154 5     5   33 use constant API_EDIT => 33;
  5         7  
  5         252  
155 5     5   31 use constant API_REMOVE => 34;
  5         8  
  5         232  
156 5     5   28 use constant API_APPROVE => 35;
  5         14  
  5         241  
157 5     5   31 use constant API_IGNORE_REPORTS => 36;
  5         23  
  5         247  
158 5     5   28 use constant API_GETWIKI => 37;
  5         29  
  5         311  
159 5     5   40 use constant API_GET_MODMAIL => 38;
  5         9  
  5         242  
160 5     5   31 use constant API_BAN => 39;
  5         16  
  5         248  
161 5     5   29 use constant API_MORECHILDREN => 40;
  5         20  
  5         253  
162 5     5   31 use constant API_BY_ID => 41;
  5         9  
  5         205  
163 5     5   25 use constant API_FLAIR => 42;
  5         7  
  5         238  
164 5     5   30 use constant API_DELETEFLAIR => 43;
  5         8  
  5         237  
165 5     5   30 use constant API_UNBAN => 44;
  5         9  
  5         234  
166 5     5   43 use constant API_DISTINGUISH => 45;
  5         18  
  5         252  
167 5     5   39 use constant API_UNDISTINGUISH => 46;
  5         10  
  5         228  
168 5     5   28 use constant API_LOCK => 47;
  5         7  
  5         242  
169 5     5   30 use constant API_UNLOCK => 48;
  5         9  
  5         231  
170 5     5   30 use constant API_MARKNSFW => 49;
  5         23  
  5         225  
171 5     5   27 use constant API_UNMARKNSFW => 50;
  5         9  
  5         262  
172 5     5   32 use constant API_FLAIRTEMPLATE2 => 51;
  5         12  
  5         228  
173 5     5   28 use constant API_LINKFLAIRV1 => 52;
  5         17  
  5         301  
174 5     5   40 use constant API_LINKFLAIRV2 => 53;
  5         9  
  5         255  
175 5     5   31 use constant API_USERFLAIRV1 => 54;
  5         28  
  5         220  
176 5     5   26 use constant API_USERFLAIRV2 => 55;
  5         16  
  5         243  
177 5     5   28 use constant API_NEW_MM_CONV => 56;
  5         11  
  5         228  
178 5     5   27 use constant API_FRIEND => 57;
  5         8  
  5         247  
179 5     5   29 use constant API_STICKY_POST => 58;
  5         28  
  5         244  
180 5     5   36 use constant API_MM_MUTE => 59;
  5         12  
  5         242  
181 5     5   31 use constant API_REPORT => 60;
  5         9  
  5         269  
182 5     5   36 use constant API_MM_POST_ACTION => 61;
  5         11  
  5         250  
183 5     5   29 use constant API_MM_GET_ACTION => 62;
  5         17  
  5         230  
184 5     5   27 use constant API_SUBINFO => 63;
  5         9  
  5         244  
185 5     5   29 use constant API_ABOUT => 64;
  5         9  
  5         360  
186              
187             #===============================================================================
188             # Parameters
189             #===============================================================================
190              
191             our $DEBUG = 0;
192             our $BASE_URL = 'https://oauth.reddit.com';
193 5     5   31 use constant BASE_URL =>'https://oauth.reddit.com';
  5         10  
  5         378  
194             our $LINK_URL = 'https://www.reddit.com'; # Why are there two of these?
195 5     5   31 use constant LINK_URL =>'https://www.reddit.com'; # both are unused now?
  5         10  
  5         3336  
196              
197             our @API;
198             $API[API_ME ] = ['GET', '/api/v1/me' ];
199             $API[API_INFO ] = ['GET', '/api/info' ];
200             $API[API_SUB_SEARCH ] = ['GET', '/subreddits/search' ];
201             $API[API_LOGIN ] = ['POST', '/api/login/%s' ];
202             $API[API_SUBMIT ] = ['POST', '/api/submit' ];
203             $API[API_COMMENT ] = ['POST', '/api/comment' ];
204             $API[API_VOTE ] = ['POST', '/api/vote' ];
205             $API[API_SAVE ] = ['POST', '/api/save' ];
206             $API[API_UNSAVE ] = ['POST', '/api/unsave' ];
207             $API[API_HIDE ] = ['POST', '/api/hide' ];
208             $API[API_UNHIDE ] = ['POST', '/api/unhide' ];
209             $API[API_SUBREDDITS ] = ['GET', '/subreddits/%s' ];
210             $API[API_MY_SUBREDDITS ] = ['GET', '/subreddits/mine/%s' ];
211             $API[API_LINKS_OTHER ] = ['GET', '/%s' ];
212             $API[API_LINKS_FRONT ] = ['GET', '/r/%s/%s' ];
213             $API[API_DEL ] = ['POST', '/api/del' ];
214             $API[API_MESSAGE ] = ['POST', '/api/compose' ];
215             $API[API_COMMENTS ] = ['GET', '/r/%s/comments' ];
216             $API[API_COMMENTS_FRONT] = ['GET', '/comments' ];
217             $API[API_MESSAGES ] = ['GET', '/message/%s' ];
218             $API[API_MARK_READ ] = ['POST', '/api/read_message' ];
219             $API[API_MARKALL ] = ['POST', '/api/read_all_messages' ];
220             $API[API_USER ] = ['GET', '/user/%s/%s' ];
221             $API[API_SELECTFLAIR ] = ['POST', '/r/%s/api/selectflair' ];
222             $API[API_FLAIROPTS ] = ['POST', '/r/%s/api/flairselector' ];
223             $API[API_EDITWIKI ] = ['POST', '/r/%s/api/wiki/edit' ];
224             $API[API_GETWIKI ] = ['GET', '/r/%s/wiki/%s' ];
225             $API[API_CREATEMULTI ] = ['POST', '/api/multi/user/%s/m/%s' ];
226             $API[API_GETMULTI ] = ['GET', '/api/multi/user/%s/m/%s%s'];
227             $API[API_DELETEMULTI ] = ['DELETE','/api/multi/user/%s/m/%s'];
228             $API[API_EDITMULTI ] = ['PUT', '/api/multi/user/%s/m/%s' ];
229             $API[API_ABOUT ] = ['GET', '/r/%s/about' ];
230             $API[API_SUBINFO ] = ['GET', '/r/%s/about/%s' ];
231             $API[API_SEARCH ] = ['GET', '/r/%s/search' ];
232             $API[API_MODQ ] = ['GET', '/r/%s/about/%s' ];
233             $API[API_EDIT ] = ['POST', '/api/editusertext' ];
234             $API[API_REMOVE ] = ['POST', '/api/remove' ];
235             $API[API_APPROVE ] = ['POST', '/api/approve' ];
236             $API[API_IGNORE_REPORTS] = ['POST', '/api/ignore_reports' ];
237             $API[API_GET_MODMAIL ] = ['GET', '/api/mod/conversations' ];
238             $API[API_BAN ] = ['POST', '/r/%s/api/friend' ];
239             $API[API_MORECHILDREN ] = ['GET', '/api/morechildren' ];
240             $API[API_BY_ID ] = ['GET', '/by_id' ];
241             $API[API_FLAIR ] = ['POST', '/r/%s/api/flair' ];
242             $API[API_DELETEFLAIR ] = ['POST', '/r/%s/api/deleteflair' ];
243             $API[API_UNBAN ] = ['POST', '/r/%s/api/unfriend' ];
244             $API[API_DISTINGUISH ] = ['POST', '/api/distinguish' ];
245             $API[API_UNDISTINGUISH ] = ['POST', '/api/distinguish' ];
246             $API[API_LOCK ] = ['POST', '/api/lock' ]; # fullname
247             $API[API_UNLOCK ] = ['POST', '/api/unlock' ]; # only
248             $API[API_MARKNSFW ] = ['POST', '/api/marknsfw' ]; # these
249             $API[API_UNMARKNSFW ] = ['POST', '/api/unmarknsfw' ]; # four
250             $API[API_FLAIRTEMPLATE2] = ['POST', '/r/%s/api/flairtemplate_v2'];
251             $API[API_LINKFLAIRV1 ] = ['GET', '/r/%s/api/link_flair' ];
252             $API[API_LINKFLAIRV2 ] = ['GET', '/r/%s/api/link_flair_v2' ];
253             $API[API_USERFLAIRV1 ] = ['GET', '/r/%s/api/user_flair' ];
254             $API[API_USERFLAIRV2 ] = ['GET', '/r/%s/api/user_flair_v2' ];
255             # Read modmail conversation uses GET on the same endpoint
256             $API[API_NEW_MM_CONV ] = ['POST', '/api/mod/conversations' ];
257             $API[API_FRIEND ] = ['PUT', '/api/v1/me/friends/%' ];
258             $API[API_STICKY_POST ] = ['POST', '/api/set_subreddit_sticky'];
259             $API[API_MM_MUTE ] = ['POST', '/api/mod/conversations/%s/mute'];
260             $API[API_REPORT ] = ['POST', '/api/report' ];
261             $API[API_MM_POST_ACTION] = ['POST', '/api/mod/conversations/%s/%s'];
262              
263             #POST /api/mod/conversations/:conversation_id/mute
264             #conversation_id base36 modmail conversation id
265              
266             #
267             #
268              
269              
270             #===============================================================================
271             # Class methods
272             #===============================================================================
273              
274             use fields (
275 5         27 'modhash', # No longer used. stored session modhash
276             'cookie', # No longer used. stored user cookie
277             'session_file', # No longer used. path to session file
278             'user_agent', # user agent string
279             'token', # oauth authorization token
280             'tokentype', # unused but saved for reference
281             'last_token', # time last token was acquired
282             'client_id', # always required
283             'secret', # always required
284             'username', # now optional for web apps
285             'password', # script apps only
286             'request_errors', # print request errors, deprecated
287             'print_request_errors', # print request errors
288             'print_response', # print response content, deprecated
289             'print_response_content',# print response content
290             'print_request', # print entire request
291             'print_request_on_error',# print entire request on error
292             'refresh_token', # oauth refresh token
293             'auth_type', # 'script' or 'webapp'
294             'debug',
295             'subdomain',
296 5     5   2237 );
  5         6422  
297              
298             sub new {
299 0     0 1 0 my ($class, %param) = @_;
300 0         0 my $self = fields::new($class);
301              
302 0 0       0 if (not exists $param{user_agent}) {
303 0         0 croak "param 'user_agent' is required.";
304             }
305 0         0 $self->{user_agent} = $param{user_agent};
306             # request_errors does nothing?
307 0   0     0 $self->{request_errors} = $param{print_request_errors} || $param{request_errors} || 0;
308 0   0     0 $self->{print_response} = $param{print_response} || $param{print_response_conent} || 0;
309 0   0     0 $self->{print_request} = $param{print_request} || 0;
310 0   0     0 $self->{debug} = $param{debug} || 0;
311 0   0     0 $self->{print_request_on_error} = $param{print_request_on_error} || 0;
312 0   0     0 $self->{subdomain} = $param{subdomain} || 'www';
313              
314 0 0       0 if ($param{password}) {
    0          
315 0 0 0     0 if (!$param{username}) {
    0          
316 0         0 croak "if password is provided, username is required.";
317             } elsif (!$param{client_id} or !$param{secret}) {
318 0         0 croak "client_id and secret are required for authorized apps.";
319             } else {
320 0         0 $self->{auth_type} = 'script';
321 0         0 $self->{client_id} = $param{client_id};
322 0         0 $self->{secret} = $param{secret};
323 0         0 $self->{username} = $param{username};
324 0         0 $self->{password} = $param{password};
325              
326 0         0 $self->get_token();
327             }
328             } elsif ($param{refresh_token}) {
329 0 0 0     0 croak "client_id and secret are required for authorized apps." unless $param{client_id} and $param{secret};
330            
331 0         0 $self->{auth_type} = 'webapp';
332 0         0 $self->{client_id} = $param{client_id};
333 0         0 $self->{secret} = $param{secret};
334 0         0 $self->{refresh_token}= $param{refresh_token};
335             # will this break anything?
336 0 0       0 $self->{username} = $param{username} if $param{username};
337              
338 0         0 $self->get_token();
339             } else {
340             # optionall allow people to pass in client id and secret now, for people
341             # who choose to get refresh token from an RC object
342 0 0       0 $self->{client_id} = $param{client_id} if $param{client_id};
343 0 0       0 $self->{secret} = $param{secret} if $param{secret};
344             # can this even be run without auth anymore?
345 0         0 $self->{auth_type} = 'none';
346             }
347              
348 0         0 return $self;
349             }
350              
351             sub version {
352 0     0 1 0 my $self = shift;
353 0         0 return $VERSION;
354             }
355              
356             #===============================================================================
357             # Requests and Oauth
358             #===============================================================================
359              
360             sub request {
361 0     0 0 0 my ($self, $method, $path, $query, $post_data) = @_;
362              
363             # 401s not being caused by this. they are a new API issue apparently.
364 0 0 0     0 if (!$self->{last_token} or $self->{last_token} <= ( time - 3600 + 55) ) {
365             # passing in username, pass, client_id, secret here did nothing
366 0         0 $self->get_token();
367             }
368              
369             # Trim leading slashes off of the path
370 0         0 $path =~ s/^\/+//;
371             my $request = Reddit::Client::Request->new(
372             user_agent => $self->{user_agent},
373             # path is sprintf'd before call, in api_json_request
374             # the calling function passes in path %s's in 'args' param
375             url => sprintf('%s/%s', $BASE_URL, $path),
376             method => $method,
377             query => $query,
378             post_data => $post_data,
379             modhash => $self->{modhash},
380             cookie => $self->{cookie},
381             token => $self->{token},
382             tokentype => $self->{tokentype},
383             last_token => $self->{last_token},
384             request_errors=> $self->{request_errors},
385             print_response=> $self->{print_response},
386             print_request=> $self->{print_request},
387             print_request_on_error=>$self->{print_request_on_error},
388 0         0 );
389              
390 0         0 return $request->send;
391             }
392              
393             sub get_token {
394 0     0 1 0 my ($self, %param) = @_;
395              
396             # let people set auth things here. this was stupid to allow.
397             # these all set $self properties then continue as normal.
398 0 0 0     0 if ($param{username} or $param{password}) {
    0          
399 0 0 0     0 die "get_token: if username or password are provided, all 4 script-type authentication arguments (username, password, client_id, secret) are required." unless $param{username} and $param{password} and $param{client_id} and $param{secret};
      0        
      0        
400              
401 0         0 $self->{auth_type} = 'script';
402 0         0 $self->{client_id} = $param{client_id};
403 0         0 $self->{secret} = $param{secret};
404 0         0 $self->{username} = $param{username};
405 0         0 $self->{password} = $param{password};
406              
407             } elsif ($param{refresh_token}) {
408 0         0 $self->{auth_type} = 'webapp';
409 0   0     0 $self->{client_id} = $param{client_id} || $self->{client_id} || die "get_token: 'client_id' must be set, either as a parameter to get_token or when instantiating the Reddit::Client object.";
410 0   0     0 $self->{secret} = $param{secret} || $self->{secret} || die "get_token: 'secret' must be set, either as a parameter to get_token or when instantiating the Reddit::Client object.";
411 0         0 $self->{refresh_token} = $param{refresh_token};
412             }
413              
414 0         0 $self->{last_token} = time;
415              
416             # why don't we just pass in the whole Client object ffs
417             my %p = (
418             client_id => $self->{client_id},
419             secret => $self->{secret},
420             user_agent => $self->{user_agent},
421             auth_type => $self->{auth_type},
422 0         0 );
423              
424 0 0       0 if ($self->{auth_type} eq 'script') {
    0          
425             $p{username} = $self->{username},
426             $p{password} = $self->{password},
427 0         0 } elsif ($self->{auth_type} eq 'webapp') {
428 0         0 $p{refresh_token} = $self->{refresh_token};
429 0         0 } else { die "get_token: invalid auth type"; }
430              
431             # Why is this static?
432 0         0 my $message = Reddit::Client::Request->token_request(%p);
433 0         0 my $j = decode_json($message);
434 0         0 $self->{token} = $j->{access_token};
435 0         0 $self->{tokentype} = $j->{token_type};
436              
437 0 0       0 if (!$self->{token}) { croak "Unable to get or parse token."; }
  0         0  
438             }
439              
440             sub has_token {
441 0     0 1 0 my $self = shift;
442 0 0 0     0 return (!$self->{last_token} || $self->{last_token} <= time - 3595) ? 0 : 1;
443             }
444             #
445             # This must be called in static context because no refresh token or user/
446             # pass combination exist. We would have to add a third flow and that doesn't
447             # seem worth it.
448             #
449             # We could call it in an empty RC object, but that would require all sorts
450             # of annoyoing conditions, and all other methods would be broken until
451             # tokens were obtained
452             sub get_refresh_token {
453 0     0 1 0 my ($self, %param) = @_;
454              
455 0         0 my %data;
456 0   0     0 $data{code} = $param{code} || die "'code' is required.\n";
457 0   0     0 $data{redirect_uri} = $param{redirect_uri} || die "'redirect_uri' is required.\n";
458 0   0     0 $data{client_id} = (ref $self eq 'HASH' and $self->{client_id} ? $self->{client_id} : undef) || $param{client_id} || die "'client_id' is required.\n";
459 0   0     0 $data{secret} = (ref $self eq 'HASH' and $self->{secret} ? $self->{secret} : undef) || $param{secret} || die "'secret' is required.";
460 0   0     0 $data{ua} = (ref $self eq 'HASH' and $self->{user_agent} ? $self->{user_agent} : undef) || $param{user_agent} || die "'user_agent' is required.";
461             #$data{ua} = $param{user_agent} || die "user_agent is required";
462 0         0 $data{grant_type} = 'authorization_code';
463 0         0 $data{duration} = 'permanent';
464              
465 0         0 my $refresh_token = Reddit::Client::Request->refresh_token_request(%data);
466 0         0 return $refresh_token;
467             }
468              
469             sub json_request {
470 0     0 0 0 my ($self, $method, $path, $query, $post_data) = @_;
471 0         0 DEBUG('%4s JSON', $method);
472              
473 0 0       0 if ($method eq 'POST') {
474 0   0     0 $post_data ||= {};
475 0         0 $post_data->{api_type} = 'json'; # only POST enpoints require*
476             } else {
477             #$path .= '.json'; # the oauth api returns json by default
478             }
479              
480 0         0 my $response = $self->request($method, $path, $query, $post_data);
481 0 0       0 my $json = JSON::from_json($response) if $response;
482              
483 0 0 0     0 if (ref $json eq 'HASH' && $json->{json}) {
484 0         0 my $result = $json->{json};
485 0 0       0 if (@{$result->{errors}}) {
  0         0  
486 0         0 DEBUG('API Errors: %s', Dumper($result->{errors}));
487             my @errors = map {
488 0         0 sprintf '[%s] %s', $_->[0], $_->[1]
489 0         0 } @{$result->{errors}};
  0         0  
490 0         0 croak sprintf("Error(s): %s", join('|', @errors));
491             } else {
492 0         0 return $result;
493             }
494             } else {
495 0         0 return $json;
496             }
497             }
498              
499             sub api_json_request {
500 0     0 0 0 my ($self, %param) = @_;
501 0   0     0 my $args = $param{args} || [];
502 0         0 my $api = $param{api};
503 0         0 my $data = $param{data};
504 0         0 my $callback = $param{callback};
505              
506 0 0       0 croak 'Expected "api"' unless defined $api;
507              
508 0         0 DEBUG('API call %d', $api);
509              
510 0   0     0 my $info = $API[$api] || croak "Unknown API: $api";
511 0         0 my ($method, $path) = @$info;
512 0         0 $path = sprintf $path, @$args;
513              
514 0         0 my ($query, $post_data);
515 0 0 0     0 if ($method eq 'GET' or $method eq 'DELETE') {
516 0         0 $query = $data;
517             } else {
518 0         0 $post_data = $data;
519             }
520              
521 0         0 my $result = $self->json_request($method, $path, $query, $post_data);
522              
523             # This breaks on endpoints that return an array like flairselect v2
524 0 0 0     0 if (ref $result eq 'HASH' and exists $result->{errors}) {
525 0         0 my @errors = @{$result->{errors}};
  0         0  
526              
527 0 0       0 if (@errors) {
528 0         0 DEBUG("ERRORS: @errors");
529 0         0 my $message = join(' | ', map { join(', ', @$_) } @errors);
  0         0  
530 0         0 croak $message;
531             }
532             }
533             # The fuck is this?
534 0 0 0     0 if (defined $callback && ref $callback eq 'CODE') {
535 0         0 return $callback->($result);
536             } else {
537 0         0 return $result;
538             }
539             }
540              
541             # deprecated, to be removed
542             sub is_logged_in {
543 0     0 0 0 return defined $_[0]->{modhash};
544             }
545              
546             # deprecated, to be removed
547             sub require_login {
548 0     0 0 0 my $self = shift;
549 0         0 return;
550             }
551              
552              
553             #===============================================================================
554             # User and account management
555             #===============================================================================
556              
557             sub me {
558 0     0 1 0 my $self = shift;
559 0         0 DEBUG('Request user account info');
560 0         0 my $result = $self->api_json_request(api => API_ME);
561             # Account has no data property like other things
562 0         0 return Reddit::Client::Account->new($self, $result);
563             }
564             sub list_subreddits {
565 0     0 1 0 my ($self, %param) = @_;
566 0   0     0 my $type = $param{view} || SUBREDDITS_HOME;
567 0 0       0 $type = '' if lc $type eq 'home';
568              
569 0         0 my $query = $self->set_listing_defaults(%param);
570              
571 0 0 0     0 my $api = $type eq SUBREDDITS_MOD || $type eq SUBREDDITS_CONTRIB || $type eq SUBREDDITS_MINE ? API_MY_SUBREDDITS : API_SUBREDDITS;
572              
573 0         0 my $result = $self->api_json_request(
574             api => $api,
575             args => [$type],
576             data => $query,
577             );
578              
579             return [
580 0         0 map {Reddit::Client::SubReddit->new($self, $_->{data})} @{$result->{data}{children}}
  0         0  
  0         0  
581             ];
582             }
583              
584             sub contrib_subreddits {
585 0     0 0 0 my ($self, %param) = @_;
586 0         0 $param{view} = SUBREDDITS_CONTRIB;
587 0         0 return $_[0]->list_subreddits(%param);
588             }
589             sub home_subreddits {
590 0     0 0 0 my ($self, %param) = @_;
591 0         0 $param{view} = SUBREDDITS_HOME;
592 0         0 return $_[0]->list_subreddits(%param);
593             }
594             sub mod_subreddits {
595 0     0 0 0 my ($self, %param) = @_;
596 0         0 $param{view} = SUBREDDITS_MOD;
597 0         0 return $_[0]->list_subreddits(%param);
598             }
599             sub my_subreddits {
600 0     0 0 0 my ($self, %param) = @_;
601 0         0 $param{view} = SUBREDDITS_MINE;
602 0         0 return $_[0]->list_subreddits(%param);
603             }
604             sub new_subreddits {
605 0     0 0 0 my ($self, %param) = @_;
606 0         0 $param{view} = SUBREDDITS_NEW;
607 0         0 return $_[0]->list_subreddits(%param);
608             }
609             sub popular_subreddits {
610 0     0 0 0 my ($self, %param) = @_;
611 0         0 $param{view} = SUBREDDITS_POPULAR;
612 0         0 return $_[0]->list_subreddits(%param);
613             }
614              
615             #===============================================================================
616             # Inbox and messages
617             #===============================================================================
618             sub get_inbox {
619 0     0 1 0 my ($self, %param) = @_;
620 0   0     0 my $limit = $param{limit} || DEFAULT_LIMIT;
621 0   0     0 my $mode = $param{mode} || MESSAGES_INBOX;
622 0   0     0 my $view = $param{view} || MESSAGES_INBOX;
623              
624             # this before and after business is stupid and needs to be fixed
625             # in 3 separate places
626 0         0 my $query = {};
627 0 0       0 $query->{mark} = $param{mark} ? 'true' : 'false';
628 0 0       0 $query->{sr_detail} = $param{sr_detail} if $param{sr_detail};
629 0 0       0 $query->{before} = $param{before} if $param{before};
630 0 0       0 $query->{after} = $param{after} if $param{after};
631 0 0 0     0 if (exists $param{limit}) { $query->{limit} = $param{limit} || 500; }
  0         0  
632 0         0 else { $query->{limit} = DEFAULT_LIMIT; }
633            
634 0         0 my $result = $self->api_json_request(
635             api => API_MESSAGES,
636             args => [$view],
637             data => $query,
638             );
639              
640             #return $result;
641             return [
642 0         0 map { Reddit::Client::Message->new($self, $_->{data}) } @{$result->{data}{children}}
  0         0  
  0         0  
643             ];
644             }
645              
646             # TODO
647             sub mark_read {
648 0     0 0 0 my ($self, %param) = @_;
649              
650             }
651              
652             sub mark_inbox_read {
653 0     0 1 0 my $self = shift;
654 0         0 my ($method, $path) = @{$API[API_MARKALL]};
  0         0  
655             # Why does this error without api_type? json_request is adding it anyway?
656 0         0 my $post_data = {api_type => 'json'};
657 0         0 my $result = $self->request($method, $path, {}, $post_data);
658             }
659              
660             #===============================================================================
661             # Subreddits and listings
662             #===============================================================================
663              
664             # works section 1:
665             # banned, muted, wikibanned, contributors, wikicontributors, moderators, edit, log
666              
667             # should work but returns undef:
668             # rules (uses read), traffic (uses modconfig),
669             #
670             sub get_subreddit_info {
671 0     0 1 0 my $self = shift;
672 0   0     0 my $sub = shift || croak 'Argument 1 (subreddit name) is required.';
673 0         0 $sub = subreddit($sub);
674 0         0 my $page = shift;
675              
676 0         0 my ($api, $args);
677 0 0       0 if ($page) {
678 0         0 $api = API_SUBINFO;
679 0         0 $args = [$sub, $page];
680             } else {
681 0         0 $api = API_ABOUT;
682 0         0 $args = [$sub];
683             }
684              
685 0         0 my $result = $self->api_json_request(
686             api => $api,
687             args => $args,
688             );
689             #return $result->{data};
690 0         0 return $result;
691             }
692              
693             sub info {
694 0     0 1 0 my ($self, $id) = @_;
695 0 0       0 defined $id || croak 'Expected $id';
696 0         0 my $query->{id} = $id;
697            
698 0         0 my $info = $self->api_json_request(
699             api => API_INFO,
700             data=>$query
701             );
702             #return $info;
703 0         0 my $rtn = $info->{data}->{children}[0]->{data};
704 0 0       0 $rtn->{kind} = $info->{data}->{children}[0]->{kind} if $rtn;
705 0         0 return $rtn;
706             }
707              
708             sub search {
709 0     0 0 0 my ($self, %param) = @_;
710 0   0     0 my $sub = $param{subreddit} || $param{sub} || croak "'subreddit' or 'sub' is required.";
711              
712 0         0 my $query = $self->set_listing_defaults(%param);
713 0   0     0 $query->{q} = $param{q} || croak "'q' (search string) is required.";
714              
715             # things the user should be able to choose but we're hard coding
716 0         0 $query->{restrict_sr} = 'on';
717 0         0 $query->{include_over18}= 'on';
718 0         0 $query->{t} = 'all';
719 0         0 $query->{syntax} = 'cloudsearch';
720 0         0 $query->{show} = 'all';
721 0         0 $query->{type} = 'link'; # return Link objects
722 0         0 $query->{sort} = 'top';
723            
724 0         0 my $args = [$sub];
725              
726 0         0 my $result = $self->api_json_request(
727             api => API_SEARCH,
728             args=> $args,
729             data => $query,
730             );
731              
732             #return $result->{data};
733             return [
734 0         0 map {Reddit::Client::Link->new($self, $_->{data})} @{$result->{data}{children}}
  0         0  
  0         0  
735             ];
736             }
737             sub get_permalink {
738             # This still makes an extra request. Why?
739 0     0 1 0 my ($self, $commentid, $post_fullname) = @_;
740              
741 0 0       0 if (substr ($commentid, 0, 3) eq "t1_") { $commentid = substr $commentid, 3; }
  0         0  
742 0 0       0 if (substr ($post_fullname, 0, 3) ne "t3_") { $post_fullname = "t3_" . $post_fullname; }
  0         0  
743              
744 0         0 my $info = $self->info($post_fullname);
745 0         0 return sprintf "%s%s%s", $LINK_URL, $info->{permalink}, $commentid;
746             }
747              
748             sub find_subreddits {
749 0     0 1 0 my ($self, %param) = @_;
750              
751 0         0 my $query = $self->set_listing_defaults(%param);
752 0   0     0 $query->{q} = $param{q} || croak "expected 'q'";
753 0   0     0 $query->{sort} = $param{sort} || 'relevance';
754              
755 0         0 my $result = $self->api_json_request(
756             api => API_SUB_SEARCH,
757             data => $query,
758             );
759             return [
760 0         0 map { Reddit::Client::SubReddit->new($self, $_->{data}) } @{$result->{data}{children}}
  0         0  
  0         0  
761             ];
762             }
763              
764             sub fetch_links {
765 0     0 0 0 my ($self, %param) = @_;
766 0   0     0 my $subreddit = $param{sub} || $param{subreddit} || '';
767 0   0     0 my $view = $param{view}|| VIEW_DEFAULT;
768              
769 0         0 my $query = $self->set_listing_defaults(%param);
770              
771 0         0 $subreddit = subreddit($subreddit);
772              
773 0         0 my $args = [$view];
774 0 0       0 unshift @$args, $subreddit if $subreddit;
775              
776             #$API[API_LINKS_OTHER ] = ['GET', '/%s' ];
777             #$API[API_LINKS_FRONT ] = ['GET', '/r/%s/%s' ];
778             # this is backwards? front is actually a specific sub, other is front page
779 0 0       0 my $result = $self->api_json_request(
780             api => ($subreddit ? API_LINKS_FRONT : API_LINKS_OTHER),
781             args => $args,
782             data => $query,
783             );
784             #return $result;
785              
786             return [
787 0         0 map { Reddit::Client::Link->new($self, $_->{data}) } @{$result->{data}{children}}
  0         0  
  0         0  
788             ];
789             }
790              
791             sub get_links { # alias for fetch_links to make naming convention consistent
792 0     0 1 0 my ($self, %param) = @_;
793 0         0 return $self->fetch_links(%param);
794             }
795             # Is this a better way to get a single link than a call to info?
796             sub get_links_by_id {
797 0     0 1 0 my ($self, @fullnames) = @_;
798 0 0       0 die "get_links_by_id: argument 1 (\@fullnames) is required.\n" unless @fullnames;
799 0         0 @fullnames = map { fullname($_, 't3') } @fullnames;
  0         0  
800 0         0 my $str = join ",", @fullnames;
801             # what the fuck is this?
802 0         0 my $result = $self->json_request('GET', $API[API_BY_ID][1]."/$str");
803              
804             return [
805 0         0 map { Reddit::Client::Link->new($self, $_->{data}) } @{$result->{data}{children}}
  0         0  
  0         0  
806             ];
807             }
808              
809             sub get_link {
810 0     0 1 0 my ($self, $fullname) = @_;
811 0 0       0 die "get_link: need arg 1 (id/fullname)" unless $fullname;
812              
813 0         0 $fullname = fullname($fullname, 't3');
814 0         0 my $result = $self->json_request('GET', $API[API_BY_ID][1]."/$fullname");
815             # empty return is caused by purged post, not error on our part
816 0         0 return Reddit::Client::Link->new($self, $result->{data}{children}[0]{data});
817             }
818              
819             sub get_comment {
820 0     0 1 0 my ($self, $fullname, %param) = @_;
821 0 0       0 croak "expected argument 1: id or fullname" unless $fullname;
822              
823 0         0 $fullname = fullname($fullname, 't1');
824 0         0 my $info = $self->info($fullname);
825 0 0       0 return unless $info;
826              
827 0         0 my $cmt = Reddit::Client::Comment->new($self, $info);
828 0 0 0     0 if ($param{include_children} and $cmt->{permalink}) {
829 0         0 $cmt = $self->get_comments(permalink=>$cmt->{permalink});
830 0         0 $cmt = $$cmt[0];
831             }
832 0         0 return $cmt;
833             }
834              
835             sub get_subreddit_comments {
836 0     0 1 0 my ($self, %param) = @_;
837 0   0     0 my $subreddit = $param{sub} || $param{subreddit} || '';
838 0   0     0 my $view = $param{view} || VIEW_DEFAULT;
839              
840 0         0 my $query = {};
841 0 0       0 $query->{before} = $param{before} if $param{before};
842 0 0       0 $query->{after} = $param{after} if $param{after};
843 0 0 0     0 if (exists $param{limit}) { $query->{limit} = $param{limit} || 500; }
  0         0  
844 0         0 else { $query->{limit} = DEFAULT_LIMIT; }
845              
846 0         0 $subreddit = subreddit($subreddit); # remove slashes and leading r/
847 0 0       0 my $args = $subreddit ? [$subreddit] : [];
848              
849 0 0       0 my $result = $self->api_json_request(
850             api => ($subreddit ? API_COMMENTS : API_COMMENTS_FRONT),
851             args => $args,
852             data => $query,
853             );
854              
855             #return $result;
856             #return $result->{data}{children}[0]->{data};
857             return [
858 0         0 map {Reddit::Client::Comment->new($self, $_->{data})} @{$result->{data}{children}}
  0         0  
  0         0  
859             ];
860             }
861              
862             #=============================================================
863             # Moderation
864             #=============================================================
865             sub remove {
866 0     0 1 0 my $self = shift;
867 0   0     0 my $fullname = shift || die "remove: arg 1 (fullname) is required.\n";
868            
869 0         0 my $result = $self->api_json_request(
870             api => API_REMOVE,
871             data => { id => $fullname, spam=> 'false' },
872             );
873 0         0 return $result;
874             }
875             # like remove, but sets spam flag
876             sub spam {
877 0     0 0 0 my $self = shift;
878 0   0     0 my $fullname = shift || croak "spam: arg 1 (fullname) is required.\n";
879            
880 0         0 my $result = $self->api_json_request(
881             api => API_REMOVE,
882             data => { id => $fullname, spam => 'true' },
883             );
884 0         0 return $result;
885             }
886             sub approve {
887 0     0 1 0 my $self = shift;
888 0   0     0 my $fullname = shift || die "approve: arg 1 (fullname) is required.\n";
889            
890 0         0 my $result = $self->api_json_request(
891             api => API_APPROVE,
892             data => { id => $fullname },
893             );
894 0         0 return $result;
895             }
896             sub ignore_reports {
897 0     0 1 0 my $self = shift;
898 0   0     0 my $fullname = shift || die "ignore_reports: arg 1 (fullname) is required.\n";
899            
900 0         0 my $result = $self->api_json_request(
901             api => API_IGNORE_REPORTS,
902             data => { id => $fullname },
903             );
904 0         0 return $result;
905             }
906             sub lock {
907 0     0 1 0 my ($self, $fullname, %param) = @_;
908 0 0       0 die "lock: arg 1 (fullname) is required.\n" unless $fullname;
909              
910 0 0 0     0 if (!ispost($fullname) and !iscomment($fullname)) {
911 0         0 die "lock: arg 1 must be a fullname of a post or comment.\n";
912             }
913              
914 0 0       0 my $lock = exists $param{lock} ? $param{lock} : 1;
915              
916 0 0       0 my $result = $self->api_json_request(
917             api => $lock ? API_LOCK : API_UNLOCK,
918             data => { id => $fullname },
919             );
920 0         0 return $result;
921             }
922             sub unlock {
923 0     0 1 0 my ($self, $fullname, %param) = @_;
924            
925 0         0 return $self->lock($fullname, lock=>0);
926             }
927             sub nsfw {
928 0     0 1 0 my ($self, $fullname, %param) = @_;
929 0 0       0 die "nsfw: arg 1 (fullname) is required.\n" unless $fullname;
930              
931 0 0       0 if (!ispost($fullname)) {
932 0         0 die "nsfw: arg 1 must be a fullname of a post or comment.\n";
933             }
934              
935 0 0       0 my $nsfw = exists $param{nsfw} ? $param{nsfw} : 1;
936              
937 0 0       0 my $result = $self->api_json_request(
938             api => $nsfw ? API_MARKNSFW : API_UNMARKNSFW,
939             data => { id => $fullname },
940             );
941 0         0 return $result;
942             }
943             sub unnsfw {
944 0     0 1 0 my ($self, $fullname, %param) = @_;
945            
946 0         0 return $self->nsfw($fullname, nsfw=>0);
947             }
948             # -ban is really a call to friend, which creates relationships between accounts.
949             # other functions can call it and pass in a different mode (see functions below)
950             # this is to make it just as unreadable as Reddit's endpoint
951             # TODO: make this a general fn, call ban from outside like modinvite is
952             #
953             # -ban uses the "modcontributors" oauth scope EXCEPT:
954             # -moderator and moderator_invite use "modothers"
955             # -wikibanned and wikicontributor require both modcontributors and modwiki
956             # https://old.reddit.com/dev/api/#POST_api_friend
957             #
958             sub ban {
959 0     0 1 0 my ($self, %param) = @_;
960 0   0     0 my $sub = $param{sub} || $param{subreddit} || die "subreddit is required\n";
961            
962 0         0 my $data = {};
963 0   0     0 $data->{name} = $param{user} || $param{username} || die "username is required\n";
964             # ban_context = fullname (of what?) - not required
965              
966             # Ban message
967 0 0       0 $data->{ban_message} = $param{ban_message} if $param{ban_message};
968             # Reason: short report reason
969 0 0       0 if ($param{reason}) {
970 0 0       0 if (length $param{reason} > 100) {
971 0         0 print "Warning: 'reason' longer than 100 characters. Truncating.\n";
972 0         0 $param{reason} = substr $param{reason}, 0, 100;
973             }
974 0         0 $data->{ban_reason} = $param{reason};
975             }
976              
977 0 0       0 if ($param{note}) {
978 0 0       0 if (length $param{note} > 300) {
979 0         0 print "Warning: 'note' longer than 300 characters. Truncating.\n";
980 0         0 $param{note} = substr $param{note}, 0, 300;
981             }
982 0         0 $data->{note} = $param{note};
983             }
984              
985 0 0       0 if ($param{duration}){ # if 0 this never even hits which we want anyway
986 0 0       0 if ($param{duration} > 999) {
    0          
987 0         0 print "Warning: Max duration is 999. Setting to 999.\n";
988 0         0 $param{duration} = 999;
989             } elsif ($param{duration} < 1) {
990 0         0 $param{duration} = 0;
991             }
992 0 0       0 $data->{duration} = $param{duration} if $param{duration};
993             }
994             # $data->{container} is not needed unless mode is friend or enemy
995             # from docs for unfriend https://old.reddit.com/dev/api/#POST_api_unfriend:
996             # The user can either be passed in by name (nuser) or by fullname (iuser). If type is friend or enemy, 'container' MUST be the current user's fullname; for other types, the subreddit must be set via URL (e.g., /r/funny/api/unfriend)
997             # So what would the arg be? /r//api/friend?
998             # Unfriend has its own endpoint too
999             # $data->{permissions} = ?
1000              
1001             # type is one of (friend, moderator, moderator_invite, contributor, banned, muted, wikibanned, wikicontributor)
1002 0 0       0 if ($param{mode} eq 'mute') {
    0          
    0          
1003 0         0 $data->{type} = 'muted';
1004             } elsif ($param{mode} eq 'contributor') {
1005 0         0 $data->{type} = 'contributor';
1006             } elsif ($param{mode} eq 'moderator_invite') {
1007             #print "modinvite\n";
1008 0         0 $data->{type} = 'moderator_invite';
1009             } else {
1010 0         0 $data->{type} = 'banned';
1011             }
1012              
1013 0         0 my $result = $self->api_json_request(
1014             api => API_BAN,
1015             args => [$sub],
1016             data => $data,
1017             );
1018 0         0 return $result;
1019             }
1020              
1021             sub mute {
1022 0     0 1 0 my ($self, %param) = @_;
1023 0         0 $param{mode} = 'mute';
1024 0         0 return $self->ban(%param);
1025             }
1026              
1027             sub add_approved_user {
1028 0     0 0 0 my ($self, %param) = @_;
1029 0         0 $param{mode} = 'contributor';
1030 0         0 return $self->ban(%param);
1031             }
1032             # more sensible version of add_approved_user
1033             sub approve_user {
1034 0     0 1 0 my ($self, $user, $sub) = @_;
1035 0         0 my %param;
1036 0   0     0 $param{username} = $user || die "approve_user: arg 1 (username) is required.\n";
1037 0   0     0 $param{subreddit} = $sub || die "approve_user: arg 2 (sub) is required.\n";
1038 0         0 $param{mode} = 'contributor';
1039 0         0 return $self->ban(%param);
1040             }
1041             # Requires scope 'modothers'
1042             sub invite_moderator {
1043 0     0 0 0 my ($self, %param) = @_;
1044 0         0 $param{mode} = 'moderator_invite';
1045 0         0 return $self->ban(%param);
1046             }
1047             # so we already had a function to do this and we wrote another one
1048             sub invite_mod {
1049 0     0 0 0 my ($this, $sub, $user) = @_;
1050              
1051 0         0 return $this->ban( # excellent naming of that function, bravo
1052             user => $user,
1053             sub => $sub,
1054             mode => 'moderator_invite',
1055             );
1056             }
1057              
1058             sub unban {
1059 0     0 1 0 my ($self, %param) = @_;
1060 0   0     0 my $sub = $param{sub} || $param{subreddit} || die "subreddit is required\n";
1061            
1062 0         0 my $data = {};
1063 0   0     0 $data->{name} = $param{username} || die "username is required\n";
1064             # ban_context = fullname, but of what - not required
1065              
1066 0 0       0 if ($param{mode} eq 'mute') {
1067 0         0 $data->{type} = 'muted';
1068             } else {
1069 0         0 $data->{type} = 'banned';
1070             }
1071              
1072 0         0 my $result = $self->api_json_request(
1073             api => API_UNBAN,
1074             args => [$sub],
1075             data => $data,
1076             );
1077 0         0 return $result;
1078             }
1079              
1080             sub unmute {
1081 0     0 1 0 my ($self, %param) = @_;
1082 0         0 $param{mode} = 'mute';
1083 0         0 return $self->unban(%param);
1084             }
1085              
1086             sub distinguish {
1087 0     0 1 0 my ($self, $fullname, %param) = @_;
1088 0         0 my $data = {};
1089              
1090 0 0 0     0 if (!iscomment($fullname) and !ispost($fullname)) {
1091 0         0 die 'Fullname is required (comment preceeded by "t1_", post "t3_")';
1092             }
1093              
1094 0 0       0 if (iscomment($fullname)) {
1095             # only top level can be sticky
1096 0 0       0 my $sticky = exists $param{sticky} ? $param{sticky} : 0;
1097 0 0       0 $data->{sticky} = $sticky ? 'true' : 'false';
1098             }
1099              
1100 0         0 $data->{id} = $fullname;
1101              
1102              
1103 0         0 $data->{how} = 'yes';
1104             # Check manual setting of 'how'. Normal users should never set 'how'.
1105 0 0       0 if ($param{how}) {
1106 0         0 my @valid = qw/yes no admin special/;
1107 0         0 my $ok;
1108 0         0 for (@valid) {
1109 0 0       0 if ($param{how} eq $_) {
1110 0         0 $ok = 1;
1111 0         0 last; # because we have to save potentially TWO CYCLES, right asshole? yeah spend all day on 2 cycles, that's a good use of your time
1112             }
1113             }
1114              
1115 0 0       0 die "valid values for 'how' are: yes, no, admin, special\n" unless $ok;
1116             }
1117            
1118 0         0 my $result = $self->api_json_request(
1119             api => API_DISTINGUISH,
1120             data => $data,
1121             );
1122 0         0 return $result;
1123             }
1124              
1125             sub undistinguish {
1126 0     0 1 0 my ($self, $fullname, %param) = @_;
1127 0         0 my $data = {};
1128              
1129 0 0 0     0 if (!iscomment($fullname) and !ispost($fullname)) {
1130 0         0 die 'Fullname is required (comment preceeded by "t1_", post "t3_")';
1131             }
1132              
1133 0         0 $data->{id} = $fullname;
1134 0         0 $data->{how} = 'no';
1135              
1136 0         0 my $result = $self->api_json_request(
1137             api => API_UNDISTINGUISH,
1138             data => $data,
1139             );
1140 0         0 return $result;
1141             }
1142              
1143             # https://old.reddit.com/dev/api/#POST_api_report
1144             # Send a report. Don't know what most of these fields do. made them all optional
1145             sub report {
1146 0     0 0 0 my ($this, %param) = @_;
1147              
1148             # Nearly all optional until we know what they do lol
1149 0         0 my $data = {};
1150             # is sub required, tho? Not for a sitewide report
1151             # required here so we don't accidentally send a sitewide report
1152 0 0       0 $data->{custom_text} = $param{custom_text} if $param{custom_text};
1153 0 0       0 $data->{from_help_desk} = bool($param{from_help_desk}) if exists $param{from_help_desk};
1154 0 0       0 $data->{from_modmail} = bool($param{from_modmail}) if exists $param{from_modmail};
1155              
1156 0 0       0 $data->{modmail_conv_id}= $param{modmail_conv_id} if $param{modmail_conv_id};
1157 0 0       0 $data->{other_reason} = $param{other_reason} if $param{other_reason};
1158 0 0       0 $data->{reason} = $param{reason} if $param{reason};
1159 0 0       0 $data->{rule_reason} = $param{rule_reason} if $param{rule_reason};
1160 0 0       0 $data->{site_reason} = $param{site_reason} if $param{site_reason};
1161             #$data->{sr_name} = $param{sub} || $param{subreddit} || croak "sub or subreddit is required."; # API says sr_name can be 1000 characters?
1162 0 0 0     0 $data->{sr_name} = $param{sub}||$param{subreddit} if $param{sub}||$param{subreddit};
      0        
1163 0   0     0 my $id = $param{id}||$param{fullname} || croak "fullname (alias id) is required";
1164 0 0       0 croak "fullname (alias id) must be a fullname" unless $id =~ /^t[0-9]_/;
1165 0         0 $data->{thing_id} = $id;
1166            
1167             #$data->{strict_freeform_reports} = bool($param{strict_freeform_reports}) if exists $param{strict_freeform_reports};
1168 0         0 $data->{strict_freeform_reports} = "true"; # see docs
1169 0 0       0 $data->{usernames} = $param{usernames} if $param{usernames}; # a comma-delimited list
1170              
1171 0         0 return $this->api_json_request(
1172             api => API_REPORT,
1173             data => $data,
1174             );
1175             }
1176              
1177             sub get_modlinks {
1178 0     0 1 0 my ($self, %param) = @_;
1179              
1180 0         0 my $query = $self->set_listing_defaults(%param);
1181 0   0     0 my $sub = $param{sub} || $param{subreddit} || 'mod';
1182 0   0     0 my $mode = $param{mode} || 'modqueue';
1183              
1184 0         0 my $result = $self->api_json_request(
1185             api => API_MODQ,
1186             args => [$sub, $mode],
1187             data => $query,
1188             );
1189              
1190             #return $result->{data};
1191              
1192             return [
1193             map {
1194              
1195             $_->{kind} eq "t1" ?
1196             Reddit::Client::Comment->new($self, $_->{data}) :
1197             Reddit::Client::Link->new($self, $_->{data})
1198 0 0       0 }
1199              
1200 0         0 @{$result->{data}{children}}
  0         0  
1201             ];
1202             }
1203             sub get_modqueue {
1204 0     0 1 0 my ($self, %param) = @_;
1205 0         0 $param{mode} = 'modqueue';
1206 0         0 return $self->get_modlinks(%param);
1207             }
1208              
1209             # Get new modmail. This returns metadata and the first message for each conver-
1210             # sation. Full conversations must be loaded separately with get_conversation
1211              
1212             # after: conversation id
1213             # entity: comma-delimited list of subreddit names
1214             # limit
1215             # sort: one of (recent, mod, user, unread)
1216             # state: one of (new, inprogress, mod, notifications, archived, highlighted, all
1217              
1218             # Returns:
1219             # conversationIds, array of conversation IDs
1220             # conversations, hash of data about the conversation, keys are conversation IDs
1221             # -subject
1222             # -numMessages
1223             # -state - corresponds to state arg?
1224             # -authors, array of hashes of information about each author
1225             # -participant, hash of info about the user from the top message?
1226             # -owner, hash of info about the sub
1227             sub get_modmail {
1228 0     0 0 0 my ($self, %param) = @_;
1229              
1230 0         0 my $data = {};
1231 0   0     0 $data->{sort} = $param{sort} || 'unread';
1232 0   0     0 $data->{state} = $param{state} || 'all';
1233 0 0       0 $data->{after} = $param{after} if $param{after};
1234 0 0       0 $data->{limit} = exists $param{limit} ? ( $param{limit} ? $param{limit} : 500 ) : DEFAULT_LIMIT;
    0          
1235              
1236 0   0     0 my $subs = $param{entity} || $param{subreddits} || $param{subs};
1237 0 0       0 if ($subs) {
1238 0 0       0 $subs = join ",", @$subs if ref $subs eq 'ARRAY';
1239 0 0       0 $data->{entity} = $subs if $subs;
1240             }
1241 0         0 my $result = $self->api_json_request(
1242             api => API_GET_MODMAIL,
1243             data => $data,
1244             );
1245 0         0 return $result;
1246             }
1247              
1248             # GET /api/mod/conversations/:conversation_id
1249             # Returns all messages, mod actions and conversation metadata for id
1250             # conversation_id base36 modmail conversation id
1251             # markRead boolean
1252              
1253             sub get_conversation {
1254 0     0 0 0 my ($this, $id, %param) = @_;
1255              
1256             }
1257              
1258             # "This endpoint will create a ModmailConversation object as well as the first ModmailMessage within the ModmailConversation object."
1259             sub new_modmail_conversation {
1260 0     0 1 0 my ($this, %param) = @_;
1261 0         0 my $data = {};
1262              
1263 0   0     0 $data->{body} = $param{body} || croak "new_modmail_conversation: body is required.";
1264             # Unlike Reddit's functionality, this hides the author name by default
1265             my $auth = exists $param{isAuthorHidden} ? $param{isAuthorHidden} :
1266 0 0       0 ( exists $param{hide_author} ? $param{hide_author} : 1 );
    0          
1267             #$data->{isAuthorHidden} = exists $param{isAuthorHidden} ? ( $param{isAuthorHidden} ? "true" : "false" ) : "true";
1268 0 0       0 $data->{isAuthorHidden} = $auth ? "true" : "false";
1269 0   0     0 $data->{srName} = $param{subreddit} || $param{sub} || $param{srName} || croak "new_modmail_conversation: subreddit is required (also accepts aliases 'sub' and 'srName')";
1270 0   0     0 my $subj = $param{subject} || croak "new_modmail_conversation: subject is required";
1271 0 0       0 if (length $subj > 100) {
1272 0         0 print "new_modmail_conversation: subject truncated to 100 characters.\n";
1273 0         0 $subj = substr $subj, 0, 100;
1274             }
1275 0         0 $data->{subject} = $subj;
1276              
1277             # users only or can subreddit be target?
1278 0   0     0 $data->{to} = $param{to} || croak "new_modmail_conversation: fullname is required.";
1279             #$fullname = fullname
1280             # body, isAuthorHidden, srName, subject=100 chars, to=fullname
1281             # documentation is WRONG. to is not a fullname, it's just a username
1282 0         0 my $result = $this->api_json_request(
1283             api => API_NEW_MM_CONV,
1284             data => $data,
1285             );
1286 0 0       0 if (ref $result eq 'HASH') {
1287 0         0 return new Reddit::Client::ModmailConversation($this, $result->{conversation}, $result->{messages}, $result->{modActions});
1288             }
1289 0         0 return $result;
1290             }
1291              
1292             sub sticky_post {
1293 0     0 0 0 my ($this, $id, %opt) = @_;
1294 0         0 my $data = {};
1295             # docs say id but maybe they mean fullname
1296 0   0     0 $id = fullname($id, 't3') || die "sticky_post: arg 1 (id) is required.\n";
1297 0         0 $data->{id} = $id;
1298              
1299 0 0       0 if ($opt{num}) {
1300 0 0       0 if ($opt{num} =~ /^[1234]$/) {
1301 0         0 $data->{num} = $opt{num};
1302             } else {
1303 0         0 print "sticky_post: option 'num' must be an integer from 1-4. Unsetting.\n";
1304             }
1305             }
1306            
1307 0 0       0 $data->{state} = exists $opt{sticky} ? ($opt{sticky} ? "true" : "false") : "true";
    0          
1308 0 0       0 $data->{to_profile} = exists $opt{to_profile} ? ($opt{to_profile} ? "true" : "false") : "false";
    0          
1309              
1310 0         0 return $this->api_json_request(
1311             api => API_STICKY_POST,
1312             data => $data,
1313             );
1314              
1315             }
1316              
1317             #=============================================================
1318             # New modmail functions
1319             # most use the same URL format so we should make a central function
1320              
1321             # Sub for many modmail actions
1322             # these actions take no args, just the action
1323             # TODO: call these from ModmailConversation
1324             sub modmail_action {
1325 0     0 0 0 my ($this, $action, $id) = @_;
1326 0 0 0     0 croak "args 1 and 2 (action and id) are required" unless $action and $id;
1327 0         0 $action = lc $action;
1328              
1329             # Choose MM_POST_ACTION or MM_GET_ACTION
1330             # POST: bulk_read, approve (?), archive, disapprove (?), highlight,
1331             # unarchive, unban, unmute
1332              
1333             # POST: read and unread take single arg
1334              
1335             # POST: mute takes hours, has own function
1336             # POST: temp_ban takes duration, support elsehwere
1337              
1338             # only hightlight uses DELETE, not supporting
1339 0         0 my @post_actions = qw/bulk_read approve archive disapprove highlight unarchive unban unmute /;
1340 0         0 my $api;
1341 0         0 for (@post_actions) {
1342 0 0       0 if ($action eq $_) {
1343 0         0 $api = API_MM_POST_ACTION;
1344 0         0 last;
1345             }
1346             }
1347 0 0       0 croak "'$action' is not a recognized action. only POST actions are implemented at this time." unless $api;
1348              
1349              
1350 0         0 return $this->api_json_request(
1351             api => $api,
1352             args => [$id, $action],
1353             );
1354             }
1355              
1356              
1357             # num_hours one of (72, 168, 672)
1358             sub modmail_mute {
1359 0     0 0 0 my ($this, $id, $length) = @_;
1360 0   0     0 $length ||= 72;
1361              
1362             # We should accept days too
1363 0 0 0     0 if ($length == 3 or $length == 7 or $length == 28) {
    0 0        
      0        
      0        
1364 0         0 $length *= 24;
1365             } elsif ($length != 72 and $length != 168 and $length != 672) {
1366 0         0 die "arg 2 (length) must be 3, 7, or 28 days (or 72, 168, or 672 hours)\n";
1367             }
1368              
1369 0         0 my $data = { num_hours => $length };
1370 0         0 my $args = [ $id ];
1371              
1372 0         0 return $this->api_json_request(
1373             api => API_MM_MUTE,
1374             args => $args,
1375             data => $data,
1376             );
1377             }
1378              
1379             #=============================================================
1380             # Users
1381             #=============================================================
1382             sub get_user {
1383             #my ($self, %param) = @_;
1384             #$user = $param{user} || $param{username} || croak "expected 'user'";
1385             #$view = $param{view} || 'overview';
1386 0     0 1 0 my $self = shift;
1387 0         0 my ($user, $view, %param);
1388              
1389             # old ver: user=>$user, view=>$view
1390             # what if someone passes in another key?
1391             # this fails with unpredictable results lol
1392              
1393             # even elements = old way, odd = new way
1394 0         0 my $odd = scalar(@_) % 2;
1395 0 0 0     0 if (!$odd or $_[0] eq 'user' or $_[0] eq 'username' or $_[0] eq 'view') {
      0        
      0        
1396 0         0 print "This form of get_user is deprecated. A future version will take the following simplified argument structure: get_user(\$username, \%params)\n";
1397 0         0 %param = @_;
1398 0   0     0 $user = $param{user} || $param{username} || croak "expected 'user'";
1399             } else {
1400             # new ver: $user, %params
1401 0         0 $user = shift;
1402 0         0 %param= @_;
1403             }
1404              
1405 0   0     0 $view = $param{view} || 'overview';
1406              
1407             # This can accept limit as data? are all GET string args sent as data?
1408 0         0 my $data = $self->set_listing_defaults(%param);
1409              
1410 0         0 my $args = [$user, $view];
1411              
1412             # $API[API_USER ] = ['GET', '/user/%s/%s' ];
1413             # view is different here; would need third arg, 'sort=new'
1414             # /user/TheUser/submitted?sort=new
1415 0         0 my $result = $self->api_json_request(
1416             api => API_USER,
1417             args => $args,
1418             data => $data,
1419             );
1420              
1421 0 0       0 if ($view eq 'about') {
1422 0         0 return Reddit::Client::Account->new($self, $result->{data});
1423             }
1424              
1425             return [
1426             map {
1427              
1428             $_->{kind} eq "t1" ?
1429             Reddit::Client::Comment->new($self, $_->{data}) :
1430             Reddit::Client::Link->new($self, $_->{data})
1431 0 0       0 }
1432              
1433 0         0 @{$result->{data}{children}}
  0         0  
1434             ];
1435             }
1436             #===============================================================================
1437             # Change posts or comments
1438             #===============================================================================
1439              
1440             sub edit {
1441 0     0 1 0 my ($self, $name, $text) = @_;
1442 0         0 my $type = substr $name, 0, 2;
1443 0 0 0     0 croak 'Argument 1 ($fullname) must be a post or comment.' if $type ne 't1' && $type ne 't3';
1444 0 0       0 croak 'Argument 2 (text) is required. Empty strings are allowed.' unless defined $text;
1445              
1446 0         0 my $data = {
1447             thing_id => $name,
1448             text => $text
1449             };
1450              
1451 0         0 my $result = $self->api_json_request(
1452             api => API_EDIT,
1453             data => $data,
1454             );
1455 0         0 return $result->{data}{things}[0]{data}{name};
1456             }
1457              
1458             sub delete {
1459 0     0 1 0 my ($self, $name) = @_;
1460 0 0       0 croak 'Expected $fullname' if !$name;
1461 0         0 my $type = substr $name, 0, 2;
1462 0 0 0     0 croak '$fullname must be a post or comment' if $type ne 't1' && $type ne 't3';
1463              
1464 0         0 DEBUG('Delete post/comment %s', $name);
1465              
1466 0         0 my $result = $self->api_json_request(api => API_DEL, data => { id => $name });
1467 0         0 return $result;
1468             }
1469              
1470             #===============================================================================
1471             # Submitting links
1472             #===============================================================================
1473              
1474             sub submit_link {
1475 0     0 1 0 my ($self, %param) = @_;
1476             # why is sub allowed to be empty?
1477 0   0     0 my $subreddit = $param{subreddit} || $param{sub} || '';
1478 0   0     0 my $title = $param{title} || croak 'Expected "title"';
1479 0   0     0 my $url = $param{url} || croak 'Expected "url"';
1480 0 0       0 my $replies = exists $param{inbox_replies} ? ($param{inbox_replies} ? "true" : "false") : "true";
    0          
1481 0 0       0 my $repost = exists $param{repost} ? ($param{repost} ? "true" : "false") : "false";
    0          
1482 0 0       0 my $nsfw = exists $param{nsfw} ? ($param{nsfw} ? "true" : "false") : "false";
    0          
1483              
1484 0         0 DEBUG('Submit link to %s: %s', $subreddit, $title, $url);
1485              
1486 0         0 $subreddit = subreddit($subreddit);
1487              
1488 0         0 my $result = $self->api_json_request(api => API_SUBMIT, data => {
1489             title => $title,
1490             url => $url,
1491             sr => $subreddit,
1492             kind => SUBMIT_LINK,
1493             sendreplies => $replies,
1494             resubmit => $repost,
1495             nsfw => $nsfw,
1496             });
1497              
1498 0         0 return $result->{data}{name};
1499             }
1500              
1501             sub submit_crosspost {
1502 0     0 1 0 my ($self, %param) = @_;
1503             # why is subreddit allowed to be empty?
1504 0   0     0 my $subreddit = $param{subreddit} || $param{sub} || die "expected 'subreddit'\n";
1505 0   0     0 my $title = $param{title} || die "Expected 'title'\n";
1506 0   0     0 my $source_id = $param{source_id} || die "Expected 'source_id'\n";
1507 0 0       0 $source_id = "t3_$source_id" if lc substr($source_id, 0, 3) ne 't3_';
1508             #my $url = $param{url} || croak 'Expected "url"';
1509 0 0       0 my $replies = exists $param{inbox_replies} ? ($param{inbox_replies} ? "true" : "false") : "true";
    0          
1510 0 0       0 my $repost = exists $param{repost} ? ($param{repost} ? "true" : "false") : "false";
    0          
1511              
1512 0         0 $subreddit = subreddit($subreddit);
1513              
1514 0         0 my $result = $self->api_json_request(api => API_SUBMIT, data => {
1515             title => $title,
1516             #url => $url,
1517             crosspost_fullname => $source_id,
1518             sr => $subreddit,
1519             kind => SUBMIT_CROSSPOST,
1520             sendreplies => $replies,
1521             resubmit => $repost,
1522             });
1523              
1524 0         0 return $result->{data}{name};
1525             }
1526              
1527             sub submit_text {
1528 0     0 1 0 my ($self, %param) = @_;
1529 0   0     0 my $subreddit = $param{subreddit} || $param{sub} || die "expected 'subreddit'\n";
1530 0   0     0 my $title = $param{title} || croak 'Expected "title"';
1531 0   0     0 my $text = $param{text} || "";#croak 'Expected "text"';
1532             # true and false have to be the strings "true" or "false"
1533 0 0       0 my $replies = exists $param{inbox_replies} ? ($param{inbox_replies} ? "true" : "false") : "true";
    0          
1534              
1535 0         0 DEBUG('Submit text to %s: %s', $subreddit, $title);
1536              
1537 0         0 $subreddit = subreddit($subreddit);
1538              
1539 0         0 my $result = $self->api_json_request(api => API_SUBMIT, data => {
1540             title => $title,
1541             text => $text,
1542             sr => $subreddit,
1543             kind => SUBMIT_SELF,
1544             sendreplies=>$replies,
1545             });
1546              
1547 0         0 return $result->{data}{name};
1548             }
1549             # These could go in the user section or here, but it seems like it will be
1550             # more commonly used for flairing posts
1551             sub template {
1552 0     0 0 0 my ($self, %param) = @_;
1553 0         0 my $data = {}; # POST data
1554 0         0 my $url_arg; # arguments that get interpolated into the URL
1555            
1556 0         0 my $result = $self->api_json_request(
1557             api => API_FLAIR,
1558             args => [$url_arg],
1559             data => $data
1560             );
1561             }
1562              
1563             # flair a post, not using an existing template, just manually providing the
1564             # text and CSS class
1565             sub flair_post {
1566 0     0 1 0 my ($self, %param) = @_;
1567 0   0     0 my $link_fullname = $param{link_id} || $param{post_id} || die "flair_post: need 'link_id'\n";
1568 0         0 $link_fullname = fullname($link_fullname, 't3');
1569 0   0     0 my $subreddit = $param{sub} || $param{subreddit} || die "flair_post: need 'subreddit'\n";
1570             # Initializing $text to '' here was accidentally preventing a concatenation
1571             # warning from Request
1572 0 0       0 my $text = $param{text} ? substr($param{text}, 0, 64) : '';
1573 0         0 my $css_class = $param{css_class}; # optional
1574              
1575 0         0 my $data = { link => $link_fullname };
1576 0 0       0 $data->{text} = $text if $text;
1577 0 0       0 $data->{css_class} = $css_class if $css_class;
1578              
1579 0         0 my $result = $self->api_json_request(
1580             api => API_FLAIR,
1581             args => [$subreddit],
1582             data => $data
1583             );
1584             }
1585             sub flair_link {
1586 0     0 1 0 my ($self, %param) = @_;
1587 0         0 return $self->flair_post(%param);
1588             }
1589              
1590             # flair a user, not using an existing template, just manually providing the
1591             # text and CSS class
1592             sub flair_user {
1593 0     0 1 0 my ($self, %param) = @_;
1594 0   0     0 my $username = $param{username} || die "flair_user: need 'link_id'\n";
1595 0 0       0 my $text = $param{text} ? substr($param{text}, 0, 64) : '';
1596 0         0 my $css_class = $param{css_class}; #optional
1597 0   0     0 my $subreddit = $param{sub} || $param{subreddit} || die "flair_user: need 'subreddit'\n";
1598              
1599 0         0 my $data = { name => $username };
1600 0 0       0 $data->{text} = $text if $text;
1601 0 0       0 $data->{css_class} = $css_class if $css_class;
1602              
1603 0         0 my $result = $self->api_json_request(
1604             api => API_FLAIR,
1605             args => [$subreddit],
1606             data => $data
1607             );
1608              
1609             }
1610              
1611             sub set_post_flair { # select_flair alias
1612             #sub select_flair {
1613 0     0 1 0 my ($self, %param) = @_;
1614             #return $self->set_post_flair(%param);
1615 0         0 return $self->select_flair(%param);
1616             }
1617             # select_flair can apply flair which appears styled in multi views (such as
1618             # r/all, your homepage, and both kinds of multis).
1619             # Flair applied through other methods has no style in multi views.
1620             # view sub newred | sub oldred | multi view
1621             # Apply manually new reddit x x
1622             # API x x
1623             # Automod applies x x! x
1624             #
1625             # -New reddit and multis always ignore CSS class
1626             # -Old reddit will have the new style IF it is applied by Automod and IF it has
1627             # no css_class. Otherwise it uses old styles like usual.
1628             # -If a css_class is added by any means, old reddit will lose new styles.
1629             # -If you alter the flair in any way through either the old or new interface,
1630             # old reddit will lose the new style.
1631             # -If text is altered with flair_link, old reddit will lose new styles.
1632             # - Multi view (same as r/all view) seems to show whatever new reddit does.
1633             # - text_color and background_color seem to have no effect on anything.
1634             #
1635             # Flair will use values from the flair selection as defaults. Some can only be
1636             # set through the new interface or the API.
1637             #
1638             # It looks like flair templates with a background_color attempt to hard code the
1639             # background color - that is, they use style="" tags. There is no way to do this
1640             # with old reddit, only API and new. The override_css option in /r/api/flairtemplate2 may be related.
1641             #sub set_post_flair { # select_flair alias
1642             sub select_flair {
1643 0     0 1 0 my ($self, %param) = @_;
1644 0         0 my $errmsg = "select_flair: 'subreddit' and 'flair_template_id' (or alias 'flair_id') are required.\n";
1645 0   0     0 my $sub = $param{sub} || $param{subreddit} || die $errmsg;
1646 0   0     0 my $flairid = $param{flair_template_id} || $param{flair_id} || die $errmsg;
1647 0   0     0 my $post_id = $param{link_id} || $param{post_id};
1648              
1649             # This doesn't use LINK_FLAIR or USER_FLAIR, it watches for link id or usern
1650 0 0 0     0 if (!$post_id and !$param{username}) {
    0          
1651 0         0 die "select_flair: either 'link_id' or 'username' is required.\n";
1652             } elsif ($post_id) {
1653 0         0 $post_id = fullname($post_id, 't3');
1654             }
1655              
1656 0         0 my $textcol = $param{text_color};
1657             # putting an actual color here will be a common mistake
1658 0 0       0 if ($textcol) {
1659 0         0 $textcol = lc $textcol;
1660 0 0 0     0 if ($textcol ne 'light' and $textcol ne 'dark') {
1661 0         0 die "select_flair: if provided, text_color must be 'light' or 'dark'.\n";
1662             }
1663             }
1664              
1665 0         0 my $data = {};
1666              
1667 0 0       0 $data->{background_color} = $param{background_color} if $param{background_color};
1668 0 0       0 $data->{css_class} = $param{css_class} if $param{css_class};
1669 0         0 $data->{flair_template_id} = $flairid;
1670 0 0       0 $data->{link} = $post_id if $post_id;
1671 0 0       0 $data->{name} = $param{username} if $param{username};
1672 0 0       0 $data->{return_rtjson} = $param{return_rtjson} if $param{return_rtjson};
1673 0 0       0 $data->{text_color} = $textcol if $textcol;
1674             # if given empty string Reddit ignores the parameter-- i.e. you can't do
1675             # tricks like invisibly flair something, like you could with v1
1676             # Also passing undef here gives a concatenation error in Request
1677 0   0     0 $data->{text} = $param{text} || '';
1678              
1679 0         0 my $result = $self->api_json_request(
1680             api => API_SELECTFLAIR,
1681             args => [$sub],
1682             data => $data
1683             );
1684              
1685 0         0 return $result;
1686             }
1687             sub select_user_flair {
1688 0     0 0 0 my ($self, %param) = @_;
1689 0         0 return $self->set_user_flair(%param);
1690             }
1691             sub set_user_flair {
1692 0     0 0 0 my $errmsg = "select_user_flair: keys 'subreddit', 'username', and 'flair_template_id' (or alias 'flair_id') are required.\n";
1693 0         0 my ($self, %param) = @_;
1694 0   0     0 my $sub = $param{subreddit} || die $errmsg;
1695 0   0     0 my $user = $param{username} || die $errmsg;
1696 0   0     0 my $flairid = $param{flair_template_id} || $param{flair_id} || die $errmsg;
1697 0         0 my $data = {};
1698              
1699 0         0 $data->{name} = $user;
1700 0         0 $data->{flair_template_id} = $flairid;
1701              
1702 0         0 my $result = $self->api_json_request(
1703             api => API_SELECTFLAIR,
1704             args => [$sub],
1705             data => $data
1706             );
1707              
1708 0         0 return $result;
1709             }
1710              
1711             # Return a hash reference with keys 'choices' and 'current'
1712             # 'choices' is array of hashes with flair options
1713             # 'current' is the post's current flair
1714             sub get_flair_options {
1715 0     0 1 0 my ($self, %param) = @_;
1716 0   0     0 my $sub = $param{sub} || $param{subreddit} || die "get_flair_options: 'subreddit' (or alias 'sub') is required.\n";
1717 0   0     0 my $post_id = $param{link_id} || $param{post_id};
1718 0         0 my $user = $param{username};
1719 0         0 my $data = {};
1720              
1721 0 0       0 if ($post_id) {
    0          
1722 0         0 $post_id = fullname($post_id, 't3');
1723 0         0 $data->{link} = $post_id;
1724             } elsif ($user) {
1725 0         0 $data->{user} = $user;
1726             } else {
1727 0         0 die "get_flair_options: Need 'post_id' or 'username'";
1728             }
1729              
1730 0         0 my $result = $self->api_json_request(
1731             api => API_FLAIROPTS,
1732             args => [$sub],
1733             data => $data,
1734             );
1735              
1736             # What's this? Fixing the booleans?
1737 0 0       0 if ($result->{choices}) {
1738 0         0 for (my $i=0; $result->{choices}[$i]; $i++) {
1739 0 0       0 $result->{choices}[$i]->{flair_text_editable} = $result->{choices}[$i]->{flair_text_editable} ? 1 : 0;
1740              
1741             }
1742             }
1743              
1744 0         0 return $result;
1745             }
1746             sub get_link_flair_options { # v2: default now
1747 0     0 1 0 my $self = shift;
1748 0   0     0 my $sub = shift || die "get_link_flair_options: Need arg 1 (subreddit)\n";
1749              
1750 0         0 my $result = $self->api_json_request(
1751             api => API_LINKFLAIRV2,
1752             args => [$sub],
1753             );
1754 0         0 return $result;
1755             }
1756             sub get_link_flair_options_v1 { # v1
1757 0     0 0 0 my $self = shift;
1758 0   0     0 my $sub = shift || die "get_link_flair_options: Need arg 1 (subreddit)\n";
1759              
1760 0         0 my $result = $self->api_json_request(
1761             api => API_LINKFLAIRV1,
1762             args => [$sub],
1763             );
1764 0         0 return $result;
1765             }
1766             sub get_user_flair_options { # v2: default now
1767 0     0 1 0 my $self = shift;
1768 0   0     0 my $sub = shift || die "get_link_flair_options: Need arg 1 (subreddit)\n";
1769              
1770 0         0 my $result = $self->api_json_request(
1771             api => API_USERFLAIRV2,
1772             args => [$sub],
1773             );
1774 0         0 return $result;
1775             }
1776             sub get_user_flair_options_v1 { # v1
1777 0     0 0 0 my $self = shift;
1778 0   0     0 my $sub = shift || die "get_link_flair_options: Need arg 1 (subreddit)\n";
1779              
1780 0         0 my $result = $self->api_json_request(
1781             api => API_USERFLAIRV1,
1782             args => [$sub],
1783             );
1784 0         0 return $result;
1785             }
1786             # uses flairtemplate_v2 endpoint, which is for new but works for old
1787             sub flairtemplate {
1788 0     0 1 0 my ($self, %param) = @_;
1789 0   0     0 my $sub = $param{sub} || $param{subreddit} || die "flairtemplate: 'subreddit' (or alias 'sub') is required.\n";
1790 0 0       0 my $bg = $param{background_color} if $param{background_color};
1791 0   0     0 my $flairid = $param{flair_template_id} || $param{flair_id} || $param{id} || undef;
1792             #my $type = $param{flair_type} || die $err;
1793 0 0       0 my $modonly = exists $param{mod_only} ? ($param{mod_only} ? 'true' : 'false') : 'false';
    0          
1794 0 0       0 my $editable= exists $param{text_editable} ? ($param{text_editable} ? 'true' : 'false') : 'false';
    0          
1795 0         0 my $textcol = $param{text_color};
1796             # putting an actual color here will be a common mistake
1797 0 0       0 if ($textcol) {
1798 0         0 $textcol = lc $textcol;
1799 0 0 0     0 if ($textcol ne 'light' and $textcol ne 'dark') {
1800 0         0 die "flairtemplate: if provided, text_color must be one of (light, dark).\n";
1801             }
1802             }
1803             # override_css is undocumented and not returned by get_link_flair_options
1804             # $override is unused here as yet
1805             #my $override= exists $param{override_css} ? ($param{override_css} ? 'true' : 'false') : 'false';
1806              
1807 0 0 0     0 if ($bg and substr($bg, 0, 1) ne '#') { $bg = "#$bg"; } #requires hash
  0         0  
1808              
1809 0         0 my $data = {};
1810 0 0       0 $data->{allowable_content} = $param{allowable_content} if $param{allowable_content};
1811 0 0       0 $data->{background_color} = $bg if $bg;
1812 0 0       0 $data->{css_class} = $param{css_class} if $param{css_class};
1813 0 0       0 $data->{max_emojis} = $param{max_emojis} if $param{max_emojis};
1814             # No documentation; presumably required for editing
1815 0 0       0 $data->{flair_template_id} = $flairid if $flairid;
1816             # api defaults to USER_FLAIR, we default to LINK_FLAIR
1817 0   0     0 $data->{flair_type} = $param{flair_type} || 'LINK_FLAIR';
1818 0 0       0 $data->{mod_only} = $modonly if exists $param{mod_only};
1819             # No documentation. Probably wants "true or "false".
1820 0 0       0 $data->{override_css} = $param{override_css} if $param{override_css};
1821 0 0       0 $data->{text} = $param{text} if $param{text};
1822 0 0       0 $data->{text_color} = $textcol if $textcol;
1823 0 0       0 $data->{text_editable} = $editable if exists $param{text_editable};
1824              
1825 0         0 my $result = $self->api_json_request(
1826             api => API_FLAIRTEMPLATE2,
1827             args => [$sub],
1828             data => $data,
1829             );
1830 0         0 return $result;
1831             }
1832              
1833             #==============================================================================
1834             # Subreddit management
1835             #==============================================================================
1836              
1837             sub get_wiki {
1838 0     0 1 0 my ($self, %param) = @_;
1839 0   0     0 my $page = $param{page} || croak "Need 'page'";
1840 0   0     0 my $sub = $param{sub} || $param{subreddit} || die "need subreddit\n";
1841              
1842 0         0 my $data = {};
1843 0 0       0 $data->{v} = $param{v} if $param{v};
1844 0 0       0 $data->{v2} = $param{v2} if $param{v2};
1845              
1846            
1847 0         0 my $result = $self->api_json_request(
1848             api => API_GETWIKI,
1849             args => [$sub, $page],
1850             data => $data,
1851             );
1852 0 0       0 return $param{data} ? $result->{data} : $result->{data}->{content_md};
1853             }
1854             sub get_wiki_data {
1855 0     0 1 0 my ($self, %param) = @_;
1856 0         0 $param{data} = 1;
1857 0         0 return $self->get_wiki(%param);
1858             }
1859              
1860             sub edit_wiki {
1861 0     0 1 0 my ($self, %param) = @_;
1862 0   0     0 my $page = $param{page} || croak "Need 'page'";
1863 0 0       0 my $content = defined $param{content} ? $param{content} : croak "Need 'content'";
1864             # Reddit maximum length is 524,288
1865 0 0       0 if (length $content > 524288) { croak "Maximum length for 'content' is 524288 bytes."; }
  0         0  
1866 0   0     0 my $sub = $param{sub} || $param{subreddit} || croak "Need 'sub' or 'subreddit'";
1867 0         0 my $previous = $param{previous};
1868 0         0 my $reason = $param{reason};
1869              
1870 0         0 my $data = {};
1871 0         0 $data->{page} = $page;
1872 0         0 $data->{content}= $content;
1873 0 0       0 if ($previous) { $data->{previous} = $previous; }
  0         0  
1874 0 0       0 if ($reason) { $data->{reason} = substr $reason, 0, 256; }
  0         0  
1875              
1876 0         0 my $result = $self->api_json_request(
1877             api => API_EDITWIKI,
1878             args => [$sub],
1879             data => $data,
1880             );
1881              
1882 0         0 return $result;
1883             }
1884              
1885             #===============================================================================
1886             # Comments
1887             #===============================================================================
1888             sub get_comments {
1889 0     0 1 0 my ($self, %param) = @_;
1890 0         0 my $permalink;
1891 0   0     0 my $sub = $param{sub} || $param{subreddit};
1892              
1893 0 0 0     0 if ($param{permalink}) {
    0 0        
    0 0        
    0          
1894 0         0 $permalink = $param{permalink};
1895             } elsif ($sub and $param{comment_id} and $param{link_id}) {
1896 0         0 my $id = id($param{link_id});
1897 0         0 my $cmtid = id($param{comment_id});
1898 0         0 $permalink = "/r/$sub/comments/$id//$cmtid";
1899             } elsif ($sub and $param{id}) {
1900 0         0 my $id = id($param{id});
1901 0         0 $permalink = "/r/$sub/comments/$id";
1902             } elsif ($param{url}) {
1903 0         0 $permalink = $param{url};
1904 0         0 $permalink =~ s/^https?:\/\/([a-zA-Z]{1,3}\.)?reddit\.com//i;
1905             } else {
1906 0         0 die "get_comments: Either 'permalink' OR 'url' OR 'subreddit' and 'link_id' OR 'subreddit' and 'link_id' and 'comment_id' are required.\n";
1907             }
1908              
1909 0         0 my $result = $self->json_request('GET', $permalink);
1910 0         0 my $link_id = $result->[0]{data}{children}[0]{data}{name};
1911             # result->[0] is a listing with 1 element, the link, even if you requested a cmt
1912 0         0 my $comments = $result->[1]{data}{children};
1913              
1914 0         0 my $return = [];
1915 0         0 for my $cmt (@$comments) {
1916 0 0       0 if ($cmt->{kind} eq 't1') {
    0          
1917 0         0 push @$return, Reddit::Client::Comment->new($self, $cmt->{data});
1918             } elsif ($cmt->{kind} eq 'more') {
1919 0         0 my $more = Reddit::Client::MoreComments->new($self, $cmt->{data});
1920 0         0 $more->{link_id} = $link_id;
1921 0         0 push @$return, $more;
1922             }
1923             }
1924 0         0 return $return;
1925             }
1926             # limit_children: get these comments and their descendants
1927             sub get_collapsed_comments {
1928 0     0 0 0 my ($self, %param) = @_;
1929 0   0     0 my $link_id = fullname($param{link_id},'t3') || die "load_more_comments: 'link_id' is required.\n";
1930 0   0     0 my $children = $param{children} || die "get_collapsed_comments: 'children' is required.\n";
1931 0 0       0 my $limit = exists $param{limit_children} ? ($param{limit_children} ? 'true' : 'false') : 'false';
    0          
1932 0         0 my $ids;
1933              
1934 0 0       0 if (ref $children eq 'ARRAY') {
1935 0         0 $ids = join ",", @$children;
1936 0 0       0 die "'children' must be non-empty array reference" unless $ids;
1937             } else {
1938 0         0 die "get_collapsed_comments: 'children' must be array reference\n";
1939             }
1940              
1941 0         0 my $data = {
1942             link_id => $link_id,
1943             children => $ids,
1944             limit_children => $limit,
1945             api_type => 'json', # This is the only GET endpoint that requires
1946             }; # api_type=json to be set.
1947              
1948 0 0       0 $data->{sort} = $param{sort} if $param{sort};
1949 0 0       0 $data->{id} = $param{id} if $param{id};
1950              
1951 0         0 my $result = $self->api_json_request(
1952             api => API_MORECHILDREN,
1953             data => $data,
1954             );
1955 0         0 my $comments = $result->{data}->{things};
1956              
1957 0         0 my $return = [];
1958 0         0 for my $cmt (@$comments) {
1959 0 0       0 if ($cmt->{kind} eq 't1') {
    0          
1960 0         0 push @$return, Reddit::Client::Comment->new($self, $cmt->{data});
1961             } elsif ($cmt->{kind} eq 'more') {
1962 0         0 my $more = Reddit::Client::MoreComments->new($self, $cmt->{data});
1963 0         0 $more->{link_id} = $link_id;
1964 0         0 push @$return, $more;
1965             }
1966             }
1967 0         0 return $return;
1968             }
1969              
1970             sub submit_comment {
1971 0     0 1 0 my ($self, %param) = @_;
1972 0   0     0 my $parent_id = $param{parent} || $param{parent_id} || croak 'Expected "parent"';
1973 0   0     0 my $comment = $param{text} || croak 'Expected "text"';
1974             # the replies option, it does nothing
1975             #my $replies = exists $param{inbox_replies} ? ($param{inbox_replies} ? "true" : "false") : "true";
1976              
1977 0 0 0     0 croak '$fullname must be a post or comment' if !ispost($parent_id) && !iscomment($parent_id);
1978 0         0 DEBUG('Submit comment under %s', $parent_id);
1979              
1980 0         0 my $result = $self->api_json_request(api => API_COMMENT, data => {
1981             thing_id => $parent_id,
1982             text => $comment,
1983             #sendreplies=>$replies,
1984             });
1985              
1986 0         0 return $result->{data}{things}[0]{data}{name};
1987             }
1988              
1989             sub comment {
1990 0     0 1 0 my($self, $parent, $text) = @_;
1991 0         0 return $self->submit_comment(parent_id=>$parent, text=>$text);
1992             }
1993              
1994             #===============================================================================
1995             # Private messages
1996             #===============================================================================
1997              
1998             sub send_message {
1999 0     0 1 0 my ($self, %param) = @_;
2000 0   0     0 my $to = $param{to} || croak 'Expected "to"';
2001 0   0     0 my $subject = $param{subject} || croak 'Expected "subject"';
2002 0   0     0 my $text = $param{text} || croak 'Expected "text"';
2003              
2004 0 0       0 croak '"subject" cannot be longer than 100 characters' if length $subject > 100;
2005            
2006             #$self->require_login;
2007 0         0 DEBUG('Submit message to %s: %s', $to, $subject);
2008              
2009 0         0 my $result = $self->api_json_request(api => API_MESSAGE, data => {
2010             to => $to,
2011             subject => $subject,
2012             text => $text,
2013             kind => SUBMIT_MESSAGE,
2014             });
2015              
2016 0         0 return $result;
2017             }
2018              
2019             #===============================================================================
2020             # Voting
2021             #===============================================================================
2022              
2023             sub vote {
2024 0     0 1 0 my ($self, $name, $direction) = @_;
2025 0 0       0 defined $name || croak 'Expected $name';
2026 0 0       0 defined $direction || croak 'Expected $direction';
2027 0 0 0     0 croak '$fullname must be a post or comment' if !ispost($name) && !iscomment($name);
2028 0 0       0 croak 'Invalid vote direction' unless "$direction" =~ /^(-1|0|1)$/;
2029 0         0 DEBUG('Vote %d for %s', $direction, $name);
2030 0         0 $self->api_json_request(api => API_VOTE, data => { dir => $direction, id => $name });
2031             }
2032              
2033             #===============================================================================
2034             # Saving and hiding
2035             #===============================================================================
2036              
2037             sub save {
2038 0     0 1 0 my $self = shift;
2039 0   0     0 my $name = shift || croak 'Expected $fullname';
2040 0 0 0     0 croak '$fullname must be a post or comment' if !ispost($name) && !iscomment($name);
2041 0         0 DEBUG('Save %s', $name);
2042 0         0 $self->api_json_request(api => API_SAVE, data => { id => $name });
2043             }
2044              
2045             sub unsave {
2046 0     0 1 0 my $self = shift;
2047 0   0     0 my $name = shift || croak 'Expected $fullname';
2048 0 0 0     0 croak '$fullname must be a post or comment' if !ispost($name) && !iscomment($name);
2049 0         0 DEBUG('Unsave %s', $name);
2050 0         0 $self->api_json_request(api => API_UNSAVE, data => { id => $name });
2051             }
2052              
2053             sub hide {
2054 0     0 1 0 my $self = shift;
2055 0   0     0 my $name = shift || croak 'Expected $fullname';
2056 0 0       0 croak '$fullname must be a post' if !ispost($name);
2057 0         0 DEBUG('Hide %s', $name);
2058 0         0 $self->api_json_request(api => API_HIDE, data => { id => $name });
2059             }
2060              
2061             sub unhide {
2062 0     0 1 0 my $self = shift;
2063 0   0     0 my $name = shift || croak 'Expected $fullname';
2064 0 0       0 croak '$fullname must be a post' if !ispost($name);
2065 0         0 DEBUG('Unhide %s', $name);
2066 0         0 $self->api_json_request(api => API_UNHIDE, data => { id => $name });
2067             }
2068              
2069             #==============================================================================
2070             # Multireddits
2071             #==============================================================================
2072              
2073             sub edit_multi {
2074 0     0 1 0 my ($self, %param) = @_;
2075 0         0 $param{edit} = 1;
2076 0         0 $self->create_multi(%param);
2077             }
2078             sub create_multi {
2079 0     0 1 0 my ($self, %param) = @_;
2080 0         0 my $data = {};
2081 0         0 my $model = {};
2082 0   0     0 my $username = $param{username} || $self->{username} || die "'username' is required.";
2083              
2084 0   0     0 $model->{display_name} = $param{name} || croak "Expected 'name'.";
2085 0 0       0 if (length($model->{display_name}) > 50) { croak "max length of 'name' is 50."; }
  0         0  
2086              
2087 0 0       0 $model->{description_md} = $param{description} if $param{description};
2088              
2089 0 0       0 if ($param{icon_name}) {
2090 0         0 $model->{icon_name} = $param{icon_name};
2091 0         0 my @iconnames = ('art and design', 'ask', 'books', 'business', 'cars', 'comics', 'cute animals', 'diy', 'entertainment', 'food and drink', 'funny', 'games', 'grooming', 'health', 'life advice', 'military', 'models pinup', 'music', 'news', 'philosophy', 'pictures and gifs', 'science', 'shopping', 'sports', 'style', 'tech', 'travel', 'unusual stories', 'video', '', 'None');
2092 0         0 my $match = 0;
2093 0         0 foreach my $i (@iconnames) {
2094 0 0       0 $match = 1 if $i eq $model->{icon_name};
2095             }
2096 0         0 my $iconstr = join ", ", @iconnames;
2097 0 0       0 if (!$match) {croak "if 'icon_name' is provided, it must be one of the following values: $iconstr. Note that the purpose of icon_str is unclear and you should not use it unless you know what you're doing."; }
  0         0  
2098             }
2099              
2100 0 0       0 if ($param{key_color}) {
2101 0         0 $model->{key_color} = "#".$param{key_color};
2102 0 0       0 if (length($model->{key_color}) != 7) { croak "'key_color' must be a 6-character color code"; }
  0         0  
2103             }
2104              
2105 0 0       0 if ($param{visibility}) {
2106 0         0 $model->{visibility} = $param{visibility};
2107 0 0 0     0 if ($model->{visibility} ne 'private' and
      0        
2108             $model->{visibility} ne 'public' and
2109             $model->{visibility} ne 'hidden') {
2110 0         0 croak "if provided, 'visibility' must be either 'public', 'private', or 'hidden'.";
2111             }
2112             }
2113              
2114 0 0       0 if ($param{weighting_scheme}) {
2115 0         0 $model->{weighting_scheme} = $param{weighting_scheme};
2116 0 0 0     0 if ($model->{weighting_scheme} ne 'classic' and $model->{weighting_scheme} ne 'fresh') { croak "if 'weighting_scheme' is provided, it must be either 'classic' or 'fresh'"; }
  0         0  
2117             }
2118            
2119 0 0 0     0 if ($param{subreddits} or $param{subs}) {
2120 0   0     0 $param{subreddits} = $param{subs} || $param{subreddits};
2121 0 0       0 if (ref $param{subreddits} ne 'ARRAY') { croak "'subreddits' must be an array reference."; }
  0         0  
2122              
2123 0         0 $model->{subreddits} = [ map { { name=> $_ } } @{$param{subreddits}} ];
  0         0  
  0         0  
2124             #print Dumper($model->{subreddits});
2125             }
2126              
2127             # Put a ribbon on it
2128 0         0 $data->{model} = JSON::encode_json($model);
2129 0         0 $data->{multipath} = "/user/$username/m/$model->{display_name}";
2130              
2131             my $result = $self->api_json_request(
2132             api => $param{edit} ? API_EDITMULTI : API_CREATEMULTI,
2133 0 0       0 args => [$username, $model->{display_name}],
2134             data => $data,
2135             );
2136              
2137 0         0 return $result->{data};
2138             }
2139              
2140             sub get_multi {
2141 0     0 1 0 my ($self, %param) = @_;
2142 0   0     0 my $name = $param{name} || croak "expected 'name'";
2143 0   0     0 my $username= $param{user} || $param{username} || $self->{username} || die "'username' is required.\n";
2144 0 0       0 my $expand = $param{expand} ? '?expand_srs=true' : '';
2145              
2146 0         0 my $result = $self->api_json_request(
2147             api => API_GETMULTI,
2148             args => [$username, $name, $expand],
2149             );
2150              
2151             # The result looks like a Subreddit object, but is not.
2152             # By returning just the data we lose only the 'kind' key,
2153             # which is just the string "LabeledMulti"
2154 0         0 return $result->{data};
2155             }
2156              
2157             sub delete_multi {
2158 0     0 1 0 my $self = shift;
2159 0   0     0 my $name = shift || croak "expected arg 1 (name)";
2160              
2161             my $result = $self->api_json_request(
2162             api => API_DELETEMULTI,
2163 0         0 args => [$self->{username}, $name],
2164             );
2165 0         0 return $result->{data};
2166             }
2167             #==============================================================================
2168             # Misc
2169             #==============================================================================
2170             sub get_origin {
2171 0     0 0 0 my $self = shift;
2172 0         0 return "https://$self->{subdomain}.reddit.com";
2173             }
2174              
2175             #==============================================================================
2176             # Internal and static
2177             #==============================================================================
2178              
2179             # Strip the type portion of a filname (i.e. t3_), if it exists
2180             sub id {
2181 0     0 1 0 my $id = shift;
2182 0         0 $id =~ s/^t\d_//;
2183 0         0 return $id;
2184             }
2185             # accept id or fullname, always return fullname
2186             sub fullname {
2187 0   0 0 1 0 my $id = shift || return;
2188 0   0     0 my $type = shift || die "fullname: 'type' is required";
2189 0 0       0 $id = $type."_".$id if substr($id, 0, 3) ne $type."_";
2190 0         0 return $id;
2191             }
2192             sub bool {
2193 0 0   0 0 0 return $_[0] ? "true" : "false";
2194             }
2195             sub ispost {
2196 0     0 0 0 my $name = shift;
2197 0         0 my $type = substr $name, 0, 2;
2198 0         0 return $type eq 't3';
2199             }
2200             sub iscomment {
2201 0     0 0 0 my $name = shift;
2202 0         0 my $type = substr($name, 0, 2);
2203 0         0 return $type eq 't1';
2204             }
2205             sub get_type {
2206 0     0 0 0 my $name = shift;
2207 0 0       0 return lc substr($name, 0, 2) if $name;
2208             }
2209             sub DEBUG {
2210 2 50   2 0 10 if ($DEBUG) {
2211 0           my ($format, @args) = @_;
2212 0           my $ts = strftime "%Y-%m-%d %H:%M:%S", localtime;
2213 0           my $msg = sprintf $format, @args;
2214 0           chomp $msg;
2215 0           printf STDERR "[%s] [ %s ]\n", $ts, $msg;
2216             }
2217             }
2218              
2219             sub subreddit {
2220 0     0 0   my $subject = shift;
2221 0           $subject =~ s/^\/r//; # trim leading /r
2222 0           $subject =~ s/^\///; # trim leading slashes
2223 0           $subject =~ s/\/$//; # trim trailing slashes
2224              
2225 0 0         if ($subject !~ /\//) { # no slashes in name - it's probably good
2226 0 0         if ($subject eq '') { # front page
2227 0           return '';
2228             } else { # subreddit
2229 0           return $subject;
2230             }
2231             } else { # fail
2232 0           return;
2233             }
2234             }
2235              
2236             # Remember that this returns a new hash and any key not from here will be
2237             # wiped out
2238             sub set_listing_defaults {
2239 0     0 0   my ($self, %param) = @_;
2240 0           my $query = {};
2241 0 0         $query->{before} = $param{before} if $param{before};
2242 0 0         $query->{after} = $param{after} if $param{after};
2243 0 0         $query->{only} = $param{only} if $param{only};
2244 0 0         $query->{count} = $param{count} if $param{count};
2245 0 0 0       $query->{show} = 'all' if $param{show} or $param{show_all};
2246 0 0         $query->{sort} = $param{sort} if $param{sort};
2247 0 0         $query->{sr_detail} = 'true' if $param{sr_detail};
2248             # 500?
2249 0 0 0       if (exists $param{limit}) { $query->{limit} = $param{limit} || 100; }
  0            
2250 0           else { $query->{limit} = DEFAULT_LIMIT; }
2251            
2252 0           return $query;
2253             }
2254              
2255             1;
2256              
2257             __END__