[webservice-vichan.git] / lib / WebService / Vichan.pm

package WebService::Vichan;

use 5.014000;
use strict;
use warnings;
use parent qw/Exporter/;

use HTTP::Tiny;
use Hash::Inflator;
use JSON::MaybeXS;
use Time::HiRes qw/time sleep/;

our $VERSION = '0.001';

our %cache;
our $last_request = 0;
our $ht = HTTP::Tiny->new(
	agent      => 'WebService-Vichan/'.$VERSION,
	verify_SSL => 1
);

use constant +{
	API_4CHAN => 'https://a.4cdn.org',
	API_8CHAN => 'https://8ch.net',
};

our @EXPORT_OK = qw/API_4CHAN API_8CHAN/;
our %EXPORT_TAGS = ( all => \@EXPORT_OK );

sub new {
	my ($class, $url) = @_;
	bless { url => $url }, $class
}

sub do_request {
	my ($url, $cached_result, $cached_timestamp) = @_;
	my %options;
	if ($cached_timestamp) {
		$options{headers}{'If-Modified-Since'} = $cached_timestamp
	}
	my $time_since_last_request = time - $last_request;
	sleep 1 - $time_since_last_request if $time_since_last_request < 1;
	my $result = $ht->get($url, \%options);
	$last_request = time;
	if ($result->{status} == 304) {
		[$cached_result, $cached_timestamp]
	} elsif (!$result->{success}) {
		my $diestr = sprintf "Error requesting %s: %s\n", $url, $result->{reason};
		die $diestr unless $result->{success};
	} else {
		[$result->{content}, $last_request]
	}
}

sub requestf {
	my ($self, $format, @args) = @_;
	my $what = sprintf $format, @args;
	my $url = $self->{url} . '/' . $what;
	my $result = $cache{$url};
	if (!defined $result) {
		$cache{$url} = do_request $url
	} elsif (time - $result->[1] > 10) {
		$cache{$url} = do_request $url, @$result
	}
	decode_json $cache{$url}->[0]
}

sub boards {
	my ($self) = @_;
	my $result = $self->requestf('boards.json');
	$result = $result->{boards} if ref $result eq 'HASH';
	my @results = map {
		$_->{board} //= $_->{uri};
		Hash::Inflator->new($_)
	  } @$result;
	wantarray ? @results : \@results;
}

sub threads {
	my ($self, $board) = @_;
	$board = $board->{board} if ref $board;
	my $result = $self->requestf('%s/threads.json', $board);
	my @pages = map { Hash::Inflator->new($_) } @$result;
	wantarray ? @pages : \@pages
}

sub threads_flat {
	my @pages = shift->threads(@_);
	my @flat = map { @{$_->{threads}} } @pages;
	wantarray ? @flat : \@flat
}

sub catalog {
	my ($self, $board) = @_;
	$board = $board->{board} if ref $board;
	my $result = $self->requestf('%s/catalog.json', $board);
	my @pages = map { Hash::Inflator->new($_) } @$result;
	wantarray ? @pages : \@pages
}

sub catalog_flat {
	my @pages = shift->catalog(@_);
	my @flat = map { @{$_->{threads}} } @pages;
	wantarray ? @flat : \@flat
}

sub thread {
	my ($self, $board, $threadno, $is_4chan) = @_;
	$board = $board->{board} if ref $board;
	$threadno = $threadno->{no} if ref $threadno;
	$is_4chan //= (index $self->{url}, '4cdn.org') >= 0;
	my $res_or_thread = $is_4chan ? 'thread' : 'res';
	my $result =
	  $self->requestf('%s/%s/%s.json', $board, $res_or_thread, $threadno);
	my @posts = map { Hash::Inflator->new($_) } @{$result->{posts}};
	wantarray ? @posts : \@posts
}

1;
__END__

=encoding utf-8

=head1 NAME

WebService::Vichan - API client for 4chan and vichan-based imageboards

=head1 SYNOPSIS

  use WebService::Vichan qw/:all/;
  my $chan = WebService::Vichan->new(API_4CHAN);

  my @boards = $chan->boards;
  say 'Boards on 4chan: ', join ', ', map { $_->board } @boards;

  my @all_pages_of_wsg = $chan->threads('wsg');
  my @wsg = @{$all_pages_of_wsg[0]->threads};
  say 'IDs of threads on the first page of /wsg/: ', join ', ', map { $_->no } @wsg;

  my @all_threads_of_g = $chan->threads_flat('g');
  my @posts_in_23rd_thread = $chan->thread('g', $all_threads_of_g[22]);
  printf "There are %d posts in the 23rd thread of /g/\n", scalar @posts_in_23rd_thread;
  my $the_post = $posts_in_23rd_thread[1];
  say 'HTML of the 2nd post in the 23rd thread of /g/: ', $the_post->com;

=head1 DESCRIPTION

This is an api client for 4chan.org and imageboards that use vichan
(such as 8ch.net). It offers the following methods:

Note: functions that ordinarily return lists will return arrayrefs if
called in scalar context.

=over

=item WebService::Vichan->B<new>(I<$url>)

Creates a new WebService::Vichan object with the given base URL.

Two constants are exported on request by this module: C<API_4CHAN> and
C<API_8CHAN>, which represent the base URLs for 4chan.org and 8ch.net.

=item $chan->B<boards>

Returns a list of available boards. These are blessed
imageboard-dependent hashrefs which should at least have the methods
C<board> (returning the board code as a string) and C<title>.

=item $chan->B<threads>(I<$board>)

Takes a board object (or a board code as a string) and returns a list
of pages of thread OPs. Each page is a blessed hashref with methods
C<page> (the index of the page) and C<threads> (an arrayref of thread
OPs on that page). Each thread OP is a blessed hashref which has at
least the methods C<no> (the thread number) and C<last_modified>.

=item $chan->B<threads_flat>(I<$board>)

Same as B<threads> but page information is dropped. Returns a list of
thread OPs as described above.

=item $chan->B<catalog>(I<$board>)

Same as B<threads>, but much more information is returned about each
thread OP.

=item $chan->B<catalog_flat>(I<$board>)

Same as B<threads_flat>, but much more information is returned about each thread OP.

=item $chan->B<thread>(I<$board>, I<$threadno>, [I<$is_4chan>])

Takes a board object (or a board code as a string), a thread OP object
(or a thread number) and an optional boolean indicating whether to use
4chan logic for the request (by default 4chan logic is used if the URL
contains C<4cdn.org>).

Returns a post object (blessed hashref) with methods as described in
the API documentation (see links in the SEE ALSO section).

=back

To comply with API usage rules every request is cached for 10 seconds,
and requests are rate-limited to one per second. If a method is called
less than 1 second after a request has happened, it will sleep before
issuing a second request to ensure the rate limitation is followed.

=head1 SEE ALSO

L<https://github.com/4chan/4chan-API>,
L<https://github.com/vichan-devel/vichan-API/>

=head1 AUTHOR

Marius Gavrilescu, E<lt>marius@ieval.roE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2017 by Marius Gavrilescu

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.24.3 or,
at your option, any later version of Perl 5 you may have available.


=cut
Commit	Line	Data
b1833b67 MG	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.001';
	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