File Coverage

blib/lib/WWW/FetchStory/Fetcher/DracoAndGinny.pm
Criterion Covered Total %
statement 9 81 11.1
branch 0 16 0.0
condition n/a
subroutine 3 11 27.2
pod 8 8 100.0
total 20 116 17.2


line stmt bran cond sub pod time code
1             package WWW::FetchStory::Fetcher::DracoAndGinny;
2             $WWW::FetchStory::Fetcher::DracoAndGinny::VERSION = '0.2602';
3 1     1   201185 use strict;
  1         2  
  1         34  
4 1     1   3 use warnings;
  1         2  
  1         135  
5             =head1 NAME
6              
7             WWW::FetchStory::Fetcher::DracoAndGinny - fetching module for WWW::FetchStory
8              
9             =head1 VERSION
10              
11             version 0.2602
12              
13             =head1 DESCRIPTION
14              
15             This is the DracoAndGinny story-fetching plugin for WWW::FetchStory.
16              
17             =cut
18              
19 1     1   6 use parent qw(WWW::FetchStory::Fetcher);
  1         3  
  1         28  
20              
21             =head2 info
22              
23             Information about the fetcher.
24              
25             $info = $self->info();
26              
27             =cut
28              
29             sub info {
30 0     0 1   my $self = shift;
31            
32 0           my $info = "(http://www.dracoandginny.com) A Draco Malfoy/Ginny Weasley HP fiction archive.";
33              
34 0           return $info;
35             } # info
36              
37             =head2 priority
38              
39             The priority of this fetcher. Fetchers with higher priority
40             get tried first. This is useful where there may be a generic
41             fetcher for a particular site, and then a more specialized fetcher
42             for particular sections of a site. For example, there may be a
43             generic DracoAndGinny fetcher, and then refinements for particular
44             DracoAndGinny community, such as the sshg_exchange community.
45             This works as either a class function or a method.
46              
47             This must be overridden by the specific fetcher class.
48              
49             $priority = $self->priority();
50              
51             $priority = WWW::FetchStory::Fetcher::priority($class);
52              
53             =cut
54              
55             sub priority {
56 0     0 1   my $class = shift;
57              
58 0           return 1;
59             } # priority
60              
61             =head2 allow
62              
63             If this fetcher can be used for the given URL, then this returns
64             true.
65             This must be overridden by the specific fetcher class.
66              
67             if ($obj->allow($url))
68             {
69             ....
70             }
71              
72             =cut
73              
74             sub allow {
75 0     0 1   my $self = shift;
76 0           my $url = shift;
77              
78 0           return ($url =~ /dracoandginny\.com/);
79             } # allow
80              
81             =head1 Private Methods
82              
83             =head2 parse_toc
84              
85             Parse the table-of-contents file.
86              
87             %info = $self->parse_toc(content=>$content,
88             url=>$url,
89             urls=>\@urls);
90              
91             This should return a hash containing:
92              
93             =over
94              
95             =item chapters
96              
97             An array of URLs for the chapters of the story. In the case where the
98             story only takes one page, that will be the chapter.
99             In the case where multiple URLs have been passed in, it will be those URLs.
100              
101             =item title
102              
103             The title of the story.
104              
105             =back
106              
107             It may also return additional information, such as Summary.
108              
109             =cut
110              
111             sub parse_toc {
112 0     0 1   my $self = shift;
113 0           my %args = (
114             url=>'',
115             content=>'',
116             @_
117             );
118              
119 0           my %info = ();
120 0           my $content = $args{content};
121              
122 0           my @chapters = ();
123              
124 0           $info{url} = $args{url};
125 0           my $sid='';
126 0 0         if ($args{url} =~ m#sid=(\d+)#)
127             {
128 0           $sid = $1;
129             }
130             else
131             {
132 0           return $self->SUPER::parse_toc(%args);
133             }
134              
135 0           $info{title} = $self->parse_title(%args);
136 0           $info{author} = $self->parse_author(%args);
137 0           $info{summary} = $self->parse_summary(%args,sid=>$sid);
138 0           $info{characters} = "Draco Malfoy, Ginny Weasley";
139 0           $info{universe} = 'Harry Potter';
140 0           $info{chapters} = $self->parse_chapter_urls(%args, sid=>$sid);
141              
142 0           return %info;
143             } # parse_toc
144              
145             =head2 parse_chapter_urls
146              
147             Figure out the URLs for the chapters of this story.
148              
149             =cut
150             sub parse_chapter_urls {
151 0     0 1   my $self = shift;
152 0           my %args = (
153             url=>'',
154             content=>'',
155             @_
156             );
157 0           my $content = $args{content};
158 0           my $sid = $args{sid};
159 0           my @chapters = ();
160              
161 0 0         if (defined $args{urls})
162             {
163 0           @chapters = @{$args{urls}};
  0            
164             }
165              
166 0 0         if (@chapters == 1)
167             {
168 0           my $fmt = 'http://www.dracoandginny.com/viewstory.php?action=printable&sid=%s&textsize=0&chapter=%d';
169              
170             # fortunately DracoAndGinny has a sane chapter system
171 0 0         if ($content =~ m#chapter=all#s)
172             {
173 0           @chapters = ();
174 0           while ($content =~ m#<a href="viewstory.php\?sid=${sid}&amp;chapter=(\d+)">#sg)
175             {
176 0           my $ch_num = $1;
177 0           my $ch_url = sprintf($fmt, $sid, $ch_num);
178 0 0         warn "chapter=$ch_url\n" if ($self->{verbose} > 1);
179 0           push @chapters, $ch_url;
180             }
181             }
182             else
183             {
184 0           @chapters = (sprintf($fmt, $sid, 1));
185             }
186             }
187              
188 0           return \@chapters;
189             } # parse_chapter_urls
190              
191             =head2 parse_title
192              
193             Get the title from the content
194              
195             =cut
196             sub parse_title {
197 0     0 1   my $self = shift;
198 0           my %args = (
199             url=>'',
200             content=>'',
201             @_
202             );
203              
204 0           my $content = $args{content};
205 0           my $title = '';
206 0 0         if ($content =~ m#<a href="viewstory.php\?sid=\d+">([^<]+)</a>#s)
207             {
208 0           $title = $1;
209             }
210             else
211             {
212 0           $title = $self->SUPER::parse_title(%args);
213             }
214 0           return $title;
215             } # parse_title
216              
217             =head2 parse_author
218              
219             Get the author from the content
220              
221             =cut
222             sub parse_author {
223 0     0 1   my $self = shift;
224 0           my %args = (
225             url=>'',
226             content=>'',
227             @_
228             );
229              
230 0           my $content = $args{content};
231 0           my $author = '';
232 0 0         if ($content =~ m#<a href="viewuser.php\?uid=\d+">([^<]+)</a>#s)
233             {
234 0           $author = $1;
235             }
236             else
237             {
238 0           $author = $self->SUPER::parse_author(%args);
239             }
240 0           return $author;
241             } # parse_author
242              
243             =head2 parse_summary
244              
245             Get the summary from the content
246              
247             =cut
248             sub parse_summary {
249 0     0 1   my $self = shift;
250 0           my %args = (
251             url=>'',
252             content=>'',
253             sid=>'',
254             @_
255             );
256              
257 0           my $content = $args{content};
258 0           my $sid = $args{sid};
259 0           my $summary = '';
260 0 0         if ($content =~ m#<blockquote>([^<]+)</blockquote>#s)
261             {
262 0           $summary = $1;
263             }
264             else
265             {
266             # In order to get the summary, # look at the "print" version of chapter 1
267 0           my $fmt = 'http://www.dracoandginny.com/viewstory.php?action=printable&sid=%s&textsize=0&chapter=%d';
268              
269 0           my $ch1_url = sprintf($fmt, $sid, 1);
270 0           my $chapter1 = $self->get_page($ch1_url);
271 0           $summary = $self->SUPER::parse_summary(%args,content=>$chapter1);
272             }
273 0           return $summary;
274             } # parse_summary
275              
276             1; # End of WWW::FetchStory::Fetcher::DracoAndGinny
277             __END__