File Coverage

blib/lib/WWW/Eksi.pm
Criterion Covered Total %
statement 88 148 59.4
branch 8 36 22.2
condition 9 47 19.1
subroutine 16 28 57.1
pod 5 5 100.0
total 126 264 47.7


line stmt bran cond sub pod time code
1             package WWW::Eksi;
2             $WWW::Eksi::VERSION = '0.32';
3             =head1 NAME
4              
5             WWW::Eksi - Interface for Eksisozluk.com
6              
7             =head1 DESCRIPTION
8              
9             An interface for Eksisozluk, a Turkish social network.
10             Provides easy access to entries and lists of entries.
11              
12             =head1 SYNOPSIS
13              
14             use WWW::Eksi;
15             my $e = WWW::Eksi->new;
16              
17             # Last week's most popular entries
18             my @ghebe_fast = $e->ghebe; # might get rate limited
19             my @ghebe_slow = $e->ghebe(5); # add a politeness delay
20              
21             # Yesterday's most popular entries
22             my @debe_fast = $e->debe; # might get rate limited
23             my @debe_slow = $e->debe(5); # add a politeness delay
24              
25             # Alternative list of yesterday's popular entries
26             my @doludolu_fast = $e->doludolu; # might get rate limited
27             my @doludolu_slow = $e->doludolu(5); # add a politeness delay
28              
29             # Single entry
30             my $entry = $e->download_entry(1);
31              
32             =cut
33              
34 2     2   976835 use warnings;
  2         7  
  2         72  
35 2     2   17 use strict;
  2         4  
  2         38  
36 2     2   11 use Carp;
  2         4  
  2         107  
37 2     2   11 use List::Util qw/any/;
  2         4  
  2         104  
38              
39 2     2   533 use URI;
  2         4713  
  2         51  
40 2     2   448 use Furl;
  2         24611  
  2         51  
41 2     2   576 use Mojo::DOM;
  2         178291  
  2         63  
42 2     2   460 use WWW::Lengthen;
  2         40487  
  2         75  
43 2     2   1814 use IO::Socket::SSL;
  2         133527  
  2         17  
44              
45 2     2   1322 use DateTime;
  2         466055  
  2         87  
46 2     2   757 use DateTime::Format::Strptime;
  2         54953  
  2         19  
