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__ |