package WWW::Reddit; our $VERSION = '0.10'; use 5.012004; use Data::Dumper; use common::sense; use LWP::Simple; use JSON; use HTTP::Cookies; use LWP::UserAgent; my $base_url = 'http://www.reddit.com/'; my $api_url = $base_url . 'api/'; my $login_url = $api_url . 'login'; my $submit_url = $api_url . 'submit'; my $comment_url = $api_url . 'comment'; my $api_type = 'json'; sub new { my $obj_class = shift; my $class = ref $obj_class || $obj_class; my ($user, $passwd, $subreddit) = @_; my $self = { base_url => $base_url, api_url => $api_url, login_url => $login_url, submit_url => $submit_url, api_type => $api_type, user => $user, passwd => $passwd, subreddit => $subreddit, ua => new LWP::UserAgent, cookie_jar => HTTP::Cookies->new, modhash => '', }; bless $self, $class; $self->create_methods; return $self; } #>-----------------------------------------------<# # Helper Methods #>-----------------------------------------------<# # create accessor/mutator methods for defined parameters sub create_methods { my $self = shift; for my $datum (keys %{$self}) { no strict "refs"; *$datum = sub { my $self = shift; $self->{$datum} = shift if @_; return $self->{$datum}; }; } } # Set cookie sub set_cookie { my $self = shift; my $response = shift; $self->cookie_jar->extract_cookies ($response); $self->ua->cookie_jar ($self->cookie_jar); $self->parse_modhash ($response); } # Set modhash sub parse_modhash { my $self = shift; my $response = shift; my $decoded = from_json ($response->content); $self->modhash ($decoded->{json}{data}{modhash}); } # takes link, returns post ID sub parse_link { my $self = shift; my $link = shift; my ($id) = $link =~ /comments\/(\w+)\//i; return $id; } #>---------------------------------------------------<# # Main Methods #>---------------------------------------------------<# # Login to reddit sub login { my $self = shift; if (@_) { $self->user ($_[0]); $self->passwd ($_[1]); } my $response = $self->ua->post($self->login_url, { api_type => $self->api_type, user => $self->user, passwd => $self->passwd, } ); $self->set_cookie( $response); # print Dumper $response; } # Submit link to reddit sub submit_link { my $self = shift; my ($title, $url, $subreddit) = @_; my $kind = 'link'; my $newpost = $self->ua->post($self->submit_url, { uh => $self->modhash, kind => $kind, sr => $subreddit || $self->subreddit, title => $title, r => $subreddit || $self->subreddit, url => $url, } ); my $json_content = $newpost->content; my $decoded = from_json $json_content; #returns link to new post if successful my $link = $decoded->{jquery}[18][3][0]; my $id = $self->parse_link($link); return $id, $link; } sub submit_story { my $self = shift; my ($title, $text, $subreddit) = @_; my $kind = 'self'; my $newpost = $self->ua->post($self->submit_url, { uh => $self->modhash, kind => $kind, sr => $subreddit || $self->subreddit, r => $subreddit || $self->subreddit, title => $title, text => $text, }, ); my $json_content = $newpost->content; my $decoded = from_json $json_content; #returns id and link to new post if successful my $link = $decoded->{jquery}[12][3][0]; my $id = $self->parse_link($link); return $id, $link; } 1; __END__ =head1 NAME WWW::Reddit - Perl extension for http://www.reddit.com, this module has been obsoleted and replaced by the Reddit module =head1 SYNOPSIS use Reddit; # $username, $password, [$subreddit] $r = Reddit->new('Foo', 'Bar', 'Perl'); # optionally, you may specify $username, $passwd and $subreddit here $r->login; # $title, $url, [$subreddit] # This overrides a subreddit set previously $r->submit_link( 'Test', 'http://example.com', 'NotPerl'); =head1 DESCRIPTION Perl module for interacting with Reddit. This module is still largely inprogress. =head2 Requires common::sense LWP::Simple LWP::UserAgent JSON HTTP::Cookies For Testing: Data::Dumper =head2 EXPORT None. =head1 SEE ALSO https://github.com/reddit/reddit/wiki =head1 AUTHOR Jon A, Einfo[replacewithat]cyberspacelogistics[replacewithdot]comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2011 by jon This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.12.4 or, at your option, any later version of Perl 5 you may have available. =cut