47              
48             =head1 METHODS
49              
50             =head2 new
51              
52             Returns a new WWW::Eksi object.
53              
54             =cut
55              
56             sub new {
57 1     1 1 140 my $class = shift;
58 1         12 my $today = DateTime->now->ymd;
59              
60 1         553 my $eksi = {
61             base => 'https://eksisozluk.com',
62             entry => 'https://eksisozluk.com/entry/',
63             debe => 'https://eksisozluk.com/debe',
64             ghebe => 'https://eksisozluk.com/istatistik/gecen-haftanin-en-begenilen-entryleri',
65             strp_dt => DateTime::Format::Strptime->new( pattern => '%d.%m.%Y%H:%M'),
66             strp_d => DateTime::Format::Strptime->new( pattern => '%d.%m.%Y'),
67             doludolu => 'https://eksisozluk.com/basliklar/ara?SearchForm.When.From='.$today.'T00:00:00&SearchForm.When.To='.$today.'T23:59:59&SearchForm.SortOrder=Count',
68             };
69              
70 1         3073 return bless $eksi, $class;
71             }
72              
73             =head2 download_entry($id)
74              
75             Takes entry id as argument, returns its data (if available) as follows.
76              
77             {
78             entry_url => Str
79             topic_url => Str
80             topic_title => Str
81             topic_channels => [Str]
82              
83             author_name => Str
84             author_url => Str
85             author_id => Int
86              
87             body_raw => Str
88             body_text => Str (html tags removed)
89             body_processed => Str (html tags processed)
90             fav_count => Int
91             create_time => DateTime
92             update_time => DateTime
93             }
94              
95             =cut
96              
97             sub download_entry {
98 1     1 1 703 my ($self,$id) = @_;
99 1 50 33     21 my $data = $self->_download($self->{entry}.$id) if ($id && $id=~/^\d{1,}$/);
100 1 50       8 return unless $data;
101 1         4 return $self->_parse_entry($data,$id);
102             }
103              
104             sub _parse_entry {
105 1     1   3 my ($self,$data, $id) = @_;
106 1 50       4 return unless $data;
107              
108 1         2 my $e = {};
109 1         9 my $dom = Mojo::DOM->new($data);
110              
111 1 50       1703 unless ($id){
112 0         0 $id = $dom->at('a[class~=entry-date]')->{href};
113 0         0 $id =~ s/[^\d]//g;
114 0 0 0     0 return unless ($id && $id=~/^\d{1,}$/);
115             }
116              
117             # entry_url
118 1         6 $e->{entry_url} = $self->{entry}.$id;
119              
120             # body_raw, body_text, body_processed
121 1         6 $e->{body_raw} = $dom->at('div[class=content]')->content;
122 1         865 $e->{body_text} = $dom->at('div[class=content]')->text;
123 1         427 $e->{body_processed} = $self->_process_entry($e->{body_raw});
124              
125              
126             # time_as_seen, create_time, update_time
127 1         3 my $time_as_seen = $dom->at('a[class~=entry-date]')->text;
128 1         499 $e->{time_as_seen} = $time_as_seen;
129              
130 1         8 $time_as_seen =~/
131             ^
132             \s*
133             (?<date_posted>\d\d\.\d\d\.\d{4})
134             \s*
135             (?<time_posted>\d\d:\d\d)? #old entries lack time
136             ( # update block
137             \s*
138             ~
139             \s*
140             (?<date_updated>\d\d\.\d\d\.\d{4})?
141             # date won't be shown if updated on the same day
142             \s*
143             (?<time_updated>\d\d:\d\d)?
144             )? # will not exist if not updated
145             \s*
146             $
147             /x;
148              
149 2   50 2   2250 my $date_posted = $+{date_posted} // '';
  2         916  
  2         3370  
  1         15  
150 1   50     10 my $time_posted = $+{time_posted} // '';
151 1   50     9 my $date_updated = $+{date_updated} // '';
152 1   50     9 my $time_updated = $+{time_updated} // '';
153              
154 1 50       3 Carp::croak "Entry date could not be found" unless $date_posted;
155              
156             $e->{create_time} = $time_posted
157             ? $self->{strp_dt}->parse_datetime($date_posted.$time_posted)
158 1 50       7 : $self->{strp_d}->parse_datetime($date_posted);
159             $e->{update_time} = $time_updated
160             ? $self->{strp_dt}->parse_datetime(
161 1 50 0     933 ($date_updated || $date_posted).$time_updated)
162             : '';
163              
164              
165             # author_name, author_url, author_id, fav_count
166 1         6 my $li_data_id_entry = $dom->at("li[data-id=$id]");
167 1         413 my $a_entry_author = $dom->at('a[class=entry-author]');
168 1   33     563 $e->{author_name} = $li_data_id_entry->{"data-author"}
169             // $a_entry_author->text;
170 1         32 $e->{author_url} = $self->{base}.$a_entry_author->{href};
171 1   50     23 $e->{author_id} = $li_data_id_entry->{"data-author-id"} // 0;
172 1   50     19 $e->{fav_count} = $li_data_id_entry->{"data-favorite-count"} // 0;
173              
174              
175             # topic_channels
176 1   50     21 my $channels_text = $dom->at('section[id=hidden-channels]')->text // 0;
177 1         462 $channels_text =~s/^\s*//;
178 1         6 $channels_text =~s/\s*$//;
179 1         7 my @channels = split ',',$channels_text;
180 1         3 $e->{topic_channels} = \@channels;
181              
182              
183             # topic_title, topic_url
184 1         4 my $h1_id_title = $dom->at('h1[id=title]');
185 1         322 $e->{topic_title} = $h1_id_title->{'data-title'};
186 1         19 $e->{topic_url} = $self->{base}.$h1_id_title->at('a')->{href};
187              
188 1         192 return $e;
189             }
190              
191             =head2 ghebe($politeness_delay)
192              
193             Returns an array of entries for top posts of last week.
194             Ordered from more popular to less popular.
195              
196             =cut
197              
198             sub ghebe {
199 0     0 1 0 my ($self, $sleep_seconds) = @_;
200 0   0     0 $sleep_seconds //= 0;
201 0         0 my $data = $self->_download($self->{ghebe});
202 0 0       0 return unless $data;
203              
204 0         0 my $dom = Mojo::DOM->new($data);
205 0         0 my $links = $dom->at('ol[class~=stats]')->find('a');
206 0     0   0 my $ids = $links->map(sub{$_->{href}=~m/%23(\d+)$/})->to_array;
  0         0  
207 0         0 my @entries = ();
208              
209 0         0 foreach my $id (@$ids){
210 0         0 my $entry = $self->download_entry($id);
211 0         0 push @entries, $entry;
212 0         0 sleep $sleep_seconds
213             }
214              
215 0         0 return @entries;
216             }
217              
218             =head2 debe($politeness_delay)
219              
220             Returns an array of entries for top posts of yesterday.
221             Ordered from more popular to less popular.
222              
223             =cut
224              
225             sub debe {
226 0     0 1 0 my ($self, $sleep_seconds) = @_;
227 0   0     0 $sleep_seconds //= 0;
228 0         0 my $data = $self->_download($self->{debe});
229 0 0       0 return unless $data;
230              
231 0         0 my $dom = Mojo::DOM->new($data);
232 0         0 my $links = $dom->at('ul[class~=partial]')->find('a');
233 0     0   0 my $ids = $links->map(sub{$_->{href}=~m/\/(\d+)$/})->to_array;
  0         0  
234 0         0 my @entries = ();
235              
236 0         0 foreach my $id (@$ids){
237 0         0 my $entry = $self->download_entry($id);
238 0         0 push @entries, $entry;
239 0         0 sleep $sleep_seconds
240             }
241              
242 0         0 return @entries;
243             }
244              
245             =head2 doludolu($politeness_delay)
246              
247             Returns an array of entries with alternative top posts of yesterday.
248             Ordered from more popular to less popular.
249              
250             =cut
251              
252             sub doludolu {
253 0     0 1 0 my $self = shift;
254 0   0     0 my $sleep_sec = shift // 0;
255 0         0 my $data = $self->_download($self->{doludolu});
256 0         0 my @doludolu = ();
257 0 0       0 return unless $data;
258              
259 0         0 my $dom = Mojo::DOM->new($data);
260             my $links = $dom
261             ->at('ul[class=topic-list]')
262             ->find('a')
263 0     0   0 ->map(sub{$_->{href}=~m/^(.*)\?/})
264 0         0 ->to_array;
265              
266 0         0 foreach my $link (@$links){
267 0         0 my $entry_html = $self->_download($self->{base}.$link.'?a=dailynice');
268 0         0 my $entry_hash = $self->_parse_entry($entry_html);
269 0         0 push @doludolu, $entry_hash;
270 0         0 sleep $sleep_sec;
271             }
272              
273 0         0 return @doludolu;
274             }
275              
276             sub _download {
277 0     0   0 my ($self,$url) = @_;
278              
279 0 0       0 my $u = URI->new($url) if $url;
280 0 0 0 0   0 return 0 unless ($url && $u && (any {$u->scheme eq $_} qw/http https/));
  0   0     0  
281              
282 0         0 my $response = Furl->new->get($u);
283              
284 0 0 0     0 return ($response && $response->is_success)
285             ? $response->content
286             : 0;
287             }
288              
289             sub _lengthen {
290 0     0   0 my ($self, $url) = @_;
291              
292 0 0       0 my $u = URI->new($url) if $url;
293 0 0 0 0   0 return 0 unless ($url && $u && (any {$u->scheme eq $_} qw/http https/));
  0   0     0  
294              
295 0         0 my $lengthener = WWW::Lenghten->new;
296              
297 0 0   0   0 return (any {$u->host eq $_} qw/is.gd goo.gl/)
  0         0  
298             ? $lengthener->try($u)
299             : $u;
300             }
301              
302             sub _process_entry {
303 1     1   4 my ($self,$e) = @_;
304 1 50       4 return unless $e;
305              
306             # Expand goo.gl and is.gd links
307 1         4 $e=~s/href="(https?:\/\/(goo\.gl|is\.gd)[^"]*)"/"href=\""._lengthen($1)."\""/ieg;
  0         0  
