File Coverage

blib/lib/WebService/Vichan.pm

Criterion	Covered	Total	%
statement	83	88	94.3
branch	22	38	57.8
condition	5	6	83.3
subroutine	18	18	100.0
pod	7	9	77.7
total	135	159	84.9

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.001001';

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__