lib/WebService/TDWTF.pm

   1 package WebService::TDWTF;
   2
   3 use 5.014000;
   4 use strict;
   5 use warnings;
   6 use parent qw/Exporter/;
   7
   8 use Carp;
   9 use HTTP::Tiny;
  10 use JSON::MaybeXS qw/decode_json/;
  11 use Scalar::Util qw/looks_like_number/;
  12 use WebService::TDWTF::Article;
  13
  14 my @subs = qw/article list_recent list_series list_author series/;
  15 our @EXPORT = map { "tdwtf_$_" } @subs;
  16 our @EXPORT_OK = (@EXPORT, @subs);
  17 our %EXPORT_TAGS = (all => [@EXPORT_OK]);
  18 our $VERSION = '0.002';
  19 our $AGENT = "WebService-TDWTF/$VERSION";
  20 our $BASE_URL = 'http://thedailywtf.com/api';
  21
  22 sub _ht { HTTP::Tiny->new(agent => $AGENT) }
  23
  24 sub _query {
  25         my ($url) = @_;
  26
  27         my $ht = _ht;
  28         my $response = $ht->get($url);
  29         croak $response->{reason} unless $response->{success};
  30         $response = decode_json $response->{content};
  31         croak $response->{Status} if ref $response eq 'HASH' && !exists $response->{BodyHtml};
  32
  33         $response
  34 }
  35
  36 sub _objectify {
  37         my ($response) = @_;
  38
  39         return map { _objectify($_) } @$response if ref $response eq 'ARRAY';
  40         WebService::TDWTF::Article->new($response)
  41 }
  42
  43 sub article {
  44         my ($id_or_slug, $only_body_and_html) = @_;
  45         my $url = "$BASE_URL/articles/";
  46         $url .= @_ == 0 ? 'random' : looks_like_number $id_or_slug ? "/id/$id_or_slug" : "/slug/$id_or_slug";
  47         $url .= '/true' if $only_body_and_html;
  48         _objectify _query $url
  49 }
  50
  51 sub _list {
  52         my $url = join '/', $BASE_URL, @_;
  53         _objectify _query $url
  54 }
  55
  56 sub list_recent { my $url = @_ == 2 ? 'articles' : 'articles/recent'; _list $url, @_ }
  57 sub list_series { _list 'series',   @_ }
  58 sub list_author { _list 'author',   @_ }
  59
  60 sub series { @{_query "$BASE_URL/series/"} }
  61
  62 BEGIN {
  63         *tdwtf_article     = \&article;
  64         *tdwtf_list_recent = \&list_recent;
  65         *tdwtf_list_series = \&list_series;
  66         *tdwtf_list_author = \&list_author;
  67         *tdwtf_series      = \&series;
  68 }
  69
  70 1;
  71 __END__
  72
  73 =encoding utf-8
  74
  75 =head1 NAME
  76
  77 WebService::TDWTF - retrieve articles from thedailywtf.com
  78
  79 =head1 SYNOPSIS
  80
  81   use WebService::TDWTF;
  82   my $random_article = tdwtf_article;
  83   say $random_article->Title;
  84   say $random_article->Body;
  85
  86   my $x = tdwtf_article 8301;
  87   say $x->Title;  # Your Recommended Virus
  88   my $y = tdwtf_article 'your-recommended-virus'; # $x and $y are equivalent
  89
  90   my @recent = tdwtf_list_recent;
  91   say scalar @recent; # 8
  92   @recent = tdwtf_list_recent 10;
  93   say scalar @recent; # 10
  94
  95   my @dec15 = tdwtf_list_recent 2015, 12;
  96   say $dec15[0]->Title; # Best of 2015: The A(nti)-Team
  97   say $dec15[0]->Body;  # (this makes an API call, see NOTES)
  98   say $dec15[0]->Body;  # (this doesn't make an API call)
  99
 100   my @erik = tdwtf_list_author 'erik-gern'; # (most recent 8 articles by Erik Gern)
 101   my @sod  = tdwtf_list_series 'code-sod', 5;  # (most recent 5 CodeSOD articles)
 102
 103   # All Error'd articles published in January 2014
 104   my @jan14_errord = tdwtf_list_series 'errord', 2014, 1;
 105
 106   my @series = series;           # List of all series
 107   my $series = series;           # Number of series ($series == @series)
 108   print $series[0]->Slug;        # alexs-soapbox
 109   print $series[0]->Title;       # Alex's Soapbox
 110   print $series[0]->Description; # <description of this series>
 111   print $series[0]->CssClass;    # tales
 112
 113 =head1 DESCRIPTION
 114
 115 WebService::TDWTF is an interface to the API of L<http://thedailywtf.com>.
 116 Quoting the website's sidebar:
 117
 118     Founded in 2004 by Alex Papadimoulis, The Daily WTF is your
 119     how-not-to guide for developing software. We recount tales of
 120     disastrous development, from project management gone spectacularly
 121     bad to inexplicable coding choices.
 122
 123 This module exports the following functions:
 124
 125 =over
 126
 127 =item B<tdwtf_article>()
 128
 129 =item B<tdwtf_article>(I<$id_or_slug>)
 130
 131 =item B<article>()
 132
 133 =item B<article>(I<$id_or_slug>)
 134
 135 With an argument, returns a L<WebService::TDWTF> object representing
 136 the article with the given ID or slug.
 137
 138 With no arguments, returns a L<WebService::TDWTF> object representing
 139 a random article.
 140
 141 =item B<tdwtf_list_recent>()
 142
 143 =item B<tdwtf_list_recent>(I<$count>)
 144
 145 =item B<tdwtf_list_recent>(I<$year>, I<$month>)
 146
 147 =item B<list_recent>()
 148
 149 =item B<list_recent>(I<$count>)
 150
 151 =item B<list_recent>(I<$year>, I<$month>)
 152
 153 With no arguments, returns the most recent 8 articles.
 154
 155 With one argument, returns the most recent I<$count> articles.
 156 I<$count> is at most 100.
 157
 158 With two arguments, returns all articles published in the given month
 159 of the given year. I<$month> is an integer between 1 and 12.
 160
 161 =item B<tdwtf_list_series>(I<$slug>)
 162
 163 =item B<tdwtf_list_series>(I<$slug>, I<$count>)
 164
 165 =item B<tdwtf_list_series>(I<$slug>, I<$year>, I<$month>)
 166
 167 =item B<list_series>(I<$slug>)
 168
 169 =item B<list_series>(I<$slug>, I<$count>)
 170
 171 =item B<list_series>(I<$slug>, I<$year>, I<$month>)
 172
 173 With no arguments, returns the most recent 8 articles in the given
 174 series.
 175
 176 With one argument, returns the most recent I<$count> articles in the
 177 given series. I<$count> is at most 100.
 178
 179 With two arguments, returns all articles in the given series published
 180 in the given month of the given year. I<$month> is an integer between
 181 1 and 12.
 182
 183 =item B<tdwtf_list_author>(I<$slug>)
 184
 185 =item B<tdwtf_list_author>(I<$slug>, I<$count>)
 186
 187 =item B<tdwtf_list_author>(I<$slug>, I<$year>, I<$month>)
 188
 189 =item B<list_author>(I<$slug>)
 190
 191 =item B<list_author>(I<$slug>, I<$count>)
 192
 193 =item B<list_author>(I<$slug>, I<$year>, I<$month>)
 194
 195 With no arguments, returns the most recent 8 articles by the given
 196 author.
 197
 198 With one argument, returns the most recent I<$count> articles by the
 199 given author. I<$count> is at most 100.
 200
 201 With two arguments, returns all articles by the given author published
 202 in the given month of the given year. I<$month> is an integer between
 203 1 and 12.
 204
 205 =item B<tdwtf_series>
 206
 207 =item B<series>
 208
 209 In list context, returns a list of all existing article series. Each
 210 series is an unblessed hashref with the keys C<Slug>, C<Title>,
 211 C<Description> and C<CssClass>.
 212
 213 In scalar context, returns the number of existing article series.
 214
 215 =back
 216
 217 =head1 NOTES
 218
 219 All functions are exported of the name B<tdwtf_foo> are exported by
 220 default. The unprefixed variants can be exported on request.
 221
 222 The B<tdwtf_list_*> functions return a list of incomplete
 223 L<WebService::TDWTF::Article> objects. These objects contain all of
 224 the fields of a normal object, except for BodyHtml and FooterAdHtml.
 225 For these objects, the B<Body> mehod of L<WebService::TDWTF::Article>
 226 retrieves the BodyHtml and FooterAdHtml fields from the API and saves
 227 them into the object.
 228
 229 All B<tdwtf_list_*> functions return articles in reverse chronological
 230 order. That is, the first element of the list is the most recent article.
 231
 232 =head1 SEE ALSO
 233
 234 L<http://thedailywtf.com/>
 235
 236 L<https://github.com/tdwtf/WtfWebApp/blob/master/Docs/API.md>
 237
 238 =head1 AUTHOR
 239
 240 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
 241
 242 =head1 COPYRIGHT AND LICENSE
 243
 244 Copyright (C) 2016 by Marius Gavrilescu
 245
 246 This library is free software; you can redistribute it and/or modify
 247 it under the same terms as Perl itself, either Perl version 5.20.2 or,
 248 at your option, any later version of Perl 5 you may have available.
 249
 250
 251 =cut