File Coverage

blib/lib/WWW/FetchStory/Fetcher/TwistingHellmouth.pm
Criterion Covered Total %
statement 9 74 12.1
branch 0 16 0.0
condition n/a
subroutine 3 11 27.2
pod 8 8 100.0
total 20 109 18.3


line stmt bran cond sub pod time code
1             package WWW::FetchStory::Fetcher::TwistingHellmouth;
2             $WWW::FetchStory::Fetcher::TwistingHellmouth::VERSION = '0.2602';
3             =head1 NAME
4              
5             WWW::FetchStory::Fetcher::TwistingHellmouth - fetching module for WWW::FetchStory
6              
7             =head1 VERSION
8              
9             version 0.2602
10              
11             =head1 DESCRIPTION
12              
13             This is the TwistingHellmouth story-fetching plugin for WWW::FetchStory.
14              
15             =cut
16              
17 1     1   141811 use parent qw(WWW::FetchStory::Fetcher);
  1         2  
  1         9  
18              
19 1     1   1407 use common::sense;
  1         19  
  1         7  
20 1     1   98 use YAML::Any qw(Dump);
  1         2  
  1         16  
21              
22             =head1 METHODS
23              
24             =head2 info
25              
26             Information about the fetcher.
27              
28             $info = $self->info();
29              
30             =cut
31              
32             sub info {
33 0     0 1   my $self = shift;
34            
35 0           my $info = "(http://www.tthfanfic.org) Twisting The Hellmouth; Buffy The Vampire Slayer crossovers.";
36              
37 0           return $info;
38             } # info
39              
40             =head2 priority
41              
42             The priority of this fetcher. Fetchers with higher priority
43             get tried first. This is useful where there may be a generic
44             fetcher for a particular site, and then a more specialized fetcher
45             for particular sections of a site. For example, there may be a
46             generic TwistingHellmouth fetcher, and then refinements for particular
47             TwistingHellmouth community, such as the sshg_exchange community.
48             This works as either a class function or a method.
49              
50             This must be overridden by the specific fetcher class.
51              
52             $priority = $self->priority();
53              
54             $priority = WWW::FetchStory::Fetcher::priority($class);
55              
56             =cut
57              
58             sub priority {
59 0     0 1   my $class = shift;
60              
61 0           return 1;
62             } # priority
63              
64             =head2 allow
65              
66             If this fetcher can be used for the given URL, then this returns
67             true.
68             This must be overridden by the specific fetcher class.
69              
70             if ($obj->allow($url))
71             {
72             ....
73             }
74              
75             =cut
76              
77             sub allow {
78 0     0 1   my $self = shift;
79 0           my $url = shift;
80              
81 0           return ($url =~ /tthfanfic\.org/);
82             } # allow
83              
84             =head1 Private Methods
85              
86             =head2 parse_toc
87              
88             Parse the table-of-contents file.
89              
90             %info = $self->parse_toc(content=>$content,
91             url=>$url,
92             urls=>\@urls);
93              
94             This should return a hash containing:
95              
96             =over
97              
98             =item chapters
99              
100             An array of URLs for the chapters of the story. In the case where the
101             story only takes one page, that will be the chapter.
102             In the case where multiple URLs have been passed in, it will be those URLs.
103              
104             =item title
105              
106             The title of the story.
107              
108             =back
109              
110             It may also return additional information, such as Summary.
111              
112             =cut
113              
114             sub parse_toc {
115 0     0 1   my $self = shift;
116 0           my %args = (
117             url=>'',
118             content=>'',
119             @_
120             );
121              
122 0           my $content = $args{content};
123 0           my %info = ();
124 0           $info{url} = $args{url};
125              
126 0           my $sid='';
127 0 0         if ($args{url} =~ m!Story-(\d+)!)
128             {
129 0           $sid = $1;
130             }
131             else
132             {
133 0           print STDERR "did not find SID for $args{url}";
134 0           return $self->SUPER::parse_toc(%args);
135             }
136              
137 0           $info{title} = $self->parse_title(%args);
138 0           $info{author} = $self->parse_author(%args);
139 0           $info{summary} = $self->parse_summary(%args);
140 0           $info{characters} = $self->parse_characters(%args);
141 0           $info{universe} = 'Buffy';
142 0           my $epub_url = $self->parse_epub_url(%args, sid=>$sid);
143 0 0         if ($epub_url)
144             {
145 0           $info{epub_url} = $epub_url;
146             }
147 0 0         if ($args{epub}) # need to parse the wordcount
148             {
149 0           $info{wordcount} = $self->parse_wordcount(%args);
150             }
151              
152 0 0         if ($content =~ m{<td>(No|Yes)\s*</td>\s*</tr>}s)
153             {
154 0           $info{complete} = $1;
155             }
156 0           $info{chapters} = $self->parse_chapter_urls(%args, sid=>$sid);
157              
158 0           return %info;
159             } # parse_toc
160              
161             =head2 parse_author
162              
163             Get the author.
164              
165             =cut
166             sub parse_author {
167 0     0 1   my $self = shift;
168 0           my %args = @_;
169              
170 0           my $content = $args{content};
171              
172 0           my $author = '';
173             # <a href="/AuthorStories-5487/janusi.htm">janusi</a>
174 0 0         if ($content =~ m!/AuthorStories-\d+/[a-zA-Z0-9_]+\.htm["']>([^<]+)</a>!)
175             {
176 0           $author = $1;
177             }
178             else
179             {
180 0           $author = $self->SUPER::parse_author(%args);
181             }
182 0           $author =~ s/_/ /g;
183 0           return $author;
184             } # parse_author
185              
186             =head2 parse_wordcount
187              
188             Get the wordcount.
189              
190             =cut
191             sub parse_wordcount {
192 0     0 1   my $self = shift;
193 0           my %args = @_;
194              
195 0           my $content = $args{content};
196              
197 0           my $words = '';
198             # <td><a href='/Story-22230-4/janusi+Iron+Buffy.htm' >4</a></td><td>56,481</td>
199 0 0         if ($content =~ m!</a></td><td>([0-9][0-9,]+)</td>!)
200             {
201 0           $words = $1;
202 0           $words =~ s/,//;
203             }
204 0           return $words;
205             } # parse_wordcount
206              
207             =head2 parse_chapter_urls
208              
209             Figure out the URLs for the chapters of this story.
210              
211             =cut
212             sub parse_chapter_urls {
213 0     0 1   my $self = shift;
214 0           my %args = (
215             url=>'',
216             content=>'',
217             @_
218             );
219 0           my $content = $args{content};
220 0           my $sid = $args{sid};
221              
222 0           my @chapters = ();
223 0 0         if (defined $args{urls})
224             {
225 0           @chapters = @{$args{urls}};
  0            
226             }
227 0 0         if (@chapters <= 1)
228             {
229 0           @chapters =
230             ("http://www.tthfanfic.org/wholestory.php?no=${sid}&format=offlinehtml");
231             }
232              
233 0           return \@chapters;
234             } # parse_chapter_urls
235              
236             =head2 parse_epub_url
237              
238             Figure out the URL for the EPUB version of this story.
239              
240             =cut
241             sub parse_epub_url {
242 0     0 1   my $self = shift;
243 0           my %args = (
244             url=>'',
245             content=>'',
246             @_
247             );
248 0           my $content = $args{content};
249 0           my $sid = $args{sid};
250 0           my $epub_url = "http://www.tthfanfic.org/wholestory.php?no=${sid}&format=epub";
251              
252             } # parse_epub_url
253              
254             1; # End of WWW::FetchStory::Fetcher::TwistingHellmouth
255             __END__