From 54c23de0aec8b304483d67092053f47cdc1cb1ae Mon Sep 17 00:00:00 2001 From: Marius Gavrilescu Date: Sat, 9 Jan 2016 22:45:23 +0200 Subject: [PATCH] Initial commit --- Changes | 4 + MANIFEST | 7 + Makefile.PL | 28 ++++ README | 36 +++++ lib/WebService/TDWTF.pm | 231 ++++++++++++++++++++++++++++++++ lib/WebService/TDWTF/Article.pm | 223 ++++++++++++++++++++++++++++++ t/WebService-TDWTF.t | 36 +++++ 7 files changed, 565 insertions(+) create mode 100644 Changes create mode 100644 MANIFEST create mode 100644 Makefile.PL create mode 100644 README create mode 100644 lib/WebService/TDWTF.pm create mode 100644 lib/WebService/TDWTF/Article.pm create mode 100644 t/WebService-TDWTF.t diff --git a/Changes b/Changes new file mode 100644 index 0000000..27eb14a --- /dev/null +++ b/Changes @@ -0,0 +1,4 @@ +Revision history for Perl extension WebService::TDWTF. + +0.001 2016-01-09T22:45+02:00 + - Initial release diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..3c84217 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,7 @@ +Changes +Makefile.PL +MANIFEST +README +t/WebService-TDWTF.t +lib/WebService/TDWTF.pm +lib/WebService/TDWTF/Article.pm diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..adfd6f7 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,28 @@ +use 5.014000; +use ExtUtils::MakeMaker; + +my $has_tr = $ExtUtils::MakeMaker::VERSION >= 6.64; +my @tr = (($has_tr ? 'TEST_REQUIRES' : 'BUILD_REQUIRES') => { + qw/Test::RequiresInternet 0/, +}); + +WriteMakefile( + NAME => 'WebService::TDWTF', + VERSION_FROM => 'lib/WebService/TDWTF.pm', + ABSTRACT_FROM => 'lib/WebService/TDWTF.pm', + AUTHOR => 'Marius Gavrilescu ', + MIN_PERL_VERSION => '5.14.0', + LICENSE => 'perl', + SIGN => 1, + PREREQ_PM => { + qw/Class::Accessor::Fast 0 + JSON::MaybeXS 0/, + }, + @tr, + META_ADD => { + dynamic_config => 0, + resources => { + repository => 'https://git.ieval.ro/?p=webservice-tdwtf.git', + }, + } +); diff --git a/README b/README new file mode 100644 index 0000000..8093c06 --- /dev/null +++ b/README @@ -0,0 +1,36 @@ +WebService-TDWTF version 0.001 +============================== + +WebService::TDWTF is an interface to the API of L. +Quoting the website's sidebar: + + Founded in 2004 by Alex Papadimoulis, The Daily WTF is your + how-not-to guide for developing software. We recount tales of + disastrous development, from project management gone spectacularly + bad to inexplicable coding choices. + +INSTALLATION + +To install this module type the following: + + perl Makefile.PL + make + make test + make install + +DEPENDENCIES + +This module requires these other modules and libraries: + +* Class::Accessor::Fast +* JSON::MaybeXS + +COPYRIGHT AND LICENCE + +Copyright (C) 2016 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.20.2 or, +at your option, any later version of Perl 5 you may have available. + + diff --git a/lib/WebService/TDWTF.pm b/lib/WebService/TDWTF.pm new file mode 100644 index 0000000..33827e4 --- /dev/null +++ b/lib/WebService/TDWTF.pm @@ -0,0 +1,231 @@ +package WebService::TDWTF; + +use 5.014000; +use strict; +use warnings; +use parent qw/Exporter/; + +use Carp; +use HTTP::Tiny; +use JSON::MaybeXS qw/decode_json/; +use Scalar::Util qw/looks_like_number/; +use WebService::TDWTF::Article; + +my @subs = qw/article list_recent list_series list_author/; +our @EXPORT = map { "tdwtf_$_" } @subs; +our @EXPORT_OK = (@EXPORT, @subs); + +our $VERSION = '0.001'; +our $AGENT = "WebService-TDWTF/$VERSION"; +our $BASE_URL = 'http://thedailywtf.com/api'; + +sub _ht { HTTP::Tiny->new(agent => $AGENT) } + +sub _query { + my ($url) = @_; + + my $ht = _ht; + my $response = $ht->get($url); + croak $response->{reason} unless $response->{success}; + $response = decode_json $response->{content}; + croak $response->{Status} if ref $response eq 'HASH' && !exists $response->{BodyHtml}; + + $response +} + +sub _objectify { + my ($response) = @_; + + return map { _objectify($_) } @$response if ref $response eq 'ARRAY'; + WebService::TDWTF::Article->new($response) +} + +sub article { + my ($id_or_slug, $only_body_and_html) = @_; + my $url = "$BASE_URL/articles/"; + $url .= @_ == 0 ? 'random' : looks_like_number $id_or_slug ? "/id/$id_or_slug" : "/slug/$id_or_slug"; + $url .= '/true' if $only_body_and_html; + _objectify _query $url +} + +sub _list { + my $url = join '/', $BASE_URL, @_; + _objectify _query $url +} + +sub list_recent { my $url = @_ == 2 ? 'articles' : 'articles/recent'; _list $url, @_ } +sub list_series { _list 'series', @_ } +sub list_author { _list 'author', @_ } + +BEGIN { + *tdwtf_article = \&article; + *tdwtf_list_recent = \&list_recent; + *tdwtf_list_series = \&list_series; + *tdwtf_list_author = \&list_author; +} + +1; +__END__ + +=encoding utf-8 + +=head1 NAME + +WebService::TDWTF - retreive articles from thedailywtf.com + +=head1 SYNOPSIS + + use WebService::TDWTF; + my $random_article = tdwtf_article; + say $random_article->Title; + say $random_article->Body; + + my $x = tdwtf_article 8301; + say $x->Title; # Your Recommended Virus + my $y = tdwtf_article 'your-recommended-virus'; # $x and $y are equivalent + + my @recent = tdwtf_list_recent; + say scalar @recent; # 8 + @recent = tdwtf_list_recent 10; + say scalar @recent; # 10 + + my @dec15 = tdwtf_list_recent 2015, 12; + say $dec15[0]->Title; # Best of 2015: The A(nti)-Team + say $dec15[0]->Body; # (this makes an API call, see NOTES) + say $dec15[0]->Body; # (this doesn't make an API call) + + my @erik = tdwtf_list_author 'erik-gern'; # (most recent 8 articles by Erik Gern) + my @sod = tdwtf_list_series 'code-sod', 5; # (most recent 5 CodeSOD articles) + + # All Error'd articles published in January 2014 + my @jan14_errord = tdwtf_list_series 'errord', 2014, 1; + +=head1 DESCRIPTION + +WebService::TDWTF is an interface to the API of L. +Quoting the website's sidebar: + + Founded in 2004 by Alex Papadimoulis, The Daily WTF is your + how-not-to guide for developing software. We recount tales of + disastrous development, from project management gone spectacularly + bad to inexplicable coding choices. + +This module exports the following functions: + +=over + +=item B() + +=item B(I<$id_or_slug>) + +=item B
() + +=item B
(I<$id_or_slug>) + +With an argument, returns a L object representing +the article with the given ID or slug. + +With no arguments, returns a L object representing +a random article. + +=item B() + +=item B(I<$count>) + +=item B(I<$year>, I<$month>) + +=item B() + +=item B(I<$count>) + +=item B(I<$year>, I<$month>) + +With no arguments, returns the most recent 8 articles. + +With one argument, returns the most recent I<$count> articles. +I<$count> is at most 100. + +With two arguments, returns all articles published in the given month +of the given year. I<$month> is an integer between 1 and 12. + +=item B(I<$slug>) + +=item B(I<$slug>, I<$count>) + +=item B(I<$slug>, I<$year>, I<$month>) + +=item B(I<$slug>) + +=item B(I<$slug>, I<$count>) + +=item B(I<$slug>, I<$year>, I<$month>) + +With no arguments, returns the most recent 8 articles in the given +series. + +With one argument, returns the most recent I<$count> articles in the +given series. I<$count> is at most 100. + +With two arguments, returns all articles in the given series published +in the given month of the given year. I<$month> is an integer between +1 and 12. + +=item B(I<$slug>) + +=item B(I<$slug>, I<$count>) + +=item B(I<$slug>, I<$year>, I<$month>) + +=item B(I<$slug>) + +=item B(I<$slug>, I<$count>) + +=item B(I<$slug>, I<$year>, I<$month>) + +With no arguments, returns the most recent 8 articles by the given +author. + +With one argument, returns the most recent I<$count> articles by the +given author. I<$count> is at most 100. + +With two arguments, returns all articles by the given author published +in the given month of the given year. I<$month> is an integer between +1 and 12. + +=back + +=head1 NOTES + +All functions are exported of the name B are exported by +default. The unprefixed variants can be exported on request. + +The B functions return a list of incomplete +L objects. These objects contain all of +the fields of a normal object, except for BodyHtml and FooterAdHtml. +For these objects, the B mehod of L +retrieves the BodyHtml and FooterAdHtml fields from the API and saves +them into the object. + +All B functions return articles in reverse chronological +order. That is, the first element of the list is the most recent article. + +=head1 SEE ALSO + +L + +L + +=head1 AUTHOR + +Marius Gavrilescu, Emarius@ieval.roE + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2016 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.20.2 or, +at your option, any later version of Perl 5 you may have available. + + +=cut diff --git a/lib/WebService/TDWTF/Article.pm b/lib/WebService/TDWTF/Article.pm new file mode 100644 index 0000000..b705b87 --- /dev/null +++ b/lib/WebService/TDWTF/Article.pm @@ -0,0 +1,223 @@ +package WebService::TDWTF::Article; + +use 5.014000; +use strict; +use warnings; +use parent qw/Class::Accessor::Fast/; + +our $VERSION = '0.001'; + +use WebService::TDWTF (); + +sub _article { goto &WebService::TDWTF::article } + +__PACKAGE__->mk_ro_accessors(qw/Id Slug SummaryHtml BodyHtml FooterAdHtml Title CoalescedCommentCount DiscourseThreadUrl PublishedDate DisplayDate Url CommentsUrl PreviousArticleId PreviousArticleUrl NextArticleId NextArticleUrl/); + +sub AuthorName { shift->{Author}->{Name} } +sub AuthorShortDescription { shift->{Author}->{ShortDescription} } +sub AuthorDescriptionHtml { shift->{Author}->{DescriptionHtml} } +sub AuthorSlug { shift->{Author}->{Slug} } +sub AuthorImageUrl { shift->{Author}->{ImageUrl} } + +sub SeriesSlug { shift->{Series}->{Slug} } +sub SeriesTitle { shift->{Series}->{Title} } +sub SeriesDescription { shift->{Series}->{Description} } + +sub PreviousArticle { _article shift->PreviousArticleId // return } +sub NextArticle { _article shift->NextArticleId // return } + +sub Body { + unless ($_[0]->BodyHtml) { + my $ret = _article $_[0]->Id, 1; + $_[0]->{$_} = $ret->{$_} for qw/BodyHtml FooterAdHtml/; + } + $_[0]->BodyHtml +} + +1; +__END__ + +=encoding utf-8 + +=head1 NAME + +WebService::TDWTF::Article - Class representing information about a TDWTF article + +=head1 SYNOPSIS + + use WebService::TDWTF; + my $article = tdwtf_article 8301; + + say $article->Id; # 8301 + say $article->Slug; # your-recommended-virus + say $article->SummaryHtml; + say $article->BodyHtml; + say $article->Body; + say $article->Title; # Your Recommended Virus + say $article->CoalescedCommentCount; + say $article->DiscourseThreadUrl; # http://what.thedailywtf.com/t/your-recommended-virus/52541 + say $article->PublishedDate; # 2015-11-12T06:30:00 + say $article->DisplayDate; # 2015-11-12 + say $article->Url; # http://thedailywtf.com/articles/your-recommended-virus + say $article->CommentsUrl; # http://thedailywtf.com/articles/comments/your-recommended-virus + say $article->PreviousArticleId; # 8299 + say $article->PreviousArticleUrl; # //thedailywtf.com/articles/confession-rect-contains-point + say $article->NextArticleId; # 8302 + say $article->NextArticleUrl; # //thedailywtf.com/articles/who-stole-the-search-box + + say $article->AuthorName; # Ellis Morning + say $article->AuthorShortDescription; # Editor + say $article->AuthorDescriptionHtml; + say $article->AuthorSlug; # ellis-morning + say $article->AuthorImageUrl; # http://img.thedailywtf.com/images/remy/ellis01.jpg + + say $article->SeriesSlug; # feature-articles + say $article->SeriesTitle; # Feature Articles + say $article->SeriesDescription; + + say $article->PreviousArticle->Title # Confession: rect.Contains(point) + say $article->NextArticle->Title # Who Stole the Search Box?! + +=head1 DESCRIPTION + +A WebService::TDWTF::Article object represents an article on +L. Objects of this class are returned by the +functions in L. Each such object is guaranteed to +be a blessed hashref corresponding to the JSON returned by the TDWTF +API (possibly with some extra keys), so the data inside can be +obtained by simply dereferencing the object. + +The ArticleModel class in the TDWTF source code might be helpful in +finding the available attributes and understanding their meaning. It +can be found here: +L + +Several accessors and convenience functions are provided for accessing +the most common attributes. See the SYNOPSIS for usage examples. + +=over + +=item B + +The numerical ID of the article. + +=item B + +The string ID of the article. + +=item B + +The title of the article + +=item B<Url> + +URL of the article itself. + +=item B<SummaryHtml> + +The summary (first 1-2 paragraphs) of the article. + +=item B<BodyHtml> + +The body of the article. If the object comes from a tdwtf_list_* function, this method returns "". + +=item B<Body> + +The body of the article. If the object comes from a tdwtf_list_* function, this method retreives the body from the server, saves it in the object and returns it. + +=item B<FooterAdHtml> + +The advertisment in the footer of the article. If the object comes from a list_ function, this method returns "". + +=item B<CoalescedCommentCount> + +The number of comments of the article. + +=item B<CommentsUrl> + +URL to the featured comments list. See DiscourseThreadUrl for the URL to the full comment thread. + +=item B<DiscourseThreadUrl> + +URL of the full comment thread on what.thedailywtf.com. + +=item B<PublishedDate> + +Date and time when the article was published in ISO 8601 format, with no timezone. + +=item B<DisplayDate> + +Date when the article was published in ISO 8601 format, with no timezone. + +=item B<AuthorName> + +Name of the article's author. + +=item B<AuthorShortDescription> + +A one-line description of the article's author. + +=item B<AuthorDescriptionHtml> + +A longer description of the article's author. + +=item B<AuthorSlug> + +The ID of the article's author, suitable for passing to the tdwtf_list_author function of L<WebService::TDWTF>. + +=item B<AuthorImageUrl> + +URL to an image of the article's author. + +=item B<SeriesSlug> + +The ID of the article's series, suitable for passing to the tdwtf_list_series function of L<WebService::TDWTF> + +=item B<SeriesTitle> + +The name of the article's series. + +=item B<SeriesDescription> + +A description of the article's series. + +=item B<PreviousArticleId> + +The numerical ID of the previous article. + +=item B<PreviousArticleUrl> + +URL of the previous article. + +=item B<PreviousArticle> + +Retrieves the previous article using L<WebService::TDWTF> and returns it as a WebService::TDWTF::Article object. + +=item B<NextArticleId> + +The numerical ID of the next article. + +=item B<NextArticleUrl> + +URL of the next article. + +=item B<NextArticle> + +Retrieves the next article using L<WebService::TDWTF> and returns it as a WebService::TDWTF::Article object. + +=back + +=head1 AUTHOR + +Marius Gavrilescu, E<lt>marius@ieval.roE<gt> + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2016 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.20.2 or, +at your option, any later version of Perl 5 you may have available. + + +=cut diff --git a/t/WebService-TDWTF.t b/t/WebService-TDWTF.t new file mode 100644 index 0000000..2c2d53e --- /dev/null +++ b/t/WebService-TDWTF.t @@ -0,0 +1,36 @@ +#!/usr/bin/perl +use strict; +use warnings; + +use Test::RequiresInternet ('thedailywtf.com' => 80); +use Test::More tests => 14; +BEGIN { use_ok('WebService::TDWTF') }; + +my $art = tdwtf_article; +ok $art->Title, 'article'; +$art = tdwtf_article 8301; +is $art->Title, 'Your Recommended Virus', 'article 8301'; +$art = tdwtf_article 'your-recommended-virus'; +is $art->Title, 'Your Recommended Virus', 'article \'your-recommended-virus\''; + +my @recent = tdwtf_list_recent; +is @recent, 8, 'tdwtf_list_recent'; +@recent = tdwtf_list_recent 2; +is @recent, 2, 'tdwtf_list_recent 2'; + +my @dec15 = tdwtf_list_recent 2015, 12; +is $dec15[0]->Title, 'Best of 2015: The A(nti)-Team', 'tdwtf_list_recent 2015, 12'; +is $dec15[0]->BodyHtml, '', '->BodyHtml'; +isnt $dec15[0]->Body, '', '->Body'; +isnt $dec15[0]->Body, '', '->Body (cached)'; + +my @erik = tdwtf_list_author 'erik-gern'; +is @erik, 8, 'tdwtf_list_author \'erik-gern\''; + +my @sod = tdwtf_list_series 'code-sod', 5; +is @sod, 5, 'tdwtf_list_series \'code-sod\', 5'; + + +my ($last) = tdwtf_list_recent 1; +ok !defined $last->NextArticle, 'last article has no next article'; +is $last->PreviousArticle->NextArticle->Id, $last->Id, 'next article of the previous article is current article'; -- 2.39.2