308              
309             # Make hidden references (akıllı bkz) visible
310 1         3 $e=~s/(<sup class="ab"><a data-query=")([^"]*)("[^<>]*>)\*/$1$2$3* ($2)/g;
311              
312             # Make local links global
313 1         3 $e=~s/href="\//target="_blank" href="https:\/\/eksisozluk.com\//g;
314              
315             # Force no decoration to disable underline in Gmail
316 1         4 $e=~s/href="/style="text-decoration:none;" href="/g;
317              
318             # Add JPG to imgur images with no extension
319 1         3 $e=~s/(href="https?:\/\/[^.]*\.?imgur.com\/\w{7})"/$1\.jpg"/g;
320              
321             # Make JPG/PNG images visible
322 1         2 $e=~s/(href="([^"]*\.(jpe?g|png)(:large)?)"[^<]*<\/a>)/$1<br><br><img src="$2"><br><br>/g;
323              
324             # Add NW arrow to external links
325 1         3 $e=~s/(https?:\/\/(?!eksisozluk.com)([^\/<]*\.[^\/<]*)[^<]*<\/a>)/$1 \($2 &#8599;\)/g;
326              
327 1         3 return $e;
328              
329             }
330              
331             sub _entry_not_found {
332              
333             return {
334 0     0     topic_title => '?',
335             topic_url => '?',
336             topic_channels => [],
337             author_name => '?',
338             author_id => 0,
339             body_raw => "<i>bu entry silinmi&#351;.</i>",
340             body_text => "bu entry silinmi&#351;.",
341             body_processed => "<i>bu entry silinmi&#351;.</i>",
342             fav_count => '?',
343             create_time => 0,
344             update_time => 0,
345             };
346             }
347              
348             1;
349              
350             __END__
351              
352             =head1 AUTHOR
353              
354             Kivanc Yazan C<< <kyzn at cpan.org> >>
355              
356             =head1 CONTRIBUTORS
357              
358             Mohammad S Anwar, C<< <mohammad.anwar at yahoo.com> >>
359              
360             =head1 COPYRIGHT AND LICENSE
361              
362             This software is copyright (c) 2017 by Kivanc Yazan.
363              
364             This is free software; you can redistribute it and/or modify it under
365             the same terms as the Perl 5 programming language system itself.
366              
367             Content you reach by using this module might be subject to copyright
368             terms of Eksisozluk. See eksisozluk.com for details.
369              
370             =cut