1package Reddit::Client; 2 3our $VERSION = '1.374'; # 1.374 added nsfw option to submit_link 4 5# 1.373 2/3/20 edit now returns the edited thing's id 6# 1.372 7# -get_link now gets its links in a proper way, by calling get_links_by_ids and 8# taking the first element 9# -Link class now has many more keys; should now reflect most or all of the keys 10# Reddit returns, minus 'downs' and 'ups' because they are deprecated and can 11# cause confusion 12 13# 1.371 01/10/20 14# -added flairtemplate, creates or edits a flair template 15# -added get_link_flair_options. Gets link flair for a sub. uses v2 endpoint. 16# -added get_link_flair_options_v1, which uses the v1 endpoint and is instantly deprecated 17# -select_post_flair is renamed select_flair, now accepts v2 arguments, and can 18# accept a username instead to flair a user. See the documentation for description 19 20 21$VERSION = eval $VERSION; 22 23use strict; 24use Carp; 25 26use Data::Dumper qw/Dumper/; 27use JSON qw/decode_json/; 28use File::Spec qw//; 29use Digest::MD5 qw/md5_hex/; 30use POSIX qw/strftime/; 31#use File::Path::Expand qw//; # Does nothing? 32 33require Reddit::Client::Account; 34require Reddit::Client::Comment; 35require Reddit::Client::Link; 36require Reddit::Client::SubReddit; 37require Reddit::Client::Request; 38require Reddit::Client::Message; 39require Reddit::Client::MoreComments; 40 41#=============================================================================== 42# Constants 43#=============================================================================== 44 45use constant DEFAULT_LIMIT => 25; 46 47use constant VIEW_HOT => ''; 48use constant VIEW_NEW => 'new'; 49use constant VIEW_CONTROVERSIAL => 'controversial'; 50use constant VIEW_TOP => 'top'; 51use constant VIEW_RISING => 'rising'; 52use constant VIEW_DEFAULT => VIEW_HOT; 53 54use constant VOTE_UP => 1; 55use constant VOTE_DOWN => -1; 56use constant VOTE_NONE => 0; 57 58use constant SUBMIT_LINK => 'link'; 59use constant SUBMIT_SELF => 'self'; 60use constant SUBMIT_MESSAGE => 'message'; 61use constant SUBMIT_CROSSPOST => 'crosspost'; 62 63use constant MESSAGES_INBOX => 'inbox'; 64use constant MESSAGES_UNREAD => 'unread'; 65use constant MESSAGES_SENT => 'sent'; 66use constant MESSAGES_MESSAGES => 'messages'; 67use constant MESSAGES_COMMENTREPLIES => 'comments'; 68use constant MESSAGES_POSTREPLIES => 'selfreply'; 69use constant MESSAGES_MENTIONS => 'mentions'; 70 71use constant SUBREDDITS_HOME => ''; 72use constant SUBREDDITS_MINE => 'subscriber'; 73use constant SUBREDDITS_POPULAR => 'popular'; 74use constant SUBREDDITS_NEW => 'new'; 75use constant SUBREDDITS_CONTRIB => 'contributor'; 76use constant SUBREDDITS_MOD => 'moderator'; 77 78use constant USER_OVERVIEW => 'overview'; 79use constant USER_COMMENTS => 'comments'; 80use constant USER_SUBMITTED => 'submitted'; 81use constant USER_GILDED => 'gilded'; 82use constant USER_UPVOTED => 'upvoted'; 83use constant USER_DOWNVOTED => 'downvoted'; 84use constant USER_HIDDEN => 'hidden'; 85use constant USER_SAVED => 'saved'; 86use constant USER_ABOUT => 'about'; 87 88use constant API_ME => 0; 89use constant API_INFO => 1; 90use constant API_SUB_SEARCH => 2; 91use constant API_LOGIN => 3; 92use constant API_SUBMIT => 4; 93use constant API_COMMENT => 5; 94use constant API_VOTE => 6; 95use constant API_SAVE => 7; 96use constant API_UNSAVE => 8; 97use constant API_HIDE => 9; 98use constant API_UNHIDE => 10; 99use constant API_SUBREDDITS => 11; 100use constant API_LINKS_FRONT => 12; 101use constant API_LINKS_OTHER => 13; 102use constant API_DEL => 14; 103use constant API_MESSAGE => 15; 104use constant API_COMMENTS_FRONT => 16; 105use constant API_COMMENTS => 17; 106use constant API_MESSAGES => 18; 107use constant API_MARK_READ => 19; 108use constant API_MARKALL => 20; 109use constant API_MY_SUBREDDITS => 21; 110use constant API_USER => 22; 111use constant API_SELECTFLAIR => 23; 112use constant API_FLAIROPTS => 24; 113use constant API_EDITWIKI => 25; 114use constant API_CREATEMULTI => 26; 115use constant API_DELETEMULTI => 27; 116use constant API_GETMULTI => 28; 117use constant API_EDITMULTI => 29; 118use constant API_SUBREDDIT_INFO => 30; 119use constant API_SEARCH => 31; 120use constant API_MODQ => 32; 121use constant API_EDIT => 33; 122use constant API_REMOVE => 34; 123use constant API_APPROVE => 35; 124use constant API_IGNORE_REPORTS => 36; 125use constant API_GETWIKI => 37; 126use constant API_GET_MODMAIL => 38; 127use constant API_BAN => 39; 128use constant API_MORECHILDREN => 40; 129use constant API_BY_ID => 41; 130use constant API_FLAIR => 42; 131use constant API_DELETEFLAIR => 43; 132use constant API_UNBAN => 44; 133use constant API_DISTINGUISH => 45; 134use constant API_UNDISTINGUISH => 46; 135use constant API_LOCK => 47; 136use constant API_UNLOCK => 48; 137use constant API_MARKNSFW => 49; 138use constant API_UNMARKNSFW => 50; 139use constant API_FLAIRTEMPLATE2 => 51; 140use constant API_LINKFLAIRV1 => 52; 141use constant API_LINKFLAIRV2 => 53; 142use constant API_USERFLAIRV1 => 54; 143use constant API_USERFLAIRV2 => 55; 144 145#=============================================================================== 146# Parameters 147#=============================================================================== 148 149our $DEBUG = 0; 150our $BASE_URL = 'https://oauth.reddit.com'; 151use constant BASE_URL =>'https://oauth.reddit.com'; 152our $LINK_URL = 'https://www.reddit.com'; # Why are there two of these? 153use constant LINK_URL =>'https://www.reddit.com'; # both are unused now? 154our $UA = sprintf 'Reddit::Client/%f', $VERSION; 155 156our @API; 157$API[API_ME ] = ['GET', '/api/v1/me' ]; 158$API[API_INFO ] = ['GET', '/api/info' ]; 159$API[API_SUB_SEARCH ] = ['GET', '/subreddits/search' ]; 160$API[API_LOGIN ] = ['POST', '/api/login/%s' ]; 161$API[API_SUBMIT ] = ['POST', '/api/submit' ]; 162$API[API_COMMENT ] = ['POST', '/api/comment' ]; 163$API[API_VOTE ] = ['POST', '/api/vote' ]; 164$API[API_SAVE ] = ['POST', '/api/save' ]; 165$API[API_UNSAVE ] = ['POST', '/api/unsave' ]; 166$API[API_HIDE ] = ['POST', '/api/hide' ]; 167$API[API_UNHIDE ] = ['POST', '/api/unhide' ]; 168$API[API_SUBREDDITS ] = ['GET', '/subreddits/%s' ]; 169$API[API_MY_SUBREDDITS ] = ['GET', '/subreddits/mine/%s' ]; 170$API[API_LINKS_OTHER ] = ['GET', '/%s' ]; 171$API[API_LINKS_FRONT ] = ['GET', '/r/%s/%s' ]; 172$API[API_DEL ] = ['POST', '/api/del' ]; 173$API[API_MESSAGE ] = ['POST', '/api/compose' ]; 174$API[API_COMMENTS ] = ['GET', '/r/%s/comments' ]; 175$API[API_COMMENTS_FRONT] = ['GET', '/comments' ]; 176$API[API_MESSAGES ] = ['GET', '/message/%s' ]; 177$API[API_MARK_READ ] = ['POST', '/api/read_message' ]; 178$API[API_MARKALL ] = ['POST', '/api/read_all_messages' ]; 179$API[API_USER ] = ['GET', '/user/%s/%s' ]; 180$API[API_SELECTFLAIR ] = ['POST', '/r/%s/api/selectflair' ]; 181$API[API_FLAIROPTS ] = ['POST', '/r/%s/api/flairselector' ]; 182$API[API_EDITWIKI ] = ['POST', '/r/%s/api/wiki/edit' ]; 183$API[API_GETWIKI ] = ['GET', '/r/%s/wiki/%s' ]; 184$API[API_CREATEMULTI ] = ['POST', '/api/multi/user/%s/m/%s' ]; 185$API[API_GETMULTI ] = ['GET', '/api/multi/user/%s/m/%s%s']; 186$API[API_DELETEMULTI ] = ['DELETE','/api/multi/user/%s/m/%s']; 187$API[API_EDITMULTI ] = ['PUT', '/api/multi/user/%s/m/%s' ]; 188$API[API_SUBREDDIT_INFO] = ['GET', '/r/%s/about' ]; 189$API[API_SEARCH ] = ['GET', '/r/%s/search' ]; 190$API[API_MODQ ] = ['GET', '/r/%s/about/%s' ]; 191$API[API_EDIT ] = ['POST', '/api/editusertext' ]; 192$API[API_REMOVE ] = ['POST', '/api/remove' ]; 193$API[API_APPROVE ] = ['POST', '/api/approve' ]; 194$API[API_IGNORE_REPORTS] = ['POST', '/api/ignore_reports' ]; 195$API[API_GET_MODMAIL ] = ['GET', '/api/mod/conversations' ]; 196$API[API_BAN ] = ['POST', '/r/%s/api/friend' ]; 197$API[API_MORECHILDREN ] = ['GET', '/api/morechildren' ]; 198$API[API_BY_ID ] = ['GET', '/by_id' ]; 199$API[API_FLAIR ] = ['POST', '/r/%s/api/flair' ]; 200$API[API_DELETEFLAIR ] = ['POST', '/r/%s/api/deleteflair' ]; 201$API[API_UNBAN ] = ['POST', '/r/%s/api/unfriend' ]; 202$API[API_DISTINGUISH ] = ['POST', '/api/distinguish' ]; 203$API[API_UNDISTINGUISH ] = ['POST', '/api/distinguish' ]; 204$API[API_LOCK ] = ['POST', '/api/lock' ]; # fullname only 205$API[API_UNLOCK ] = ['POST', '/api/unlock' ]; # these 206$API[API_MARKNSFW ] = ['POST', '/api/marknsfw' ]; # 207$API[API_UNMARKNSFW ] = ['POST', '/api/unmarknsfw' ]; # four 208$API[API_FLAIRTEMPLATE2] = ['POST', '/r/%s/api/flairtemplate_v2']; 209$API[API_LINKFLAIRV1 ] = ['GET', '/r/%s/api/link_flair' ]; 210$API[API_LINKFLAIRV2 ] = ['GET', '/r/%s/api/link_flair_v2' ]; 211$API[API_USERFLAIRV1 ] = ['GET', '/r/%s/api/user_flair' ]; 212$API[API_USERFLAIRV2 ] = ['GET', '/r/%s/api/user_flair_v2' ]; 213 214#=============================================================================== 215# Class methods 216#=============================================================================== 217 218use fields ( 219 'modhash', # No longer used. stored session modhash 220 'cookie', # No longer used. stored user cookie 221 'session_file', # No longer used. path to session file 222 'user_agent', # user agent string 223 'token', # oauth authorization token 224 'tokentype', # unused but saved for reference 225 'last_token', # time last token was acquired 226 'client_id', # always required 227 'secret', # always required 228 'username', # now optional for web apps 229 'password', # script apps only 230 'request_errors', # print request errors, deprecated 231 'print_request_errors', # print request errors 232 'print_response', # print response content, deprecated 233 'print_response_content',# print response content 234 'print_request', # print entire request 235 'print_request_on_error',# print entire request on error 236 'refresh_token', # oauth refresh token 237 'auth_type', # 'script' or 'webapp' 238 'debug', 239 'subdomain', 240); 241 242sub new { 243 my ($class, %param) = @_; 244 my $self = fields::new($class); 245 246 if (not exists $param{user_agent}) { 247 croak "param 'user_agent' is required."; 248 } 249 $self->{user_agent} = $param{user_agent}; 250 # request_errors does nothing? 251 $self->{request_errors} = $param{print_request_errors} || $param{request_errors} || 0; 252 $self->{print_response} = $param{print_response} || $param{print_response_conent} || 0; 253 $self->{print_request} = $param{print_request} || 0; 254 $self->{debug} = $param{debug} || 0; 255 $self->{print_request_on_error} = $param{print_request_on_error} || 0; 256 $self->{subdomain} = $param{subdomain} || 'www'; 257 258 if ($param{password}) { 259 if (!$param{username}) { 260 croak "if password is provided, username is required."; 261 } elsif (!$param{client_id} or !$param{secret}) { 262 croak "client_id and secret are required for authorized apps."; 263 } else { 264 $self->{auth_type} = 'script'; 265 $self->{client_id} = $param{client_id}; 266 $self->{secret} = $param{secret}; 267 $self->{username} = $param{username}; 268 $self->{password} = $param{password}; 269 270 $self->get_token(); 271 } 272 } elsif ($param{refresh_token}) { 273 croak "client_id and secret are required for authorized apps." unless $param{client_id} and $param{secret}; 274 275 $self->{auth_type} = 'webapp'; 276 $self->{client_id} = $param{client_id}; 277 $self->{secret} = $param{secret}; 278 $self->{refresh_token}= $param{refresh_token}; 279 # will this break anything? 280 $self->{username} = $param{username} if $param{username}; 281 282 $self->get_token(); 283 } else { 284 # optionall allow people to pass in client id and secret now, for people 285 # who choose to get refresh token from an RC object 286 $self->{client_id} = $param{client_id} if $param{client_id}; 287 $self->{secret} = $param{secret} if $param{secret}; 288 # can this even be run without auth anymore? 289 $self->{auth_type} = 'none'; 290 } 291 292 return $self; 293} 294 295sub version { 296 my $self = shift; 297 return $VERSION; 298} 299 300#=============================================================================== 301# Requests and Oauth 302#=============================================================================== 303 304sub request { 305 my ($self, $method, $path, $query, $post_data) = @_; 306 307 # 401s not being caused by this. they are a new API issue apparently. 308 if (!$self->{last_token} or $self->{last_token} <= ( time - 3600 + 55) ) { 309 # passing in username, pass, client_id, secret here did nothing 310 $self->get_token(); 311 } 312 313 # Trim leading slashes off of the path 314 $path =~ s/^\/+//; 315 my $request = Reddit::Client::Request->new( 316 user_agent => $self->{user_agent}, 317 # path is sprintf'd before call, in api_json_request 318 # the calling function passes in path %s's in 'args' param 319 url => sprintf('%s/%s', $BASE_URL, $path), 320 method => $method, 321 query => $query, 322 post_data => $post_data, 323 modhash => $self->{modhash}, 324 cookie => $self->{cookie}, 325 token => $self->{token}, 326 tokentype => $self->{tokentype}, 327 last_token => $self->{last_token}, 328 request_errors=> $self->{request_errors}, 329 print_response=> $self->{print_response}, 330 print_request=> $self->{print_request}, 331 print_request_on_error=>$self->{print_request_on_error}, 332 ); 333 334 return $request->send; 335} 336 337sub get_token { 338 my ($self, %param) = @_; 339 340 # let people set auth things here. this was stupid to allow. 341 # these all set $self properties then continue as normal. 342 if ($param{username} or $param{password}) { 343 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}; 344 345 $self->{auth_type} = 'script'; 346 $self->{client_id} = $param{client_id}; 347 $self->{secret} = $param{secret}; 348 $self->{username} = $param{username}; 349 $self->{password} = $param{password}; 350 351 } elsif ($param{refresh_token}) { 352 $self->{auth_type} = 'webapp'; 353 $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."; 354 $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."; 355 $self->{refresh_token} = $param{refresh_token}; 356 } 357 358 $self->{last_token} = time; 359 360 # why don't we just pass in the whole Client object ffs 361 my %p = ( 362 client_id => $self->{client_id}, 363 secret => $self->{secret}, 364 user_agent => $self->{user_agent}, 365 auth_type => $self->{auth_type}, 366 ); 367 368 if ($self->{auth_type} eq 'script') { 369 $p{username} = $self->{username}, 370 $p{password} = $self->{password}, 371 } elsif ($self->{auth_type} eq 'webapp') { 372 $p{refresh_token} = $self->{refresh_token}; 373 } else { die "get_token: invalid auth type"; } 374 375 # Why is this static? 376 my $message = Reddit::Client::Request->token_request(%p); 377 my $j = decode_json($message); 378 $self->{token} = $j->{access_token}; 379 $self->{tokentype} = $j->{token_type}; 380 381 if (!$self->{token}) { croak "Unable to get or parse token."; } 382} 383 384sub has_token { 385 my $self = shift; 386 return (!$self->{last_token} || $self->{last_token} <= time - 3595) ? 0 : 1; 387} 388# 389# This must be called in static context because no refresh token or user/ 390# pass combination exist. We would have to add a third flow and that doesn't 391# seem worth it. 392# 393# We could call it in an empty RC object, but that would require all sorts 394# of annoyoing conditions, and all other methods would be broken until 395# tokens were obtained 396sub get_refresh_token { 397 my ($self, %param) = @_; 398 399 my %data; 400 $data{code} = $param{code} || die "'code' is required.\n"; 401 $data{redirect_uri} = $param{redirect_uri} || die "'redirect_uri' is required.\n"; 402 $data{client_id} = (ref $self eq 'HASH' and $self->{client_id} ? $self->{client_id} : undef) || $param{client_id} || die "'client_id' is required.\n"; 403 $data{secret} = (ref $self eq 'HASH' and $self->{secret} ? $self->{secret} : undef) || $param{secret} || die "'secret' is required."; 404 $data{ua} = (ref $self eq 'HASH' and $self->{user_agent} ? $self->{user_agent} : undef) || $param{user_agent} || die "'user_agent' is required."; 405 #$data{ua} = $param{user_agent} || die "user_agent is required"; 406 $data{grant_type} = 'authorization_code'; 407 $data{duration} = 'permanent'; 408 409 my $refresh_token = Reddit::Client::Request->refresh_token_request(%data); 410 return $refresh_token; 411} 412 413sub json_request { 414 my ($self, $method, $path, $query, $post_data) = @_; 415 DEBUG('%4s JSON', $method); 416 417 if ($method eq 'POST') { 418 $post_data ||= {}; 419 $post_data->{api_type} = 'json'; # only POST enpoints require* 420 } else { 421 #$path .= '.json'; # the oauth api returns json by default 422 } 423 424 my $response = $self->request($method, $path, $query, $post_data); 425 my $json = JSON::from_json($response) if $response; 426 427 if (ref $json eq 'HASH' && $json->{json}) { 428 my $result = $json->{json}; 429 if (@{$result->{errors}}) { 430 DEBUG('API Errors: %s', Dumper($result->{errors})); 431 my @errors = map { 432 sprintf '[%s] %s', $_->[0], $_->[1] 433 } @{$result->{errors}}; 434 croak sprintf("Error(s): %s", join('|', @errors)); 435 } else { 436 return $result; 437 } 438 } else { 439 return $json; 440 } 441} 442 443sub api_json_request { 444 my ($self, %param) = @_; 445 my $args = $param{args} || []; 446 my $api = $param{api}; 447 my $data = $param{data}; 448 my $callback = $param{callback}; 449 450 croak 'Expected "api"' unless defined $api; 451 452 DEBUG('API call %d', $api); 453 454 my $info = $API[$api] || croak "Unknown API: $api"; 455 my ($method, $path) = @$info; 456 $path = sprintf $path, @$args; 457 458 my ($query, $post_data); 459 if ($method eq 'GET' or $method eq 'DELETE') { 460 $query = $data; 461 } else { 462 $post_data = $data; 463 } 464 465 my $result = $self->json_request($method, $path, $query, $post_data); 466 467 # This breaks on endpoints that return an array like flairselect v2 468 if (ref $result eq 'HASH' and exists $result->{errors}) { 469 my @errors = @{$result->{errors}}; 470 471 if (@errors) { 472 DEBUG("ERRORS: @errors"); 473 my $message = join(' | ', map { join(', ', @$_) } @errors); 474 croak $message; 475 } 476 } 477 478 if (defined $callback && ref $callback eq 'CODE') { 479 return $callback->($result); 480 } else { 481 return $result; 482 } 483} 484 485# deprecated, to be removed 486sub is_logged_in { 487 return defined $_[0]->{modhash}; 488} 489 490# deprecated, to be removed 491sub require_login { 492 my $self = shift; 493 return; 494} 495 496 497#=============================================================================== 498# User and account management 499#=============================================================================== 500 501sub me { 502 my $self = shift; 503 DEBUG('Request user account info'); 504 my $result = $self->api_json_request(api => API_ME); 505 # Account has no data property like other things 506 return Reddit::Client::Account->new($self, $result); 507} 508sub list_subreddits { 509 my ($self, %param) = @_; 510 my $type = $param{view} || SUBREDDITS_HOME; 511 $type = '' if lc $type eq 'home'; 512 513 my $query = $self->set_listing_defaults(%param); 514 515 my $api = $type eq SUBREDDITS_MOD || $type eq SUBREDDITS_CONTRIB || $type eq SUBREDDITS_MINE ? API_MY_SUBREDDITS : API_SUBREDDITS; 516 517 my $result = $self->api_json_request( 518 api => $api, 519 args => [$type], 520 data => $query, 521 ); 522 523 return [ 524 map {Reddit::Client::SubReddit->new($self, $_->{data})} @{$result->{data}{children}} 525 ]; 526} 527 528sub contrib_subreddits { 529 my ($self, %param) = @_; 530 $param{view} = SUBREDDITS_CONTRIB; 531 return $_[0]->list_subreddits(%param); 532} 533sub home_subreddits { 534 my ($self, %param) = @_; 535 $param{view} = SUBREDDITS_HOME; 536 return $_[0]->list_subreddits(%param); 537} 538sub mod_subreddits { 539 my ($self, %param) = @_; 540 $param{view} = SUBREDDITS_MOD; 541 return $_[0]->list_subreddits(%param); 542} 543sub my_subreddits { 544 my ($self, %param) = @_; 545 $param{view} = SUBREDDITS_MINE; 546 return $_[0]->list_subreddits(%param); 547} 548sub new_subreddits { 549 my ($self, %param) = @_; 550 $param{view} = SUBREDDITS_NEW; 551 return $_[0]->list_subreddits(%param); 552} 553sub popular_subreddits { 554 my ($self, %param) = @_; 555 $param{view} = SUBREDDITS_POPULAR; 556 return $_[0]->list_subreddits(%param); 557} 558 559#=============================================================================== 560# Inbox and messages 561#=============================================================================== 562sub get_inbox { 563 my ($self, %param) = @_; 564 my $limit = $param{limit} || DEFAULT_LIMIT; 565 my $mode = $param{mode} || MESSAGES_INBOX; 566 my $view = $param{view} || MESSAGES_INBOX; 567 568 # this before and after business is stupid and needs to be fixed 569 # in 3 separate places 570 my $query = {}; 571 $query->{mark} = $param{mark} ? 'true' : 'false'; 572 $query->{sr_detail} = $param{sr_detail} if $param{sr_detail}; 573 $query->{before} = $param{before} if $param{before}; 574 $query->{after} = $param{after} if $param{after}; 575 if (exists $param{limit}) { $query->{limit} = $param{limit} || 500; } 576 else { $query->{limit} = DEFAULT_LIMIT; } 577 578 my $result = $self->api_json_request( 579 api => API_MESSAGES, 580 args => [$view], 581 data => $query, 582 ); 583 584 return [ 585 map { Reddit::Client::Message->new($self, $_->{data}) } @{$result->{data}{children}} 586 ]; 587} 588 589# TODO 590sub mark_read { 591 my ($self, %param) = @_; 592 593} 594 595sub mark_inbox_read { 596 my $self = shift; 597 my ($method, $path) = @{$API[API_MARKALL]}; 598 # Why does this error without api_type? json_request is adding it anyway? 599 my $post_data = {api_type => 'json'}; 600 my $result = $self->request($method, $path, {}, $post_data); 601} 602 603#=============================================================================== 604# Subreddits and listings 605#=============================================================================== 606 607sub get_subreddit_info { 608 my $self = shift; 609 my $sub = shift || croak 'Argument 1 (subreddit name) is required.'; 610 $sub = subreddit($sub); 611 612 my $result = $self->api_json_request( 613 api => API_SUBREDDIT_INFO, 614 args => [$sub], 615 ); 616 return $result->{data}; 617} 618 619sub info { 620 my ($self, $id) = @_; 621 defined $id || croak 'Expected $id'; 622 my $query->{id} = $id; 623 624 my $info = $self->api_json_request( 625 api => API_INFO, 626 data=>$query 627 ); 628 #return $info; 629 my $rtn = $info->{data}->{children}[0]->{data}; 630 $rtn->{kind} = $info->{data}->{children}[0]->{kind} if $rtn; 631 return $rtn; 632} 633 634sub search { 635 my ($self, %param) = @_; 636 my $sub = $param{subreddit} || $param{sub} || croak "'subreddit' or 'sub' is required."; 637 638 my $query = $self->set_listing_defaults(%param); 639 $query->{q} = $param{q} || croak "'q' (search string) is required."; 640 641 # things the user should be able to choose but we're hard coding 642 $query->{restrict_sr} = 'on'; 643 $query->{include_over18}= 'on'; 644 $query->{t} = 'all'; 645 $query->{syntax} = 'cloudsearch'; 646 $query->{show} = 'all'; 647 $query->{type} = 'link'; # return Link objects 648 $query->{sort} = 'top'; 649 650 my $args = [$sub]; 651 652 my $result = $self->api_json_request( 653 api => API_SEARCH, 654 args=> $args, 655 data => $query, 656 ); 657 658 #return $result->{data}; 659 return [ 660 map {Reddit::Client::Link->new($self, $_->{data})} @{$result->{data}{children}} 661 ]; 662} 663sub get_permalink { 664 # This still makes an extra request. Why? 665 my ($self, $commentid, $post_fullname) = @_; 666 667 if (substr ($commentid, 0, 3) eq "t1_") { $commentid = substr $commentid, 3; } 668 if (substr ($post_fullname, 0, 3) ne "t3_") { $post_fullname = "t3_" . $post_fullname; } 669 670 my $info = $self->info($post_fullname); 671 return sprintf "%s%s%s", $LINK_URL, $info->{permalink}, $commentid; 672} 673 674sub find_subreddits { 675 my ($self, %param) = @_; 676 677 my $query = $self->set_listing_defaults(%param); 678 $query->{q} = $param{q} || croak "expected 'q'"; 679 $query->{sort} = $param{sort} || 'relevance'; 680 681 my $result = $self->api_json_request( 682 api => API_SUB_SEARCH, 683 data => $query, 684 ); 685 return [ 686 map { Reddit::Client::SubReddit->new($self, $_->{data}) } @{$result->{data}{children}} 687 ]; 688} 689 690sub fetch_links { 691 my ($self, %param) = @_; 692 my $subreddit = $param{sub} || $param{subreddit} || ''; 693 my $view = $param{view} || VIEW_DEFAULT; 694 695 my $query = $self->set_listing_defaults(%param); 696 697 $subreddit = subreddit($subreddit); 698 699 my $args = [$view]; 700 unshift @$args, $subreddit if $subreddit; 701 702 my $result = $self->api_json_request( 703 api => ($subreddit ? API_LINKS_FRONT : API_LINKS_OTHER), 704 args => $args, 705 data => $query, 706 ); 707 #return $result; 708 709 return [ 710 map { Reddit::Client::Link->new($self, $_->{data}) } @{$result->{data}{children}} 711 ]; 712} 713 714sub get_links { # alias for fetch_links to make naming convention consistent 715 my ($self, %param) = @_; 716 return $self->fetch_links(%param); 717} 718# Is this a better way to get a single link than a call to info? 719sub get_links_by_id { 720 my ($self, @fullnames) = @_; 721 die "get_links_by_id: argument 1 (\@fullnames) is required.\n" unless @fullnames; 722 @fullnames = map { fullname($_, 't3') } @fullnames; 723 my $str = join ",", @fullnames; 724 # what the fuck is this? 725 my $result = $self->json_request('GET', $API[API_BY_ID][1]."/$str"); 726 #return $result; 727 728 return [ 729 map { Reddit::Client::Link->new($self, $_->{data}) } @{$result->{data}{children}} 730 ]; 731} 732 733# TODO: use get links by id, then return just the top one 734sub get_link { 735 my ($self, $fullname) = @_; 736 die "get_link: need arg 1 (id/fullname)" unless $fullname; 737 738 $fullname = fullname($fullname, 't3'); 739 my $result = $self->json_request('GET', $API[API_BY_ID][1]."/$fullname"); 740 741 return Reddit::Client::Link->new($self, $result->{data}{children}[0]{data}); 742} 743 744sub get_comment { 745 my ($self, $fullname, %param) = @_; 746 croak "expected argument 1: id or fullname" unless $fullname; 747 748 $fullname = fullname($fullname, 't1'); 749 my $info = $self->info($fullname); 750 return unless $info; 751 752 my $cmt = Reddit::Client::Comment->new($self, $info); 753 if ($param{include_children} and $cmt->{permalink}) { 754 $cmt = $self->get_comments(permalink=>$cmt->{permalink}); 755 $cmt = $$cmt[0]; 756 } 757 return $cmt; 758} 759 760sub get_subreddit_comments { 761 my ($self, %param) = @_; 762 my $subreddit = $param{sub} || $param{subreddit} || ''; 763 my $view = $param{view} || VIEW_DEFAULT; 764 765 my $query = {}; 766 $query->{before} = $param{before} if $param{before}; 767 $query->{after} = $param{after} if $param{after}; 768 if (exists $param{limit}) { $query->{limit} = $param{limit} || 500; } 769 else { $query->{limit} = DEFAULT_LIMIT; } 770 771 $subreddit = subreddit($subreddit); # remove slashes and leading r/ 772 #my $args = [$view]; # this did nothing 773 my $args = $subreddit ? [$subreddit] : []; 774 775 my $result = $self->api_json_request( 776 api => ($subreddit ? API_COMMENTS : API_COMMENTS_FRONT), 777 args => $args, 778 data => $query, 779 ); 780 781 #return $result; 782 #return $result->{data}{children}[0]->{data}; 783 return [ 784 map {Reddit::Client::Comment->new($self, $_->{data})} @{$result->{data}{children}} 785 ]; 786} 787 788#============================================================= 789# Moderation 790#============================================================= 791sub remove { 792 my $self = shift; 793 my $fullname = shift || die "remove: arg 1 (fullname) is required.\n"; 794 795 my $result = $self->api_json_request( 796 api => API_REMOVE, 797 data => { id => $fullname, spam=> 'false' }, 798 ); 799 return $result; 800} 801# like remove, but sets spam flag 802sub spam { 803 my $self = shift; 804 my $fullname = shift || croak "spam: arg 1 (fullname) is required.\n"; 805 806 my $result = $self->api_json_request( 807 api => API_REMOVE, 808 data => { id => $fullname, spam => 'true' }, 809 ); 810 return $result; 811} 812sub approve { 813 my $self = shift; 814 my $fullname = shift || die "approve: arg 1 (fullname) is required.\n"; 815 816 my $result = $self->api_json_request( 817 api => API_APPROVE, 818 data => { id => $fullname }, 819 ); 820 return $result; 821} 822sub ignore_reports { 823 my $self = shift; 824 my $fullname = shift || die "ignore_reports: arg 1 (fullname) is required.\n"; 825 826 my $result = $self->api_json_request( 827 api => API_IGNORE_REPORTS, 828 data => { id => $fullname }, 829 ); 830 return $result; 831} 832sub lock { 833 my ($self, $fullname, %param) = @_; 834 die "lock: arg 1 (fullname) is required.\n" unless $fullname; 835 836 if (!ispost($fullname) and !iscomment($fullname)) { 837 die "lock: arg 1 must be a fullname of a post or comment.\n"; 838 } 839 840 my $lock = exists $param{lock} ? $param{lock} : 1; 841 842 my $result = $self->api_json_request( 843 api => $lock ? API_LOCK : API_UNLOCK, 844 data => { id => $fullname }, 845 ); 846 return $result; 847} 848sub unlock { 849 my ($self, $fullname, %param) = @_; 850 851 return $self->lock($fullname, lock=>0); 852} 853sub nsfw { 854 my ($self, $fullname, %param) = @_; 855 die "nsfw: arg 1 (fullname) is required.\n" unless $fullname; 856 857 if (!ispost($fullname)) { 858 die "nsfw: arg 1 must be a fullname of a post or comment.\n"; 859 } 860 861 my $nsfw = exists $param{nsfw} ? $param{nsfw} : 1; 862 863 my $result = $self->api_json_request( 864 api => $nsfw ? API_MARKNSFW : API_UNMARKNSFW, 865 data => { id => $fullname }, 866 ); 867 return $result; 868} 869sub unnsfw { 870 my ($self, $fullname, %param) = @_; 871 872 return $self->nsfw($fullname, nsfw=>0); 873} 874# -ban uses the "modcontributors" oauth scope EXCEPT: 875# -moderator and moderator_invite use "modothers" 876# -wikibanned and wikicontributor require both modcontributors and modwiki 877# https://old.reddit.com/dev/api/#POST_api_friend 878# 879# -ban is really a call to friend, which creates relationships between accounts. 880# other functions can call it and pass in a different mode (see functions below) 881sub ban { 882 my ($self, %param) = @_; 883 my $sub = $param{sub} || $param{subreddit} || die "subreddit is required\n"; 884 885 my $data = {}; 886 $data->{name} = $param{user} || $param{username} || die "username is required\n"; 887 # ban_context = fullname, but of what - not required 888 889 # Ban message 890 $data->{ban_message} = $param{ban_message} if $param{ban_message}; 891 # Reason: matches short report reason 892 if ($param{reason}) { 893 if (length $param{reason} > 100) { 894 print "Warning: 'reason' longer than 100 characters. Truncating.\n"; 895 $param{reason} = substr $param{reason}, 0, 100; 896 } 897 $data->{ban_reason} = $param{reason}; 898 } 899 900 if ($param{note}) { 901 if (length $param{note} > 300) { 902 print "Warning: 'note' longer than 300 characters. Truncating.\n"; 903 $param{note} = substr $param{note}, 0, 300; 904 } 905 $data->{note} = $param{note}; 906 } 907 908 if ($param{duration}){ # if 0 this never even hits which we want anyway 909 if ($param{duration} > 999) { 910 print "Warning: Max duration is 999. Setting to 999.\n"; 911 $param{duration} = 999; 912 } elsif ($param{duration} < 1) { 913 $param{duration} = 0; 914 } 915 $data->{duration} = $param{duration} if $param{duration}; 916 } 917 # $data->{container} is not needed unless mode is friend or enemy 918 # $data->{permissions} = ? 919 920 # type is one of (friend, moderator, moderator_invite, contributor, banned, muted, wikibanned, wikicontributor) 921 if ($param{mode} eq 'mute') { 922 $data->{type} = 'muted'; 923 } elsif ($param{mode} eq 'contributor') { 924 $data->{type} = 'contributor'; 925 } elsif ($param{mode} eq 'moderator_invite') { 926 print "modinvite\n"; 927 $data->{type} = 'moderator_invite'; 928 } else { 929 $data->{type} = 'banned'; 930 } 931 932 my $result = $self->api_json_request( 933 api => API_BAN, 934 args => [$sub], 935 data => $data, 936 ); 937 return $result; 938} 939 940sub mute { 941 my ($self, %param) = @_; 942 $param{mode} = 'mute'; 943 return $self->ban(%param); 944} 945 946sub add_approved_user { 947 my ($self, %param) = @_; 948 $param{mode} = 'contributor'; 949 return $self->ban(%param); 950} 951# Requires scope 'modothers' 952sub invite_moderator { 953 my ($self, %param) = @_; 954 $param{mode} = 'moderator_invite'; 955 return $self->ban(%param); 956} 957 958sub unban { 959 my ($self, %param) = @_; 960 my $sub = $param{sub} || $param{subreddit} || die "subreddit is required\n"; 961 962 my $data = {}; 963 $data->{name} = $param{username} || die "username is required\n"; 964 # ban_context = fullname, but of what - not required 965 966 if ($param{mode} eq 'mute') { 967 $data->{type} = 'muted'; 968 } else { 969 $data->{type} = 'banned'; 970 } 971 972 my $result = $self->api_json_request( 973 api => API_UNBAN, 974 args => [$sub], 975 data => $data, 976 ); 977 return $result; 978} 979 980sub unmute { 981 my ($self, %param) = @_; 982 $param{mode} = 'mute'; 983 return $self->unban(%param); 984} 985 986sub distinguish { 987 my ($self, $fullname, %param) = @_; 988 my $data = {}; 989 990 if (!iscomment($fullname) and !ispost($fullname)) { 991 die 'Fullname is required (comment preceeded by "t1_", post "t3_")'; 992 } 993 994 if (iscomment($fullname)) { 995 # only top level can be sticky 996 my $sticky = exists $param{sticky} ? $param{sticky} : 0; 997 $data->{sticky} = $sticky ? 'true' : 'false'; 998 } 999 1000 $data->{id} = $fullname; 1001 1002 1003 $data->{how} = 'yes'; 1004 # Check manual setting of 'how'. Normal users should never set 'how'. 1005 if ($param{how}) { 1006 my @valid = qw/yes no admin special/; 1007 my $ok; 1008 for (@valid) { 1009 if ($param{how} eq $_) { 1010 $ok = 1; 1011 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 1012 } 1013 } 1014 1015 die "valid values for 'how' are: yes, no, admin, special\n" unless $ok; 1016 } 1017 1018 my $result = $self->api_json_request( 1019 api => API_DISTINGUISH, 1020 data => $data, 1021 ); 1022 return $result; 1023} 1024 1025sub undistinguish { 1026 my ($self, $fullname, %param) = @_; 1027 my $data = {}; 1028 1029 if (!iscomment($fullname) and !ispost($fullname)) { 1030 die 'Fullname is required (comment preceeded by "t1_", post "t3_")'; 1031 } 1032 1033 $data->{id} = $fullname; 1034 $data->{how} = 'no'; 1035 1036 my $result = $self->api_json_request( 1037 api => API_UNDISTINGUISH, 1038 data => $data, 1039 ); 1040 return $result; 1041} 1042 1043sub get_modlinks { 1044 my ($self, %param) = @_; 1045 1046 my $query = $self->set_listing_defaults(%param); 1047 my $sub = $param{sub} || $param{subreddit} || 'mod'; 1048 my $mode = $param{mode} || 'modqueue'; 1049 1050 my $result = $self->api_json_request( 1051 api => API_MODQ, 1052 args => [$sub, $mode], 1053 data => $query, 1054 ); 1055 1056 #return $result->{data}; 1057 1058 return [ 1059 map { 1060 1061 $_->{kind} eq "t1" ? 1062 Reddit::Client::Comment->new($self, $_->{data}) : 1063 Reddit::Client::Link->new($self, $_->{data}) 1064 } 1065 1066 @{$result->{data}{children}} 1067 ]; 1068} 1069sub get_modqueue { 1070 my ($self, %param) = @_; 1071 $param{mode} = 'modqueue'; 1072 return $self->get_modlinks(%param); 1073} 1074 1075# after: conversation id 1076# entity: comma-delimited list of subreddit names 1077# limit 1078# sort: one of (recent, mod, user, unread) 1079# state: one of (new, inprogress, mod, notifications, archived, highlighted, all 1080sub get_modmail { 1081 my ($self, %param) = @_; 1082 1083 my $data = {}; 1084 $data->{sort} = $param{sort} || 'unread'; 1085 $data->{state} = $param{state} || 'all'; 1086 $data->{after} = $param{after} if $param{after}; 1087 $data->{limit} = exists $param{limit} ? ( $param{limit} ? $param{limit} : 500 ) : DEFAULT_LIMIT; 1088 1089 my $subs = $param{entity} || $param{subreddits} || $param{subs}; 1090 if ($subs) { 1091 $subs = join ",", @$subs if ref $subs eq 'ARRAY'; 1092 $data->{entity} = $subs if $subs; 1093 } 1094 my $result = $self->api_json_request( 1095 api => API_GET_MODMAIL, 1096 data => $data, 1097 ); 1098 return $result; 1099} 1100sub get_modmail_raw { 1101 my ($self, %param) = @_; 1102 1103 my $data = {}; 1104 $data->{sort} = $param{sort} || 'unread'; 1105 $data->{state} = $param{state} || 'all'; 1106 $data->{after} = $param{after} if $param{after}; 1107 $data->{limit} = exists $param{limit} ? ( $param{limit} ? $param{limit} : 500 ) : DEFAULT_LIMIT; 1108 1109 my $subs = $param{entity} || $param{subreddits} || $param{subs}; 1110 if ($subs) { 1111 $subs = join ",", @$subs if ref $subs eq 'ARRAY'; 1112 $data->{entity} = $subs if $subs; 1113 } 1114 my $result = $self->api_json_request( 1115 api => API_GET_MODMAIL, 1116 data => $data, 1117 ); 1118 return $result; 1119} 1120 1121#============================================================= 1122# Users 1123#============================================================= 1124sub get_user { 1125 my ($self, %param) = @_; 1126 my $view = $param{view} || 'overview'; 1127 my $user = $param{user} || $param{username} || croak "expected 'user'"; 1128 1129 my $query = $self->set_listing_defaults(%param); 1130 1131 my $args = [$user, $view]; 1132 1133 my $result = $self->api_json_request( 1134 api => API_USER, 1135 args => $args, 1136 data => $query, 1137 ); 1138 1139 if ($view eq 'about') { 1140 #return $result->{data}; 1141 return Reddit::Client::Account->new($self, $result->{data}); 1142 } 1143 return [ 1144 map { 1145 1146 $_->{kind} eq "t1" ? 1147 Reddit::Client::Comment->new($self, $_->{data}) : 1148 Reddit::Client::Link->new($self, $_->{data}) 1149 } 1150 1151 @{$result->{data}{children}} 1152 ]; 1153} 1154# Remember that this will return a new hash and any key not from here will be 1155# wuped out 1156sub set_listing_defaults { 1157 my ($self, %param) = @_; 1158 my $query = {}; 1159 $query->{before} = $param{before} if $param{before}; 1160 $query->{after} = $param{after} if $param{after}; 1161 $query->{only} = $param{only} if $param{only}; 1162 $query->{count} = $param{count} if $param{count}; 1163 $query->{show} = 'all' if $param{show} or $param{show_all}; 1164 $query->{sr_detail} = 'true' if $param{sr_detail}; 1165 if (exists $param{limit}) { $query->{limit} = $param{limit} || 500; } 1166 else { $query->{limit} = DEFAULT_LIMIT; } 1167 1168 return $query; 1169} 1170#=============================================================================== 1171# Change posts or comments 1172#=============================================================================== 1173 1174sub edit { 1175 my ($self, $name, $text) = @_; 1176 my $type = substr $name, 0, 2; 1177 croak 'Argument 1 ($fullname) must be a post or comment.' if $type ne 't1' && $type ne 't3'; 1178 croak 'Argument 2 (text) is required. Empty strings are allowed.' unless defined $text; 1179 1180 my $data = { 1181 thing_id => $name, 1182 text => $text 1183 }; 1184 1185 my $result = $self->api_json_request( 1186 api => API_EDIT, 1187 data => $data, 1188 ); 1189 return $result->{data}{things}[0]{data}{name}; 1190} 1191 1192sub delete { 1193 my ($self, $name) = @_; 1194 croak 'Expected $fullname' if !$name; 1195 my $type = substr $name, 0, 2; 1196 croak '$fullname must be a post or comment' if $type ne 't1' && $type ne 't3'; 1197 1198 DEBUG('Delete post/comment %s', $name); 1199 1200 my $result = $self->api_json_request(api => API_DEL, data => { id => $name }); 1201 return $result; 1202} 1203 1204#=============================================================================== 1205# Submitting links 1206#=============================================================================== 1207 1208sub submit_link { 1209 my ($self, %param) = @_; 1210 # why is sub allowed to be empty? 1211 my $subreddit = $param{subreddit} || $param{sub} || ''; 1212 my $title = $param{title} || croak 'Expected "title"'; 1213 my $url = $param{url} || croak 'Expected "url"'; 1214 my $replies = exists $param{inbox_replies} ? ($param{inbox_replies} ? "true" : "false") : "true"; 1215 my $repost = exists $param{repost} ? ($param{repost} ? "true" : "false") : "false"; 1216 my $nsfw = exists $param{nsfw} ? ($param{nsfw} ? "true" : "false") : "false"; 1217 1218 DEBUG('Submit link to %s: %s', $subreddit, $title, $url); 1219 1220 $subreddit = subreddit($subreddit); 1221 1222 my $result = $self->api_json_request(api => API_SUBMIT, data => { 1223 title => $title, 1224 url => $url, 1225 sr => $subreddit, 1226 kind => SUBMIT_LINK, 1227 sendreplies => $replies, 1228 resubmit => $repost, 1229 nsfw => $nsfw, 1230 }); 1231 1232 return $result->{data}{name}; 1233} 1234 1235sub submit_crosspost { 1236 my ($self, %param) = @_; 1237 # why is subreddit allowed to be empty? 1238 my $subreddit = $param{subreddit} || $param{sub} || die "expected 'subreddit'\n"; 1239 my $title = $param{title} || die "Expected 'title'\n"; 1240 my $source_id = $param{source_id} || die "Expected 'source_id'\n"; 1241 $source_id = "t3_$source_id" if lc substr($source_id, 0, 3) ne 't3_'; 1242 #my $url = $param{url} || croak 'Expected "url"'; 1243 my $replies = exists $param{inbox_replies} ? ($param{inbox_replies} ? "true" : "false") : "true"; 1244 my $repost = exists $param{repost} ? ($param{repost} ? "true" : "false") : "false"; 1245 1246 $subreddit = subreddit($subreddit); 1247 1248 my $result = $self->api_json_request(api => API_SUBMIT, data => { 1249 title => $title, 1250 #url => $url, 1251 crosspost_fullname => $source_id, 1252 sr => $subreddit, 1253 kind => SUBMIT_CROSSPOST, 1254 sendreplies => $replies, 1255 resubmit => $repost, 1256 }); 1257 1258 return $result->{data}{name}; 1259} 1260 1261sub submit_text { 1262 my ($self, %param) = @_; 1263 my $subreddit = $param{subreddit} || $param{sub} || die "expected 'subreddit'\n"; 1264 my $title = $param{title} || croak 'Expected "title"'; 1265 my $text = $param{text} || croak 'Expected "text"'; 1266 # true and false have to be the strings "true" or "false" 1267 my $replies = exists $param{inbox_replies} ? ($param{inbox_replies} ? "true" : "false") : "true"; 1268 1269 DEBUG('Submit text to %s: %s', $subreddit, $title); 1270 1271 $subreddit = subreddit($subreddit); 1272 1273 my $result = $self->api_json_request(api => API_SUBMIT, data => { 1274 title => $title, 1275 text => $text, 1276 sr => $subreddit, 1277 kind => SUBMIT_SELF, 1278 sendreplies=>$replies, 1279 }); 1280 1281 return $result->{data}{name}; 1282} 1283# These could go in the user section or here, but it seems like it will be 1284# more commonly used for flairing posts 1285sub template { 1286 my ($self, %param) = @_; 1287 my $data = {}; # POST data 1288 my $url_arg; # arguments that get interpolated into the URL 1289 1290 my $result = $self->api_json_request( 1291 api => API_FLAIR, 1292 args => [$url_arg], 1293 data => $data 1294 ); 1295} 1296 1297# flair a post, not using an existing template, just manually providing the 1298# text and CSS class 1299sub flair_post { 1300 my ($self, %param) = @_; 1301 my $link_fullname = $param{link_id} || $param{post_id} || die "flair_post: need 'link_id'\n"; 1302 $link_fullname = fullname($link_fullname, 't3'); 1303 my $subreddit = $param{sub} || $param{subreddit} || die "flair_post: need 'subreddit'\n"; 1304 # Initializing $text to '' here was accidentally preventing a concatenation 1305 # warning from Request 1306 my $text = $param{text} ? substr($param{text}, 0, 64) : ''; 1307 my $css_class = $param{css_class}; # optional 1308 1309 my $data = { link => $link_fullname }; 1310 $data->{text} = $text if $text; 1311 $data->{css_class} = $css_class if $css_class; 1312 1313 my $result = $self->api_json_request( 1314 api => API_FLAIR, 1315 args => [$subreddit], 1316 data => $data 1317 ); 1318} 1319sub flair_link { 1320 my ($self, %param) = @_; 1321 return $self->flair_post(%param); 1322} 1323 1324# flair a user, not using an existing template, just manually providing the 1325# text and CSS class 1326sub flair_user { 1327 my ($self, %param) = @_; 1328 my $username = $param{username} || die "flair_user: need 'link_id'\n"; 1329 my $text = $param{text} ? substr($param{text}, 0, 64) : ''; 1330 my $css_class = $param{css_class}; #optional 1331 my $subreddit = $param{sub} || $param{subreddit} || die "flair_user: need 'subreddit'\n"; 1332 1333 my $data = { name => $username }; 1334 $data->{text} = $text if $text; 1335 $data->{css_class} = $css_class if $css_class; 1336 1337 my $result = $self->api_json_request( 1338 api => API_FLAIR, 1339 args => [$subreddit], 1340 data => $data 1341 ); 1342 1343} 1344 1345sub set_post_flair { # select_flair alias 1346#sub select_flair { 1347 my ($self, %param) = @_; 1348 #return $self->set_post_flair(%param); 1349 return $self->select_flair(%param); 1350} 1351# select_flair can apply flair which appears styled in multi views (such as 1352# r/all, your homepage, and both kinds of multis). 1353# Flair applied through other methods has no style in multi views. 1354# view sub newred | sub oldred | multi view 1355# Apply manually new reddit x x 1356# API x x 1357# Automod applies x x! x 1358# 1359# -New reddit and multis always ignore CSS class 1360# -Old reddit will have the new style IF it is applied by Automod and IF it has 1361# no css_class. Otherwise it uses old styles like usual. 1362# -If a css_class is added by any means, old reddit will lose new styles. 1363# -If you alter the flair in any way through either the old or new interface, 1364# old reddit will lose the new style. 1365# -If text is altered with flair_link, old reddit will lose new styles. 1366# - Multi view (same as r/all view) seems to show whatever new reddit does. 1367# - text_color and background_color seem to have no effect on anything. 1368# 1369# Flair will use values from the flair selection as defaults. Some can only be 1370# set through the new interface or the API. 1371# 1372# It looks like flair templates with a background_color attempt to hard code the 1373# background color - that is, they use style="" tags. There is no way to do this 1374# with old reddit, only API and new. The override_css option in /r/api/flairtemplate2 may be related. 1375#sub set_post_flair { # select_flair alias 1376sub select_flair { 1377 my ($self, %param) = @_; 1378 my $errmsg = "select_flair: 'subreddit' and 'flair_template_id' (or alias 'flair_id') are required.\n"; 1379 my $sub = $param{sub} || $param{subreddit} || die $errmsg; 1380 my $flairid = $param{flair_template_id} || $param{flair_id} || die $errmsg; 1381 my $post_id = $param{link_id} || $param{post_id}; 1382 1383 # This doesn't use LINK_FLAIR or USER_FLAIR, it watches for link id or usern 1384 if (!$post_id and !$param{username}) { 1385 die "select_flair: either 'link_id' or 'username' is required.\n"; 1386 } elsif ($post_id) { 1387 $post_id = fullname($post_id, 't3'); 1388 } 1389 1390 my $textcol = $param{text_color}; 1391 # putting an actual color here will be a common mistake 1392 if ($textcol) { 1393 $textcol = lc $textcol; 1394 if ($textcol ne 'light' and $textcol ne 'dark') { 1395 die "select_flair: if provided, text_color must be 'light' or 'dark'.\n"; 1396 } 1397 } 1398 1399 my $data = {}; 1400 1401 $data->{background_color} = $param{background_color} if $param{background_color}; 1402 $data->{css_class} = $param{css_class} if $param{css_class}; 1403 $data->{flair_template_id} = $flairid; 1404 $data->{link} = $post_id if $post_id; 1405 $data->{name} = $param{username} if $param{username}; 1406 $data->{return_rtjson} = $param{return_rtjson} if $param{return_rtjson}; 1407 $data->{text_color} = $textcol if $textcol; 1408 # if given empty string Reddit ignores the parameter-- i.e. you can't do 1409 # tricks like invisibly flair something, like you could with v1 1410 # Also passing undef here gives a concatenation error in Request 1411 $data->{text} = $param{text} || ''; 1412 1413 my $result = $self->api_json_request( 1414 api => API_SELECTFLAIR, 1415 args => [$sub], 1416 data => $data 1417 ); 1418 1419 return $result; 1420} 1421sub select_user_flair { 1422 my ($self, %param) = @_; 1423 return $self->set_user_flair(%param); 1424} 1425sub set_user_flair { 1426 my $errmsg = "select_user_flair: keys 'subreddit', 'username', and 'flair_template_id' (or alias 'flair_id') are required.\n"; 1427 my ($self, %param) = @_; 1428 my $sub = $param{subreddit} || die $errmsg; 1429 my $user = $param{username} || die $errmsg; 1430 my $flairid = $param{flair_template_id} || $param{flair_id} || die $errmsg; 1431 my $data = {}; 1432 1433 $data->{name} = $user; 1434 $data->{flair_template_id} = $flairid; 1435 1436 my $result = $self->api_json_request( 1437 api => API_SELECTFLAIR, 1438 args => [$sub], 1439 data => $data 1440 ); 1441 1442 return $result; 1443} 1444 1445# Return a hash reference with keys 'choices' and 'current' 1446# 'choices' is array of hashes with flair options 1447# 'current' is the post's current flair 1448sub get_flair_options { 1449 my ($self, %param) = @_; 1450 my $sub = $param{sub} || $param{subreddit} || die "get_flair_options: 'subreddit' (or alias 'sub') is required.\n"; 1451 my $post_id = $param{link_id} || $param{post_id}; 1452 my $user = $param{username}; 1453 my $data = {}; 1454 1455 if ($post_id) { 1456 $post_id = fullname($post_id, 't3'); 1457 $data->{link} = $post_id; 1458 } elsif ($user) { 1459 $data->{user} = $user; 1460 } else { 1461 die "get_flair_options: Need 'post_id' or 'username'"; 1462 } 1463 1464 my $result = $self->api_json_request( 1465 api => API_FLAIROPTS, 1466 args => [$sub], 1467 data => $data, 1468 ); 1469 1470 # What's this? Fixing the booleans? 1471 if ($result->{choices}) { 1472 for (my $i=0; $result->{choices}[$i]; $i++) { 1473 $result->{choices}[$i]->{flair_text_editable} = $result->{choices}[$i]->{flair_text_editable} ? 1 : 0; 1474 1475 } 1476 } 1477 1478 return $result; 1479} 1480sub get_link_flair_options { # v2: default now 1481 my $self = shift; 1482 my $sub = shift || die "get_link_flair_options: Need arg 1 (subreddit)\n"; 1483 1484 my $result = $self->api_json_request( 1485 api => API_LINKFLAIRV2, 1486 args => [$sub], 1487 ); 1488 return $result; 1489} 1490sub get_link_flair_options_v1 { # v1 1491 my $self = shift; 1492 my $sub = shift || die "get_link_flair_options: Need arg 1 (subreddit)\n"; 1493 1494 my $result = $self->api_json_request( 1495 api => API_LINKFLAIRV1, 1496 args => [$sub], 1497 ); 1498 return $result; 1499} 1500sub get_user_flair_options { # v2: default now 1501 my $self = shift; 1502 my $sub = shift || die "get_link_flair_options: Need arg 1 (subreddit)\n"; 1503 1504 my $result = $self->api_json_request( 1505 api => API_USERFLAIRV2, 1506 args => [$sub], 1507 ); 1508 return $result; 1509} 1510sub get_user_flair_options_v1 { # v1 1511 my $self = shift; 1512 my $sub = shift || die "get_link_flair_options: Need arg 1 (subreddit)\n"; 1513 1514 my $result = $self->api_json_request( 1515 api => API_USERFLAIRV1, 1516 args => [$sub], 1517 ); 1518 return $result; 1519} 1520# uses flairtemplate_v2 endpoint, which is for new but works for old 1521sub flairtemplate { 1522 my ($self, %param) = @_; 1523 my $sub = $param{sub} || $param{subreddit} || die "flairtemplate: 'subreddit' (or alias 'sub') is required.\n"; 1524 my $bg = $param{background_color} if $param{background_color}; 1525 my $flairid = $param{flair_template_id} || $param{flair_id} || $param{id} || undef; 1526 #my $type = $param{flair_type} || die $err; 1527 my $modonly = exists $param{mod_only} ? ($param{mod_only} ? 'true' : 'false') : 'false'; 1528 my $editable= exists $param{text_editable} ? ($param{text_editable} ? 'true' : 'false') : 'false'; 1529 my $textcol = $param{text_color}; 1530 # putting an actual color here will be a common mistake 1531 if ($textcol) { 1532 $textcol = lc $textcol; 1533 if ($textcol ne 'light' and $textcol ne 'dark') { 1534 die "flairtemplate: if provided, text_color must be one of (light, dark).\n"; 1535 } 1536 } 1537 # override_css is undocumented and not returned by get_link_flair_options 1538 # $override is unused here as yet 1539 #my $override= exists $param{override_css} ? ($param{override_css} ? 'true' : 'false') : 'false'; 1540 1541 if ($bg and substr($bg, 0, 1) ne '#') { $bg = "#$bg"; } #requires hash 1542 1543 my $data = {}; 1544 $data->{allowable_content} = $param{allowable_content} if $param{allowable_content}; 1545 $data->{background_color} = $bg if $bg; 1546 $data->{css_class} = $param{css_class} if $param{css_class}; 1547 $data->{max_emojis} = $param{max_emojis} if $param{max_emojis}; 1548 # No documentation; presumably required for editing 1549 $data->{flair_template_id} = $flairid if $flairid; 1550 # api defaults to USER_FLAIR, we default to LINK_FLAIR 1551 $data->{flair_type} = $param{flair_type} || 'LINK_FLAIR'; 1552 $data->{mod_only} = $modonly if exists $param{mod_only}; 1553 # No documentation. Probably wants "true or "false". 1554 $data->{override_css} = $param{override_css} if $param{override_css}; 1555 $data->{text} = $param{text} if $param{text}; 1556 $data->{text_color} = $textcol if $textcol; 1557 $data->{text_editable} = $editable if exists $param{text_editable}; 1558 1559 my $result = $self->api_json_request( 1560 api => API_FLAIRTEMPLATE2, 1561 args => [$sub], 1562 data => $data, 1563 ); 1564 return $result; 1565} 1566 1567#============================================================================== 1568# Subreddit management 1569#============================================================================== 1570 1571sub get_wiki { 1572 my ($self, %param) = @_; 1573 my $page = $param{page} || croak "Need 'page'"; 1574 my $sub = $param{sub} || $param{subreddit} || die "need subreddit\n"; 1575 1576 my $data = {}; 1577 $data->{v} = $param{v} if $param{v}; 1578 $data->{v2} = $param{v2} if $param{v2}; 1579 1580 1581 my $result = $self->api_json_request( 1582 api => API_GETWIKI, 1583 args => [$sub, $page], 1584 data => $data, 1585 ); 1586 return $param{data} ? $result->{data} : $result->{data}->{content_md}; 1587} 1588sub get_wiki_data { 1589 my ($self, %param) = @_; 1590 $param{data} = 1; 1591 return $self->get_wiki(%param); 1592} 1593 1594sub edit_wiki { 1595 my ($self, %param) = @_; 1596 my $page = $param{page} || croak "Need 'page'"; 1597 my $content = defined $param{content} ? $param{content} : croak "Need 'content'"; 1598 # Reddit maximum length is 524,288 1599 if (length $content > 524288) { croak "Maximum length for 'content' is 524288 bytes."; } 1600 my $sub = $param{sub} || $param{subreddit} || croak "Need 'sub' or 'subreddit'"; 1601 my $previous = $param{previous}; 1602 my $reason = $param{reason}; 1603 1604 my $data = {}; 1605 $data->{page} = $page; 1606 $data->{content}= $content; 1607 if ($previous) { $data->{previous} = $previous; } 1608 if ($reason) { $data->{reason} = substr $reason, 0, 256; } 1609 1610 my $result = $self->api_json_request( 1611 api => API_EDITWIKI, 1612 args => [$sub], 1613 data => $data, 1614 ); 1615 1616 return $result; 1617} 1618 1619#=============================================================================== 1620# Comments 1621#=============================================================================== 1622sub get_comments { 1623 my ($self, %param) = @_; 1624 my $permalink; 1625 my $sub = $param{sub} || $param{subreddit}; 1626 1627 if ($param{permalink}) { 1628 $permalink = $param{permalink}; 1629 } elsif ($sub and $param{comment_id} and $param{link_id}) { 1630 my $id = id($param{link_id}); 1631 my $cmtid = id($param{comment_id}); 1632 $permalink = "/r/$sub/comments/$id//$cmtid"; 1633 } elsif ($sub and $param{id}) { 1634 my $id = id($param{id}); 1635 $permalink = "/r/$sub/comments/$id"; 1636 } elsif ($param{url}) { 1637 $permalink = $param{url}; 1638 $permalink =~ s/^https?:\/\/([a-zA-Z]{1,3}\.)?reddit\.com//i; 1639 } else { 1640 die "get_comments: Either 'permalink' OR 'url' OR 'subreddit' and 'link_id' OR 'subreddit' and 'link_id' and 'comment_id' are required.\n"; 1641 } 1642 1643 my $result = $self->json_request('GET', $permalink); 1644 my $link_id = $result->[0]{data}{children}[0]{data}{name}; 1645 # result->[0] is a listing with 1 element, the link, even if you requested a cmt 1646 my $comments = $result->[1]{data}{children}; 1647 1648 my $return = []; 1649 for my $cmt (@$comments) { 1650 if ($cmt->{kind} eq 't1') { 1651 push @$return, Reddit::Client::Comment->new($self, $cmt->{data}); 1652 } elsif ($cmt->{kind} eq 'more') { 1653 my $more = Reddit::Client::MoreComments->new($self, $cmt->{data}); 1654 $more->{link_id} = $link_id; 1655 push @$return, $more; 1656 } 1657 } 1658 return $return; 1659} 1660# limit_children: get these comments and their descendants 1661sub get_collapsed_comments { 1662 my ($self, %param) = @_; 1663 my $link_id = fullname($param{link_id},'t3') || die "load_more_comments: 'link_id' is required.\n"; 1664 my $children = $param{children} || die "get_collapsed_comments: 'children' is required.\n"; 1665 my $limit = exists $param{limit_children} ? ($param{limit_children} ? 'true' : 'false') : 'false'; 1666 my $ids; 1667 1668 if (ref $children eq 'ARRAY') { 1669 $ids = join ",", @$children; 1670 die "'children' must be non-empty array reference" unless $ids; 1671 } else { 1672 die "get_collapsed_comments: 'children' must be array reference\n"; 1673 } 1674 1675 my $data = { 1676 link_id => $link_id, 1677 children => $ids, 1678 limit_children => $limit, 1679 api_type => 'json', # This is the only GET endpoint that requires 1680 }; # api_type=json to be set. 1681 1682 $data->{sort} = $param{sort} if $param{sort}; 1683 $data->{id} = $param{id} if $param{id}; 1684 1685 my $result = $self->api_json_request( 1686 api => API_MORECHILDREN, 1687 data => $data, 1688 ); 1689 my $comments = $result->{data}->{things}; 1690 1691 my $return = []; 1692 for my $cmt (@$comments) { 1693 if ($cmt->{kind} eq 't1') { 1694 push @$return, Reddit::Client::Comment->new($self, $cmt->{data}); 1695 } elsif ($cmt->{kind} eq 'more') { 1696 my $more = Reddit::Client::MoreComments->new($self, $cmt->{data}); 1697 $more->{link_id} = $link_id; 1698 push @$return, $more; 1699 } 1700 } 1701 return $return; 1702} 1703 1704sub submit_comment { 1705 my ($self, %param) = @_; 1706 my $parent_id = $param{parent} || $param{parent_id} || croak 'Expected "parent"'; 1707 my $comment = $param{text} || croak 'Expected "text"'; 1708 # the replies option, it does nothing 1709 #my $replies = exists $param{inbox_replies} ? ($param{inbox_replies} ? "true" : "false") : "true"; 1710 1711 croak '$fullname must be a post or comment' if !ispost($parent_id) && !iscomment($parent_id); 1712 DEBUG('Submit comment under %s', $parent_id); 1713 1714 my $result = $self->api_json_request(api => API_COMMENT, data => { 1715 thing_id => $parent_id, 1716 text => $comment, 1717 #sendreplies=>$replies, 1718 }); 1719 1720 return $result->{data}{things}[0]{data}{name}; 1721} 1722 1723sub comment { 1724 my($self, $parent, $text) = @_; 1725 return $self->submit_comment(parent_id=>$parent, text=>$text); 1726} 1727 1728#=============================================================================== 1729# Private messages 1730#=============================================================================== 1731 1732sub send_message { 1733 my ($self, %param) = @_; 1734 my $to = $param{to} || croak 'Expected "to"'; 1735 my $subject = $param{subject} || croak 'Expected "subject"'; 1736 my $text = $param{text} || croak 'Expected "text"'; 1737 1738 croak '"subject" cannot be longer than 100 characters' if length $subject > 100; 1739 1740 #$self->require_login; 1741 DEBUG('Submit message to %s: %s', $to, $subject); 1742 1743 my $result = $self->api_json_request(api => API_MESSAGE, data => { 1744 to => $to, 1745 subject => $subject, 1746 text => $text, 1747 kind => SUBMIT_MESSAGE, 1748 }); 1749 1750 return $result; 1751} 1752 1753#=============================================================================== 1754# Voting 1755#=============================================================================== 1756 1757sub vote { 1758 my ($self, $name, $direction) = @_; 1759 defined $name || croak 'Expected $name'; 1760 defined $direction || croak 'Expected $direction'; 1761 croak '$fullname must be a post or comment' if !ispost($name) && !iscomment($name); 1762 croak 'Invalid vote direction' unless "$direction" =~ /^(-1|0|1)$/; 1763 DEBUG('Vote %d for %s', $direction, $name); 1764 $self->api_json_request(api => API_VOTE, data => { dir => $direction, id => $name }); 1765} 1766 1767#=============================================================================== 1768# Saving and hiding 1769#=============================================================================== 1770 1771sub save { 1772 my $self = shift; 1773 my $name = shift || croak 'Expected $fullname'; 1774 croak '$fullname must be a post or comment' if !ispost($name) && !iscomment($name); 1775 DEBUG('Save %s', $name); 1776 $self->api_json_request(api => API_SAVE, data => { id => $name }); 1777} 1778 1779sub unsave { 1780 my $self = shift; 1781 my $name = shift || croak 'Expected $fullname'; 1782 croak '$fullname must be a post or comment' if !ispost($name) && !iscomment($name); 1783 DEBUG('Unsave %s', $name); 1784 $self->api_json_request(api => API_UNSAVE, data => { id => $name }); 1785} 1786 1787sub hide { 1788 my $self = shift; 1789 my $name = shift || croak 'Expected $fullname'; 1790 croak '$fullname must be a post' if !ispost($name); 1791 DEBUG('Hide %s', $name); 1792 $self->api_json_request(api => API_HIDE, data => { id => $name }); 1793} 1794 1795sub unhide { 1796 my $self = shift; 1797 my $name = shift || croak 'Expected $fullname'; 1798 croak '$fullname must be a post' if !ispost($name); 1799 DEBUG('Unhide %s', $name); 1800 $self->api_json_request(api => API_UNHIDE, data => { id => $name }); 1801} 1802 1803#============================================================================== 1804# Multireddits 1805#============================================================================== 1806 1807sub edit_multi { 1808 my ($self, %param) = @_; 1809 $param{edit} = 1; 1810 $self->create_multi(%param); 1811} 1812sub create_multi { 1813 my ($self, %param) = @_; 1814 my $data = {}; 1815 my $model = {}; 1816 my $username = $param{username} || $self->{username} || die "'username' is required."; 1817 1818 $model->{display_name} = $param{name} || croak "Expected 'name'."; 1819 if (length($model->{display_name}) > 50) { croak "max length of 'name' is 50."; } 1820 1821 $model->{description_md} = $param{description} if $param{description}; 1822 1823 if ($param{icon_name}) { 1824 $model->{icon_name} = $param{icon_name}; 1825 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'); 1826 my $match = 0; 1827 foreach my $i (@iconnames) { 1828 $match = 1 if $i eq $model->{icon_name}; 1829 } 1830 my $iconstr = join ", ", @iconnames; 1831 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."; } 1832 } 1833 1834 if ($param{key_color}) { 1835 $model->{key_color} = "#".$param{key_color}; 1836 if (length($model->{key_color}) != 7) { croak "'key_color' must be a 6-character color code"; } 1837 } 1838 1839 if ($param{visibility}) { 1840 $model->{visibility} = $param{visibility}; 1841 if ($model->{visibility} ne 'private' and 1842 $model->{visibility} ne 'public' and 1843 $model->{visibility} ne 'hidden') { 1844 croak "if provided, 'visibility' must be either 'public', 'private', or 'hidden'."; 1845 } 1846 } 1847 1848 if ($param{weighting_scheme}) { 1849 $model->{weighting_scheme} = $param{weighting_scheme}; 1850 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'"; } 1851 } 1852 1853 if ($param{subreddits} or $param{subs}) { 1854 $param{subreddits} = $param{subs} || $param{subreddits}; 1855 if (ref $param{subreddits} ne 'ARRAY') { croak "'subreddits' must be an array reference."; } 1856 1857 $model->{subreddits} = [ map { { name=> $_ } } @{$param{subreddits}} ]; 1858 #print Dumper($model->{subreddits}); 1859 } 1860 1861 # Put a ribbon on it 1862 $data->{model} = JSON::encode_json($model); 1863 $data->{multipath} = "/user/$username/m/$model->{display_name}"; 1864 1865 my $result = $self->api_json_request( 1866 api => $param{edit} ? API_EDITMULTI : API_CREATEMULTI, 1867 args => [$username, $model->{display_name}], 1868 data => $data, 1869 ); 1870 1871 return $result->{data}; 1872} 1873 1874sub get_multi { 1875 my ($self, %param) = @_; 1876 my $name = $param{name} || croak "expected 'name'"; 1877 my $username= $param{user} || $param{username} || $self->{username} || die "'username' is required.\n"; 1878 my $expand = $param{expand} ? '?expand_srs=true' : ''; 1879 1880 my $result = $self->api_json_request( 1881 api => API_GETMULTI, 1882 args => [$username, $name, $expand], 1883 ); 1884 1885 # The result looks like a Subreddit object, but is not. 1886 # By returning just the data we lose only the 'kind' key, 1887 # which is just the string "LabeledMulti" 1888 return $result->{data}; 1889} 1890 1891sub delete_multi { 1892 my $self = shift; 1893 my $name = shift || croak "expected arg 1 (name)"; 1894 1895 my $result = $self->api_json_request( 1896 api => API_DELETEMULTI, 1897 args => [$self->{username}, $name], 1898 ); 1899 return $result->{data}; 1900} 1901#============================================================================== 1902# Misc 1903#============================================================================== 1904sub get_origin { 1905 my $self = shift; 1906 return "https://$self->{subdomain}.reddit.com"; 1907} 1908 1909#============================================================================== 1910# Internal and static 1911#============================================================================== 1912 1913# Strip the type portion of a filname (i.e. t3_), if it exists 1914sub id { 1915 my $id = shift; 1916 $id =~ s/^t\d_//; 1917 return $id; 1918} 1919# accept id or fullname, always return fullname 1920sub fullname { 1921 my $id = shift || return; 1922 my $type = shift || die "fullname: 'type' is required"; 1923 $id = $type."_".$id if substr($id, 0, 3) ne $type."_"; 1924 return $id; 1925} 1926 1927sub ispost { 1928 my $name = shift; 1929 #my ($self, $name) = @_; 1930 my $type = substr $name, 0, 2; 1931 return $type eq 't3'; 1932} 1933 1934sub iscomment { 1935 my $name = shift; 1936 #my ($self, $name) = @_; 1937 my $type = substr($name, 0, 2); 1938 return $type eq 't1'; 1939} 1940sub get_type { 1941 my $name = shift; 1942 return lc substr($name, 0, 2) if $name; 1943} 1944sub DEBUG { 1945 if ($DEBUG) { 1946 my ($format, @args) = @_; 1947 my $ts = strftime "%Y-%m-%d %H:%M:%S", localtime; 1948 my $msg = sprintf $format, @args; 1949 chomp $msg; 1950 printf STDERR "[%s] [ %s ]\n", $ts, $msg; 1951 } 1952} 1953 1954sub subreddit { 1955 my $subject = shift; 1956 $subject =~ s/^\/r//; # trim leading /r 1957 $subject =~ s/^\///; # trim leading slashes 1958 $subject =~ s/\/$//; # trim trailing slashes 1959 1960 if ($subject !~ /\//) { # no slashes in name - it's probably good 1961 if ($subject eq '') { # front page 1962 return ''; 1963 } else { # subreddit 1964 return $subject; 1965 } 1966 } else { # fail 1967 return; 1968 } 1969} 1970 19711; 1972 1973__END__ 1974 1975=pod 1976 1977=head1 NAME 1978 1979Reddit::Client - A Perl wrapper for the Reddit API. 1980 1981=head1 DESCRIPTION 1982 1983Reddit::Client handles Oauth session management and HTTP communication with Reddit's external API. For more information about the Reddit API, see L<https://github.com/reddit/reddit/wiki/API>. 1984 1985=head1 EXAMPLE 1986 1987 use Reddit::Client; 1988 1989 # Create a Reddit::Client object and authorize: "script"-type app 1990 my $reddit = new Reddit::Client( 1991 user_agent => "Test script 1.0 by /u/myusername", 1992 client_id => "client_id_string", 1993 secret => "secret_string", 1994 username => "reddit_username", 1995 password => "reddit_password", 1996 ); 1997 1998 # Create a Reddit::Client object and authorize: "web"-type app 1999 # Authorization can also be done separately with get_token() 2000 my $reddit = new Reddit::Client( 2001 user_agent => "Test script 1.0 by /u/myusername", 2002 client_id => "client_id_string", 2003 secret => "secret_string", 2004 refresh_token => "refresh_token", 2005 ); 2006 2007 # Check your inbox 2008 my $me = $reddit->me(); 2009 print "You've got mail!" if $me->{has_mail}; 2010 2011 # Submit a link 2012 $reddit->submit_link( 2013 subreddit => "test", 2014 title => "Change is bad, use Perl", 2015 url => "http://www.perl.org", 2016 ); 2017 2018 # Get posts from a subreddit or multi 2019 my $posts = $reddit->get_links(subreddit=>'test', limit=>5); 2020 2021 for my $post (@$posts) { 2022 print $post->{is_self} ? $post->{selftext} : $post->{url}; 2023 print $post->get_web_url(); 2024 2025 if ($post->{title} =~ /some phrase/) { 2026 $post->reply("hi, I'm a bot, oops I'm banned already, harsh"); 2027 } 2028 } 2029 2030=head1 OAUTH 2031 2032Reddit::Client uses Oauth to communicate with Reddit. To get Oauth keys, visit your apps page on Reddit, located at L<https://www.reddit.com/prefs/apps>, and create an app. There are three types of apps available. Reddit::Client supports "script" and "web" type apps. 2033 2034=over 2035 2036=item Script apps 2037 2038Most new users will want a "script"-type app. This is an app intended for personal use that uses a username and password to authenticate. The I<description> and I<about url> fields can be empty, and the I<redirect URI> can be any valid URL (script apps don't use them). Once created, you can give other users permission to use it by adding them in the "add developer" field. Each account uses its own username and password to authenticate. 2039 2040Use the app's client id and secret along with your username and password to create a L<new|https://metacpan.org/pod/Reddit::Client#new> Reddit::Client object. 2041 2042=item Web apps 2043 2044As of v1.20, Reddit::Client also supports "web" apps. These are apps that can take actions on behalf of any user that grants them permission. (This uses the familiar "SomeRedditApp wants your permission to..." screen.) 2045 2046While they are fully supported, there is not yet a setup guide, so getting one running is left as an exercise for the reader. You will need a web server, which you will use to direct users to Reddit's authorization page, where the user will be asked to grant the app permissions. Reddit's authorization page will then redirect the user back to the app's redirect URI. This process generates a refresh token, which is a unique string that your app will use to authenticate instead of a username and password. You will probably want to store refresh tokens locally, otherwise you will have to get permission from the user every time the app runs. 2047 2048Documentation for the web app flow can be found at L<https://github.com/reddit-archive/reddit/wiki/OAuth2>. 2049 2050=back 2051 2052=head1 V1 vs. V2 2053 2054v1 is "old" Reddit (the one you see if you use the subdomain old.reddit.com), v2 new (the one you see with new.reddit.com). Reddit's API has some endpoints that are for one or the other. This guide has labeled most of the v2 functions as such, but some may be missing. (Both labels and functions. Or rather: some functions are definitely missing, and some labels I<may> be missing.) 2055 2056When in doubt, use v2. It's usually the same as v1 but with more options, like flair, which can have extra colors and styles in New Reddit. 2057 2058=head1 TERMINOLOGY 2059 2060Reddit's API is slightly inconsistent in its naming. To avoid confusion, this guide will always use the following terms in the following ways: 2061 2062=over 2063 2064=item id 2065 2066A thing's short ID without prefix. Example: 3npkj4. Seen in your address bar when viewing, for example, a post or comment. 2067 2068=item fullname 2069 2070A thing's complete ID with prefix. Example: t1_3npkj4. When Reddit returns data, the fullname is usually found in the "name" field. The type of thing can be determined by the prefix; for example, t1 for comments and t3 for links. 2071 2072=back 2073 2074=head1 LISTINGS 2075 2076Methods that return listings can accept several optional parameters: 2077 2078=over 2079 2080C<limit>: Integer. How many things to return. Default 25, maximum 100. If I<limit> is present but false, this is interpreted as "no limit" and the maximum is returned. 2081 2082C<before>: Fullname. Return results that occur before I<fullname> in the listing. 2083 2084C<after>: Fullname. Return results that occur after I<fullname> in the listing. 2085 2086C<count>: Integer. Appears to be used by the Reddit website to number listings after the first page. Listings returned by the API are not numbered, so it does not seem to have a use in the API. 2087 2088C<only>: The string "links" or "comments". Return only links or only comments. Only relevant to listings that could contain both. 2089 2090C<show_all>: Boolean. Return items that would have been omitted, for example posts you have hidden, or have reported, or are hidden from you because you are using the option to hide posts after you've upvoted/downvoted them. Default false. 2091 2092=back 2093 2094Note that 'before' and 'after' mean before and after I<in the listing>, not necessarily in time. It's best to think of Reddit as a database where new lines are constantly inserted at the top, because that's basically what it is. 2095 2096=head1 MISC 2097 2098All functions that take the parameter C<subreddit> also accept the alias C<sub>. I<Most> functions that take the parameter C<username> also take the alias C<user> (planned to be all soon). 2099 2100This guide indicates optional arguments with brackets ([]), a convention we borrowed from from PHP's online manual. This creates some slight overlap with Perl's brackets (which are used to indicate an anonymous array reference), however which of the two is intended should be clear from the context. 2101 2102=head1 METHODS 2103 2104=over 2105 2106=item add_approved_user 2107 2108 add_approved_user ( sub => $subreddit, user => $username ) 2109 2110Add an approved user to a subreddit (moderator action). 2111 2112=item approve 2113 2114 approve ( $fullname ) 2115 2116Approve a comment or post (moderator action). 2117 2118=item ban 2119 2120 ban ( username => $username, subreddit => $subreddit, 2121 [ duration => $duration, ] [ ban_message => $message, ] [ reason => $reason, ] [ note => $note ] ) 2122 2123Ban a user from a subreddit. C<username> and C<subreddit> are required. Optional arguments include: 2124 2125=over 2126 2127C<duration>: Duration in days. Range 1-999. If false or not provided, the ban is indefinite. 2128 2129C<ban_message>: The message sent to the banned user. Markdown is allowed. 2130 2131C<reason>: A short ban reason, 100 characters max. On the website ban page, this in equivalent to the ban reason you would select from the dropdown menu. (For example, "Spam".) It is arbitrary: it doesn't have to match up with the reasons from the menu and can be blank. Only visible to moderators. 2132 2133C<note>: An optional note, 300 characters max. Only visible to moderators. Will be concatenated to the `reason` on the subreddit's ban page. 2134 2135=back 2136 2137A ban will overwrite any existing ban for that user. For example, to change the duration, you can call C<ban()> again with a new duration. 2138 2139=item comment 2140 2141 comment ( $fullname, $text ) 2142 2143Make a comment under C<$fullname>, which must be either a post or a comment. Return the fullname of the new comment. 2144 2145This function is an alias for C<submit_comment>, and is equivalent to 2146 2147 submit_comment ( parent_id => $fullname, text => $text ) 2148 2149=item create_multi 2150 2151 create_multi ( name => $multi_name, 2152 [ description => $description, ] [ visibility => $visibility, ] [ subreddits => [ subreddits ], ] 2153 [ icon_name => $icon_name, ] [ key_color => $hex_code, ] [ weighting_scheme => $weighting_scheme, ] 2154 [ username => $username, ] ) 2155 2156Create a multireddit. The only required argument is the name. A multi can also be created with C<edit_multi>, the only difference being that C<create_multi> will fail with a HTTP 409 error if a multi with that name already exists. As of March 2019, trying to add a banned sub to a multi will fail with a 403 Unauthorized. 2157 2158Requires a username, which script apps have by default, but if you're using a web app, you'll need to either pass it in explicitly, or set the username property on your Reddit::Client object. 2159 2160Returns a hash of information about the newly created multireddit. 2161 2162=over 2163 2164C<name> The name of the multireddit. Maximum 50 characters. Only letters, numbers and underscores are allowed (and underscores cannot be the first character). Required. 2165 2166C<description> Description of the multi. This can contain markdown. 2167 2168C<visibility> One of 'private', 'public', or 'hidden'. Default 'private'. 2169 2170C<subreddits> or C<subs>: An array reference. 2171 2172=back 2173 2174The remaining arguments don't currently do anything. It seems like at least some of them are intended for future mobile updates. 2175 2176=over 2177 2178C<icon_name>: If provided, must be one of the following values: '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'. 2179 2180C<weighting_scheme>: If provided, must be either 'classic' or 'fresh'. 2181 2182C<key_color>: A 6-character hex code. Defaults to CEE3F8. 2183 2184=back 2185 2186=item delete 2187 2188 delete ( $fullname ) 2189 2190Delete a post or comment. 2191 2192=item delete_multi 2193 2194 delete_multi ( $multireddit_name ) 2195 2196Delete a multireddit. 2197 2198=item distinguish 2199 2200 distinguish ( $fullname, [ sticky => 0, ] [ how => 'yes' ] ) 2201 2202Distinguish a comment or post (moderator action). Options: 2203 2204=over 2205 2206C<sticky> Distinguish and sticky a comment. Only works for top-level comments. 2207 2208C<how> This option should typically be left untouched. Valid values are "yes", "no", "admin", "special". Admin is for Reddit admins only; the rest are unexplained. 2209 2210=back 2211 2212=item edit 2213 2214 edit ( $fullname, $text ) 2215 2216Edit a text post or comment. Unlike on the website, C<$text> can be an empty string. (It can be false but must be defined.) 2217 2218=item edit_multi 2219 2220Edit a multireddit. Will create a new multireddit if one with that name doesn't exist. The arguments are identical to L<create_multi|https://metacpan.org/pod/Reddit::Client#create_multi>. 2221 2222=item edit_wiki 2223 2224 edit_wiki ( subreddit => $subreddit, page => $page, content => $content, 2225 [ previous => $previous_version_id, ] [ reason => $edit_reason, ] ) 2226 2227=over 2228 2229C<page> is the page being edited. 2230 2231C<content> is the new page content. Can be empty but must be defined. Maximum 524,288 characters. 2232 2233C<reason> is the edit reason. Max 256 characters, will be truncated if longer. Optional. 2234 2235C<previous> is the ID of the intended previous version of the page; if provided, that is the version the page will be rolled back to in a rollback. However, there's no way to find out what this should be from the Reddit website, or currently from Reddit::Client either. Use it only if you know what you're doing. 2236 2237Note that if you are updating your sub's automod (which you can do using the page "config/automoderator"), and it has syntax errors, it will fail with the message "HTTP 415 Unsupported Media Type". 2238 2239=back 2240 2241=item find_subreddits 2242 2243 find_subreddits ( q => $query, [ sort => 'relevance', ] ) 2244 2245Returns a list of Subreddit objects matching the search string C<$query>. Optionally sort them by C<sort>, which can be "relevance" or "activity". 2246 2247=item flair_link 2248 2249 flair_link ( subreddit => $subreddit, link_id => $link_id_or_fullname, 2250 [ text => $text, ] [ css_class => $css_class, ] ) 2251 2252Flair a post with arbitrary text and css class. 2253 2254C<text> and C<css_class> are optional. If not provided, they will remove the existing text and/or css class. One advantage of doing this through the API (as opposed to the Reddit website) is that a css class can be applied with no text at all, not even an empty string. This allows you to have automoderator react to a thread or user in ways that are completely invisible to users. 2255 2256=over 2257 2258C<css_class> can be anything; it does not have to match an existing flair template. To select a flair template from the sub's list of flair, use L<select_post_flair|https://metacpan.org/pod/Reddit::Client#select_post_flair>. 2259 2260C<text> will be truncated to 64 characters if longer. 2261 2262=back 2263 2264=item flair_post 2265 2266Alias for flair_link. 2267 2268=item flair_user 2269 2270 flair_user ( username => $username, text => $text, 2271 [ css_class => $css_class, ] [ subreddit => $subreddit ] ) 2272 2273Flair a user with arbitrary text and css class. Behaves exactly as L<flair_post|https://metacpan.org/pod/Reddit::Client#flair_post> except that it is given a username instead of a link ID. To select a flair template from the sub's list of flair, use L<select_user_flair|https://metacpan.org/pod/Reddit::Client#select_user_flair>. 2274 2275=item flairtemplate (v2) 2276 2277 flairtemplate( subreddit => $subreddit, 2278 [ allowable_content => 'all', background_color => $hexcode, flair_template_id => $id, 2279 flair_type => 'LINK_FLAIR', text => $text, text_color => 'dark', text_editable => 1, 2280 max_emojis => 10, mod_only => 0, override_css => $unknown, ] ) 2281 2282Create or edit a v2 flair template. Can be used from the old (v1) interface; the V2 options will simply not be present. 2283 2284Every argument except C<subreddit> is optional. If you supply C<flair_template_id>, it will edit the flair with that id, otherwise it will create a new one. 2285 2286=over 2287 2288C<subreddit>: Required. Accepts alias 'sub'. 2289 2290C<allowable_content>: "all", "emoji", or "text". Default all. 2291 2292C<background_color>: 6 digit hex code, with or without a hash mark. 2293 2294C<flair_template_id> or C<id>: Accepts alias 'id'. 2295 2296C<flair_type>: 'LINK_FLAIR' or 'USER_FLAIR'. Defaults to LINK_FLAIR (this differs from the API, which defaults to URER_FLAIR). 2297 2298C<max_emojis>: An integer from 1 to 10, default 10. 2299 2300C<mod_only>: Whether it can be edited by non-moderators. Default false. 2301 2302C<text>: A string up to 64 characters long. 2303 2304C<text_color>: 'dark' or 'light'. Default dark. To prevent confusion that this option might want an actual color, Reddit::Client will die with an error if given any other value. 2305 2306C<text_editable>: Whether the flair's text is editable. Default true. 2307 2308C<override_css>: This has no documentation and preliminary tests haven't shown it to do anything. In certain cases, Reddit's V2 flair style will override V1 flair CSS, for example when applied by Automod; it may be intended to control this behavior. 2309 2310=back 2311 2312Reddit will return a hash reference with some information about the new or edited flair. The returned keys do not match the input keys in all cases, unfortunately. 2313 2314=item get_collapsed_comments 2315 2316 get_collapsed_comments ( link_id => $link_id, children => $children, 2317 [ limit_children => 0, ] [ sort => $sort, ] ) 2318 2319Expand a list of collapsed comments found in a MoreComments object. Return a flat list of Comment objects. 2320 2321=over 2322 2323C<link_id> is the ID of the link the comments are under. 2324 2325C<children> is a reference to an array containing the comment IDs. 2326 2327If C<limit_children> is true, return only the requested comments, not replies to them. Otherwise return as many replies as possible (possibly resulting in more MoreComments objects down the line). 2328 2329C<sort> is one of 'confidence', 'top', 'new', 'controversial', 'old', 'random', 'qa', 'live'. Default seems to be 'confidence'. 2330 2331=back 2332 2333=item get_comment 2334 2335 get_comment ( $id_or_fullname, [ include_children => 0 ] ) 2336 2337Returns a Comment object for C<$id_or_fullname>. Note that by default, this only includes the comment itself and not replies. This is by Reddit's design; there isn't a way to return a comment and its replies in one request, using only the comment's id. 2338 2339You can get its replies at the same time by setting C<include_children> to a true value, which will cause Reddit::Client to make a second request before getting back to you. 2340 2341=item get_comments 2342 2343 get_comments ( subreddit => $subreddit, link_id => $link_id_or_fullname ) 2344 2345or 2346 2347 get_comments ( subreddit => $subreddit, link_id => $link_id_or_fullname, comment_id => $comment_id_or_fullname ) 2348 2349or 2350 2351 get_comments ( permalink => $permalink ) 2352 2353or 2354 2355 get_comments ( url => $url ) 2356 2357Get the comment tree for the selected subreddit/link_id, subreddit/link_id/comment_id, permalink, or URL. This will be a mix of Comment and MoreComments objects, which are placeholders for collapsed comments. They correspond to the "show more comments" links on the website. 2358 2359If you already have a Link or Comment object, it's best to call its own C<get_comments> method, which takes no arguments and supplies all of the necessary information for you. If you do decide to use this version: 2360 2361=over 2362 2363C<permalink> is the value found in the C<permalink> field of a Link or Comment. It is the URL minus the protocol and hostname, i.e. "/r/subreddit/comments/link_id/optional_title/comment_id". This is somewhat awkward but it's just how Reddit works. It's not intended to be something you contruct yourself; this option is intended for passing in the C<permalink> from an existing Link or Comment. 2364 2365C<url> is a complete URL for a link or comment, i.e. what would be in address bar on the website. 2366 2367C<subreddit>, C<link_id> and C<comment_id> should be self explanatory. It accepts either short IDs or fullnames, and like all functions that take C<subreddit> as an argument, it can be appreviated to C<sub>. 2368 2369=back 2370 2371Internally, all of these options simply create a permalink and pass it on to Reddit's API, because that is the only argument that this endpoint accepts. 2372 2373=item get_flair_options 2374 2375 get_flair_options( subreddit => $subreddit, link_id => $link_id_or_fullname ) 2376 2377 get_flair_options( subreddit => $subreddit, username => $username ) 2378 2379Get a subreddit's V1 (old Reddit) flair options. (To get the V2 list, which includes values like background color and text color, use L<get_link_flair_options|https://metacpan.org/pod/Reddit::Client#get_link_flair_options>.) 2380 2381Return some flair options for either the post or the user provided. Returns a hash containing two keys: 2382 2383=over 2384 2385C<choices> is an array of hash references containing the flair options. Most important is C<flair_template_id>, which is used to set the flair of a post or user with set_post_flair or set_user_flair. C<flair_text> contains the text of the flair. 2386 2387C<current> is a hash of the post or user's existing flair. 2388 2389=back 2390 2391=item get_inbox 2392 2393 get_inbox ( [ view => MESSAGES_INBOX ] ) 2394 2395Returns a listing of Message objects, where C<view> is one of the MESSAGE L<constants|https://metacpan.org/pod/Reddit::Client#CONSTANTS>. All arguments are optional. If all are omitted your default inbox will be returned-- what you would see if you went to reddit.com and clicked the mailbox icon. 2396 2397Checking your inbox via the API doesn't mark it as read. To do that you'll need to call C<mark_inbox_read>. 2398 2399=item get_link 2400 2401 get_link ( $id_or_fullname ) 2402 2403Returns a Link object for C<$id_or_fullname>. 2404 2405=item get_link_flair_options (v2) 2406 2407 get_link_flair_options ( $subreddit ) 2408 2409Get a list of the subreddit's link flairs. Uses the V2 endpoint, which includes values like background color and text color. (The V1 endpoint is still available through get_link_flair_options_v1, however its return values are a subset of the V2 options so there is not much reason to use it.) 2410 2411=item get_links 2412 2413 get_links ( [ subreddit => undef, ] [ view => VIEW_DEFAULT, ] ) 2414 2415Returns a listing of Link objects. All arguments are optional. 2416 2417C<subreddit> can be a subreddit or multi (ex: "pics+funny"). If omitted, results from the user's front page will be returned-- i.e. what you would see if you visited reddit.com as that user. 2418 2419C<fetch_links()> is an alias for C<get_links()>. 2420 2421=item get_links_by_id 2422 2423 get_links_by_id ( @ids_or_fullnames ) 2424 2425Return an array of Link objects. 2426 2427=item get_modlinks 2428 2429 get_modlinks ( [ subreddit => 'mod', ] [ mode => 'modqueue' ] ) 2430 2431Return links related to subreddit moderation. C<subreddit> defaults to 'mod', which is subreddits you moderate. C<mode> can be one of 5 values: reports, spam, modqueue, unmoderated, and edited. It defaults to 'modqueue'. Using both defaults will get you the same result as clicking the "modqueue" link that RES places in the upper left of the page, or /r/mod/about/modqueue. 2432 2433Here is an explanation of the C<mode> options from the API site: 2434 2435=over 2436 2437reports: Things that have been reported. 2438 2439spam: Things that have been marked as spam or otherwise removed. 2440 2441modqueue: Things requiring moderator review, such as reported things and items caught by the spam filter. Default. 2442 2443unmoderated: Things that have yet to be approved/removed by a mod. 2444 2445edited: Things that have been edited recently. 2446 2447=back 2448 2449C<num_reports> contains the total number of reports. Reports themselves can be found in the C<mod_reports> and C<user_reports> properties. These are arrays of arrays, i.e. 2450 2451 [ [ "Spam", 3 ], [ "report #2", 1 ] ] # user_reports 2452 [ [ "mod report", "moderator_name" ] ] # mod_reports 2453 2454The number with C<user_reports> is the number of times that particular report has been sent. This is mainly for duplicates that users have selected from the menu, for example "Spam". 2455 2456=item get_modqueue 2457 2458 get_modqueue ( [ subreddit => 'mod' ] ) 2459 2460Get the modqueue, i.e. the listing of links and comments you get by visiting /r/mod/about/modqueue. Optionally supply a subreddit. Defaults to 'mod', which is all subreddits you moderate. Identical to calling C<get_modlinks (subreddit => 'mod', mode => 'modqueue')>. 2461 2462=item get_multi 2463 2464 get_multi ( name => $multi_name, 2465 [ user => $username, ] [ expand => 0, ] ) 2466 2467Get a hash of information about a multireddit. C<$username> defaults to your username. 2468 2469If C<expand> is true, returns more detailed information about the subreddits in the multi. This can be quite a bit of information, comparable to the amount of information contained in a Subreddit object, however it's not I<exactly> the same, and if you try to create a Subreddit object out of it you'll fail. 2470 2471=item get_permalink 2472 2473 get_permalink ( $comment_id, $post_id ) 2474 2475Returns a permalink for C<$comment_id>. B<If you already have a Comment object, use its C<get_permalink()> function instead>. This version causes an extra request because it has to ask Reddit for the parent post's URL first, while a Comment object already has that information. It's provided for backwards compatibility, and for the rare case when you may have a comment's ID but not a comment object (perhaps you have a list of IDs stored in a database). It may be deprecated in the future. 2476 2477C<$comment_id> and C<$post_id> can be either fullnames or short IDs. 2478 2479=item get_refresh_token 2480 2481 Reddit::Client->get_refresh_token ( $code, $redirect_uri, $client_id, $secret, $user_agent ) 2482 2483Get a permanent refresh token for use in "web" apps. All arguments are required*. Returns the refresh token. 2484 2485This is best called in static context, just as it's written above, rather than by instantiating an RC object first. The reason is that it's completely separate from every other program flow and you only create extra work for yourself by using an existing RC object. If you choose to use an existing RC object, you'll need to create it and then call C<get_token> with your new refresh_token as a parameter. (C<client_id> and C<secret> will need to be passed in either on object creation or when calling get_token.) 2486 2487C<code> is the one-time use code returned by Reddit after a user authorizes your app. For an explanation of that and C<redirect_uri>, see the token retrieval code flow: L<https://github.com/reddit-archive/reddit/wiki/OAuth2#token-retrieval-code-flow>. 2488 2489=item get_subreddit_comments 2490 2491 get_subreddit_comments ( [ subreddit => '', ] ) 2492 2493Returns a list of Comment objects from a subreddit or multi. If subreddit is omitted the account's "front page" subreddits are returned (i.e. what you see when you visit reddit.com and are logged in). 2494 2495=item get_subreddit_info 2496 2497 get_subreddit_info ( $subreddit ) 2498 2499Returns a hash of information about subreddit C<$subreddit>. 2500 2501=item get_token 2502 2503 get_token ( client_id => $client_id, secret => $secret, username => $username, password => $password ) 2504 2505or 2506 2507 get_token ( client_id => $client_id, secret => $secret, refresh_token => $refresh_token ) 2508 2509or 2510 2511 get_token 2512 2513Get an authentication token from Reddit. Normally a user has no reason to call this function themselves. If you pass in your authentication info when creating a new Reddit::Client onject, C<get_token> will be called automatically using the information provided. If your script runs continuously for more than an hour, a new token will be obtained automatically. C<get_token> is exposed in case you need to refresh your authorization token manually for some reason, for example if you want to switch to a different user within the same Reddit::Client instance. 2514 2515If any arguments are provided, all of the appropriate arguments are required. If none are provided, it will use the information from the previous call. 2516 2517=item get_user 2518 2519 get_user ( user => $username, [ view => USER_OVERVIEW, ] ) 2520 2521Get information about a user, where C<view> is one of the user L<constants|https://metacpan.org/pod/Reddit::Client#CONSTANTS>: overview, comments, submitted, gilded, upvoted, downvoted, hidden, saved, or about. Defaults to 'overview', which shows the user's most recent comments and posts. 2522 2523The result will be a listing of Links and/or Comments, except in the 'about' view, in which case it will be a single Account object. 2524 2525=item get_user_flair_options (v2) 2526 2527 get_user_flair_options ( $subreddit ) 2528 2529Get a list of the subreddit's user flairs. Uses the V2 endpoint, which includes values like background color and text color. (The V1 endpoint is still available through get_user_flair_options_v1, however its return values are a subset of the V2 options so there is not much reason to use it.) 2530 2531=item get_wiki 2532 2533 get_wiki ( sub => $subreddit, page => $page, 2534 [ data => 0, ] [ v => $version, ] [ v2 => $diff_version ] ) 2535 2536Get the content of a wiki page. If C<data> is true, fetch the full data hash for the page. If C<v> is given, show the wiki page as it was at that version. If both C<v> and C<v2> are given, show a diff of the two. 2537 2538=item get_wiki_data 2539 2540 get_wiki_data ( sub => $subreddit, page => $page, 2541 [ v => $version, ] [ v2 => $diff_version ] ) 2542 2543Get a data hash for wiki page I<$page>. This function is the same as calling C<get_wiki> with C<data=>1>. 2544 2545=item has_token 2546 2547 has_token() 2548 2549Return true if a valid Oauth token exists. 2550 2551=item hide 2552 2553 hide ( $fullname ) 2554 2555Hide a post. 2556 2557=item ignore_reports 2558 2559 ignore_reports ( $fullname ) 2560 2561Ignore reports for a comment or post (moderator action). 2562 2563=item info 2564 2565 info ( $fullname ) 2566 2567Returns a hash of information about C<$fullname>. This will be the raw information hash from Reddit, not loaded into an object of the appropriate class (because classes don't exist for every type of thing, and because Reddit periodically updates the API, creating new fields, so it's nice to have a way to look at the raw data it's returning). C<$fullname> can be any of the 8 types of thing. 2568 2569=item list_subreddits 2570 2571 list_subreddits ( [ view => SUBREDDITS_HOME ] ) 2572 2573Returns a list of subreddits, where C<view> is one of the subreddit L<constants|https://metacpan.org/pod/Reddit::Client#CONSTANTS>: '' (i.e. home), 'subscriber', 'popular', 'new', 'contributor', or 'moderator'. Note that as of January 2018 some views, such as the default, are limited to 5,000 results. 'new' still gives infinite results (i.e. a list of all subreddits in existence). Others are untested. 2574 2575=item lock 2576 2577 lock ( $fullname, [ lock => 1 ] ) 2578 2579Lock a post's comment section or individual comment (moderator action). 2580 2581Using optional argument C<lock =E<gt> 0> is the same as calling L<unlock|https://metacpan.org/pod/Reddit::Client#unlock> on the fullname. 2582 2583=item mark_inbox_read 2584 2585 mark_inbox_read() 2586 2587Mark everything in your inbox as read. May take some time to complete. 2588 2589=item me 2590 2591 me() 2592 2593Return an Account object that contains information about the logged in account. Aside from static account information it contains the C<has_mail> property, which will be true if there is anything in your inbox. 2594 2595=item mute 2596 2597 mute ( username => $username, subreddit => $subreddit, [ note => $note ] ) 2598 2599Mute a user (moderator action). Optionally leave a note that only moderators can see. 2600 2601=item new 2602 2603 new ( user_agent => $user_agent, 2604 [ client_id => $client_id, secret => $secret, username => $username, password => $password, ] 2605 [ print_request_errors => 0, ] [ print_response => 0, ] [ print_request => 0, ] [ print_request_on_error => 0 ] 2606 [ subdomain => 'www', ] ) 2607 2608or 2609 2610 new ( user_agent => $user_agent, 2611 [ client_id => $client_id, secret => $secret, refresh_token => $refresh_token ] 2612 [ print_request_errors => 0, ] [ print_response => 0, ] [ print_request => 0, ] [ print_request_on_error => 0 ] 2613 [ subdomain => 'www', ] [ username => $username ] ) 2614 2615Instantiate a new Reddit::Client object. Optionally authenticate at the same time. (Unless you have some reason not to, this is the recommended way to do it.) For "script"-type apps, this is done by passing in a username, password, client_id and secret. For "web"-type apps, this is done by passing in a refresh_token, client_id and secret. 2616 2617C<user_agent> is a string that uniquely identifies your app. The L<API rules|https://github.com/reddit/reddit/wiki/API#rules> say it should be "something unique and descriptive, including the target platform, a unique application identifier, a version string, and your username as contact information". It also includes this warning: "NEVER lie about your user-agent. This includes spoofing popular browsers and spoofing other bots. We will ban liars with extreme prejudice." C<user_agent> is required as of version 1.2 (before, Reddit::Client would provide one if you didn't). 2618 2619C<subdomain> is the subdomain in links generated by Reddit::Client (for example with C<get_web_url>). You can use this to generate links to old.reddit.com to force the old version of Reddit, for example, or new.reddit.com for the new. Default www. 2620 2621C<username> is optional for web apps. Unlike a script app, at no point does a web app know your username unless you explicitly provide it. This means that if you're using a function that requires a username (L<create_multi|https://metacpan.org/pod/Reddit::Client#create_multi> and L<edit_multi|https://metacpan.org/pod/Reddit::Client#edit_multi> are two), and you haven't either passed it into the function directly or set the property in your Reddit::Client object, it will fail. 2622 2623B<Error handling> 2624 2625By default, if there is an error, Reddit::Client will print the HTTP status line and then die. You can change this behavior with the following variables: 2626 2627=over 2628 2629C<print_request_errors>: If there was an error, print some information about it before dying. 2630 2631Reddit will usually return some JSON in the case of an error. If it has, Reddit::Client will add some of its own information to it, encode it all to a JSON string, print it, and die. It will contain the keys C<code>, C<status_line>, C<error> (which will always be 1), and C<data>, which will contain Reddit's JSON data. The fields in Reddit's return JSON are unpredictable and vary from endpoint to endpoint. 2632 2633Sometimes Reddit will not return valid JSON; for example, if the request fails because Reddit's CDN was unable to reach their servers, you'll get a complete webpage (which is actually the same page you would see if you'd attempted the request with a browser). If Reddit did not return valid JSON for this or some other reason, Reddit::Client will print the HTTP status line and the content portion of the response. 2634 2635C<print_response_content>: Print the content portion of Reddit's HTTP response for every request, whether it succeeded or not. 2636 2637C<print_request>: Print the I<entire> HTTP request and response for every request. 2638 2639C<print_request_on_error>: If there is a request error, print the I<entire> HTTP request and response. 2640 2641=back 2642 2643=item nsfw 2644 2645 nsfw ( $fullname, [ nsfw => 1 ] ) 2646 2647Flag a post as NSFW (moderator action). 2648 2649Using optional argument C<nsfw =E<gt> 0> is the same as calling L<unnsfw|https://metacpan.org/pod/Reddit::Client#unnsfw> on the fullname. 2650 2651=item remove 2652 2653 remove ( $fullname ) 2654 2655Remove a post or comment (moderator action). Link and Comment objects also have their own C<remove> method, which doesn't require a fullname. 2656 2657Note on the mechanics of Reddit: removing is different than flagging as spam, although both have the end result of hiding a thing from view of non-moderators. Flagging as spam also trains the spam filter and will cause further posts from that user to be automatically removed. 2658 2659=item save 2660 2661 save ( $fullname ) 2662 2663Save a post or comment. 2664 2665=item send_message 2666 2667 send_message ( to => $username, subject => $subject, text => $message ) 2668 2669Send a private message to C<$username>. C<$subject> is limited to 100 characters. 2670 2671=item select_flair (v2) 2672 2673 select_flair ( link_id => $id_or_fullname, subreddit => $subreddit, flair_id => $flair_template_id, 2674 [ background_color => 'cccccc', css_class => '', text_color => 'dark', text => '', ] ) 2675 2676 select_flair ( username => $username, subreddit => $subreddit, flair_id => $flair_template_id, 2677 [ background_color => 'cccccc', css_class=> '', text_color => 'dark', text => '', ] ) 2678 2679Select flair for a user or link from among the sub's flair templates. To flair a post without an exising template, use L<flair_post|https://metacpan.org/pod/Reddit::Client#flair_post> (v1 only). 2680 2681=over 2682 2683C<background_color> Hex code, with or without hash mark. Defaults to light grey. 2684 2685C<css_class> The CSS class to be used in the v1 interface. No effect on v2 interface. 2686 2687C<flair_template_id> is acquired via L<get_link_flair_options|https://metacpan.org/pod/Reddit::Client#get_link_flair_options> or L<get_user_flair_options|https://metacpan.org/pod/Reddit::Client#get_user_flair_options>. It can also be copied from the v2 flair interface on the website. C<flair_id> may be used as an alias for C<flair_template_id>. Required. 2688 2689C<link_id> The link to apply flair to. Either it or C<username> is required. 2690 2691C<return_rtjson> all|only|none. "all" saves attributes and returns json (default), "only" only returns json, "none" only saves attributes. 2692 2693C<subreddit> The subreddit. 2694 2695C<text> The flair text. 64 characters max. 2696 2697C<text_color> The text color on the v2 interface. Can be "dark" (default) or "light". To help prevent mistaking this option for an actual color, select_flair will die with an error if given anything else. 2698 2699C<username> Username to apply flair to. Either it or C<link_id> is required. 2700 2701=back 2702 2703 2704 2705 2706=item set_post_flair and select_post_flair 2707 2708Deprecated. Use L<select_flair|https://metacpan.org/pod/Reddit::Client#select_flair> or L<flair_post|https://metacpan.org/pod/Reddit::Client#flair_post>. 2709 2710=item set_user_flairs 2711 2712Deprecated. Use L<select_user_flair|https://metacpan.org/pod/Reddit::Client#select_user_flair> or L<flair_user|https://metacpan.org/pod/Reddit::Client#flair_user>. 2713 2714=item submit_comment 2715 2716 submit_comment ( parent_id => $fullname, text => $text) 2717 2718Submit a comment under C<$fullname>, which must be a post or comment. Returns fullname of the new comment. 2719 2720=item submit_crosspost 2721 2722 submit_crosspost ( subreddit => $subreddit, title => $title, source_id => $fullname, 2723 [ inbox_replies => 1, ] [ repost => 0, ] ) 2724 2725Submit a crosspost. Returns the fullname of the new post. You must be subscribed to or a moderator of the subreddit you are crossposting to, otherwise it will fail with the error message "subreddit not found". (This message seems to be an error itself, or is possibly referring to Reddit's internal logic. For example, when crossposting, maybe Reddit selects the subreddit from your list of subscribed/moderated subreddits, and "subreddit not found" means it can't be found in this list.) 2726 2727C<source_id> is the id or fullname of an existing post. This function is identical to C<submit_link>, but with C<source_id> replacing C<url>. 2728 2729If C<inbox_replies> is defined and is false, disable inbox replies for that post. If C<repost> is true, the link is allowed to be a repost. (Otherwise, if it is a repost, the request will fail with the error "That link has already been submitted".) C<sub> can be used as an alias for C<subreddit>. 2730 2731 2732=item submit_link 2733 2734 submit_link ( subreddit => $subreddit, title => $title, url => $url, 2735 [ inbox_replies => 1, ] [ repost => 0, ] [ nsfw => 1, ] ) 2736 2737Submit a link. Returns the fullname of the new post. 2738 2739If C<inbox_replies> is defined and is false, disable inbox replies for that post. If C<repost> is true, the link is allowed to be a repost. (Otherwise, if it is a repost, the request will fail with the error "That link has already been submitted".) C<sub> can be used as an alias for C<subreddit>. 2740 2741=item submit_text 2742 2743 submit_text ( subreddit => $subreddit, title => $title, text => $text, 2744 [ inbox_replies => 1 ] ) 2745 2746Submit a text post. Returns the fullname of the new post. If C<inbox_replies> is defined and is false, disable inbox replies for that post. 2747 2748=item unban 2749 2750 unban ( username => $username, subreddit => $subreddit ) 2751 2752Un-ban a user (moderator action). 2753 2754=item undistinguish 2755 2756 undistinguish ( $fullname ) 2757 2758Un-distinguish a comment or post (moderator action). 2759 2760=item unhide 2761 2762 unhide ( $fullname ) 2763 2764Unhide a post. 2765 2766=item unlock 2767 2768 unlock ( $fullname ) 2769 2770Unlock a post's comment section or individual comment (moderator action). 2771 2772Equivalent to calling L<lock|https://metacpan.org/pod/Reddit::Client#lock>(C<$fullname>, C<lock=E<gt>0>). 2773 2774=item unmute 2775 2776 unmute ( username => $username, subreddit => $subreddit ) 2777 2778Un-mute a user (moderator action). 2779 2780=item unnsfw 2781 2782 unnsfw ( $fullname ) 2783 2784Remove the NSFW flag from a post (moderator action). Equivalent to calling L<nsfw|https://metacpan.org/pod/Reddit::Client#nsfw>(C<$fullname>, C<nsfw=E<gt>0>). 2785 2786=item unsave 2787 2788 unsave ( $fullname ) 2789 2790Unsave a post or comment. 2791 2792=item version 2793 2794 version() 2795 2796Return the Reddit::Client version. 2797 2798=item vote 2799 2800 vote ( $fullname, $direction ) 2801 2802Vote on a post or comment. C<$direction> can be 1, 0, or -1 (0 to clear votes). 2803 2804=back 2805 2806=head1 CONSTANTS 2807 2808 DEFAULT_LIMIT => 25 2809 2810 VIEW_HOT => '' 2811 VIEW_NEW => 'new' 2812 VIEW_CONTROVERSIAL => 'controversial' 2813 VIEW_TOP => 'top' 2814 VIEW_RISING => 'rising' 2815 VIEW_DEFAULT => VIEW_HOT 2816 2817 VOTE_UP => 1 2818 VOTE_DOWN => -1 2819 VOTE_NONE => 0 2820 2821 SUBMIT_LINK => 'link' 2822 SUBMIT_SELF => 'self' 2823 SUBMIT_MESSAGE => 'message' 2824 SUBMIT_CROSSPOST => 'crosspost' 2825 2826 MESSAGES_INBOX => 'inbox' 2827 MESSAGES_UNREAD => 'unread' 2828 MESSAGES_SENT => 'sent' 2829 MESSAGES_MESSAGES => 'messages' 2830 MESSAGES_COMMENTREPLIES => 'comments' 2831 MESSAGES_POSTREPLIES => 'selfreply' 2832 MESSAGES_MENTIONS => 'mentions' 2833 2834 SUBREDDITS_HOME => '' 2835 SUBREDDITS_MINE => 'subscriber' 2836 SUBREDDITS_POPULAR => 'popular' 2837 SUBREDDITS_NEW => 'new' 2838 SUBREDDITS_CONTRIB => 'contributor' 2839 SUBREDDITS_MOD => 'moderator' 2840 2841 USER_OVERVIEW => 'overview' 2842 USER_COMMENTS => 'comments' 2843 USER_SUBMITTED => 'submitted' 2844 USER_GILDED => 'gilded' 2845 USER_UPVOTED => 'upvoted' 2846 USER_DOWNVOTED => 'downvoted' 2847 USER_HIDDEN => 'hidden' 2848 USER_SAVED => 'saved' 2849 USER_ABOUT => 'about' 2850 2851=head1 CHANGELOG 2852 2853Reddit::Client has tracked changes with comments at the head of the main module for years now, but this is obviously not ideal for users who just want to know what is new. A changelog text file, function, or something more nicely-formatted is planned; for now, this section will have a cut-and-paste of recent changes from the comments. 2854 2855 # 1.374 added nsfw option to submit_link 2856 2857 # 1.373 edit now returns the edited thing's id 2858 # 1.372 2859 # -get_link now gets its links in a proper way, by calling get_links_by_ids and 2860 # taking the first element 2861 # -Link class now has many more keys; should now reflect most or all of the keys 2862 # Reddit returns, minus 'downs' and 'ups' because they are deprecated and can 2863 # cause confusion 2864 2865 2866 # 1.37 01/09/20 2867 # -added select_flair (v2) 2868 # -added flairtemplate, creates or edits a v2 flair template 2869 # -added get_link_flair_options. Gets link flair for a sub. uses v2 endpoint. 2870 # -added get_link_flair_options_v1, which uses the v1 endpoint and is instantly deprecated 2871 # -added get_user_flair_options. Gets link flair for a sub. uses v2 endpoint. 2872 # -added get_user_flair_options_v1, which uses the v1 endpoint and is instantly deprecated 2873 # -select_post_flair is renamed select_flair, now accepts v2 arguments, and can 2874 # accept a username instead to flair a user. See the documentation for description 2875 2876 2877 # 1.36 12/22/19: new functions lock, unlock, nsfw, unnsfw 2878 2879 # 1.352 10/25/19: iscomment, ispost and get_type are now static 2880 # added functions distinguish, undistinguish 2881 2882 # 10/05/19 1.351 delete now returns result 2883 # 10/02/19 1.35 add_approved_user, minor housekeeping 2884 # 1.341 7/30 removed warnings, they're stupid 2885 # 7/30 mute and unmute 2886 # 1.33 7/10 corrected 'edited' to not be boolean 2887 # 5/29 1.32 unban 2888 # 5/3 .315 submit_comment now returns fullname not id 2889 # 4/25 .314 4/8 1.313 2890 # .314 added locked key to Comment, was this a recent Reddit change? 2891 # 1.313 changed the behavior of print_request_errors 2892 # 1.312 requests that fail with print_request_errors as true now die instead of 2893 # croak, which lets you capture the error message 2894 2895=head1 AUTHOR 2896 2897L<mailto:earthtone.rc@gmail.com> 2898 2899=head1 LICENSE 2900 2901BSD license 2902 2903=cut 2904 2905