lib/WebService/Vichan.pm

   1 package WebService::Vichan;
   2
   3 use 5.014000;
   4 use strict;
   5 use warnings;
   6 use parent qw/Exporter/;
   7
   8 use HTTP::Tiny;
   9 use Hash::Inflator;
  10 use JSON::MaybeXS;
  11 use Time::HiRes qw/time sleep/;
  12
  13 our $VERSION = '0.001001';
  14
  15 our %cache;
  16 our $last_request = 0;
  17 our $ht = HTTP::Tiny->new(
  18         agent      => 'WebService-Vichan/'.$VERSION,
  19         verify_SSL => 1
  20 );
  21
  22 use constant +{
  23         API_4CHAN => 'https://a.4cdn.org',
  24         API_8CHAN => 'https://8ch.net',
  25 };
  26
  27 our @EXPORT_OK = qw/API_4CHAN API_8CHAN/;
  28 our %EXPORT_TAGS = ( all => \@EXPORT_OK );
  29
  30 sub new {
  31         my ($class, $url) = @_;
  32         bless { url => $url }, $class
  33 }
  34
  35 sub do_request {
  36         my ($url, $cached_result, $cached_timestamp) = @_;
  37         my %options;
  38         if ($cached_timestamp) {
  39                 $options{headers}{'If-Modified-Since'} = $cached_timestamp
  40         }
  41         my $time_since_last_request = time - $last_request;
  42         sleep 1 - $time_since_last_request if $time_since_last_request < 1;
  43         my $result = $ht->get($url, \%options);
  44         $last_request = time;
  45         if ($result->{status} == 304) {
  46                 [$cached_result, $cached_timestamp]
  47         } elsif (!$result->{success}) {
  48                 my $diestr = sprintf "Error requesting %s: %s\n", $url, $result->{reason};
  49                 die $diestr unless $result->{success};
  50         } else {
  51                 [$result->{content}, $last_request]
  52         }
  53 }
  54
  55 sub requestf {
  56         my ($self, $format, @args) = @_;
  57         my $what = sprintf $format, @args;
  58         my $url = $self->{url} . '/' . $what;
  59         my $result = $cache{$url};
  60         if (!defined $result) {
  61                 $cache{$url} = do_request $url
  62         } elsif (time - $result->[1] > 10) {
  63                 $cache{$url} = do_request $url, @$result
  64         }
  65         decode_json $cache{$url}->[0]
  66 }
  67
  68 sub boards {
  69         my ($self) = @_;
  70         my $result = $self->requestf('boards.json');
  71         $result = $result->{boards} if ref $result eq 'HASH';
  72         my @results = map {
  73                 $_->{board} //= $_->{uri};
  74                 Hash::Inflator->new($_)
  75           } @$result;
  76         wantarray ? @results : \@results;
  77 }
  78
  79 sub threads {
  80         my ($self, $board) = @_;
  81         $board = $board->{board} if ref $board;
  82         my $result = $self->requestf('%s/threads.json', $board);
  83         my @pages = map { Hash::Inflator->new($_) } @$result;
  84         wantarray ? @pages : \@pages
  85 }
  86
  87 sub threads_flat {
  88         my @pages = shift->threads(@_);
  89         my @flat = map { @{$_->{threads}} } @pages;
  90         wantarray ? @flat : \@flat
  91 }
  92
  93 sub catalog {
  94         my ($self, $board) = @_;
  95         $board = $board->{board} if ref $board;
  96         my $result = $self->requestf('%s/catalog.json', $board);
  97         my @pages = map { Hash::Inflator->new($_) } @$result;
  98         wantarray ? @pages : \@pages
  99 }
 100
 101 sub catalog_flat {
 102         my @pages = shift->catalog(@_);
 103         my @flat = map { @{$_->{threads}} } @pages;
 104         wantarray ? @flat : \@flat
 105 }
 106
 107 sub thread {
 108         my ($self, $board, $threadno, $is_4chan) = @_;
 109         $board = $board->{board} if ref $board;
 110         $threadno = $threadno->{no} if ref $threadno;
 111         $is_4chan //= (index $self->{url}, '4cdn.org') >= 0;
 112         my $res_or_thread = $is_4chan ? 'thread' : 'res';
 113         my $result =
 114           $self->requestf('%s/%s/%s.json', $board, $res_or_thread, $threadno);
 115         my @posts = map { Hash::Inflator->new($_) } @{$result->{posts}};
 116         wantarray ? @posts : \@posts
 117 }
 118
 119 1;
 120 __END__
 121
 122 =encoding utf-8
 123
 124 =head1 NAME
 125
 126 WebService::Vichan - API client for 4chan and vichan-based imageboards
 127
 128 =head1 SYNOPSIS
 129
 130   use WebService::Vichan qw/:all/;
 131   my $chan = WebService::Vichan->new(API_4CHAN);
 132
 133   my @boards = $chan->boards;
 134   say 'Boards on 4chan: ', join ', ', map { $_->board } @boards;
 135
 136   my @all_pages_of_wsg = $chan->threads('wsg');
 137   my @wsg = @{$all_pages_of_wsg[0]->threads};
 138   say 'IDs of threads on the first page of /wsg/: ', join ', ', map { $_->no } @wsg;
 139
 140   my @all_threads_of_g = $chan->threads_flat('g');
 141   my @posts_in_23rd_thread = $chan->thread('g', $all_threads_of_g[22]);
 142   printf "There are %d posts in the 23rd thread of /g/\n", scalar @posts_in_23rd_thread;
 143   my $the_post = $posts_in_23rd_thread[1];
 144   say 'HTML of the 2nd post in the 23rd thread of /g/: ', $the_post->com;
 145
 146 =head1 DESCRIPTION
 147
 148 This is an api client for 4chan.org and imageboards that use vichan
 149 (such as 8ch.net). It offers the following methods:
 150
 151 Note: functions that ordinarily return lists will return arrayrefs if
 152 called in scalar context.
 153
 154 =over
 155
 156 =item WebService::Vichan->B<new>(I<$url>)
 157
 158 Creates a new WebService::Vichan object with the given base URL.
 159
 160 Two constants are exported on request by this module: C<API_4CHAN> and
 161 C<API_8CHAN>, which represent the base URLs for 4chan.org and 8ch.net.
 162
 163 =item $chan->B<boards>
 164
 165 Returns a list of available boards. These are blessed
 166 imageboard-dependent hashrefs which should at least have the methods
 167 C<board> (returning the board code as a string) and C<title>.
 168
 169 =item $chan->B<threads>(I<$board>)
 170
 171 Takes a board object (or a board code as a string) and returns a list
 172 of pages of thread OPs. Each page is a blessed hashref with methods
 173 C<page> (the index of the page) and C<threads> (an arrayref of thread
 174 OPs on that page). Each thread OP is a blessed hashref which has at
 175 least the methods C<no> (the thread number) and C<last_modified>.
 176
 177 =item $chan->B<threads_flat>(I<$board>)
 178
 179 Same as B<threads> but page information is dropped. Returns a list of
 180 thread OPs as described above.
 181
 182 =item $chan->B<catalog>(I<$board>)
 183
 184 Same as B<threads>, but much more information is returned about each
 185 thread OP.
 186
 187 =item $chan->B<catalog_flat>(I<$board>)
 188
 189 Same as B<threads_flat>, but much more information is returned about each thread OP.
 190
 191 =item $chan->B<thread>(I<$board>, I<$threadno>, [I<$is_4chan>])
 192
 193 Takes a board object (or a board code as a string), a thread OP object
 194 (or a thread number) and an optional boolean indicating whether to use
 195 4chan logic for the request (by default 4chan logic is used if the URL
 196 contains C<4cdn.org>).
 197
 198 Returns a post object (blessed hashref) with methods as described in
 199 the API documentation (see links in the SEE ALSO section).
 200
 201 =back
 202
 203 To comply with API usage rules every request is cached for 10 seconds,
 204 and requests are rate-limited to one per second. If a method is called
 205 less than 1 second after a request has happened, it will sleep before
 206 issuing a second request to ensure the rate limitation is followed.
 207
 208 =head1 SEE ALSO
 209
 210 L<https://github.com/4chan/4chan-API>,
 211 L<https://github.com/vichan-devel/vichan-API/>
 212
 213 =head1 AUTHOR
 214
 215 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
 216
 217 =head1 COPYRIGHT AND LICENSE
 218
 219 Copyright (C) 2017 by Marius Gavrilescu
 220
 221 This library is free software; you can redistribute it and/or modify
 222 it under the same terms as Perl itself, either Perl version 5.24.3 or,
 223 at your option, any later version of Perl 5 you may have available.
 224
 225
 226 =cut