File Coverage

blib/lib/WWW/FetchStory/Fetcher/Ashwinder.pm
Criterion Covered Total %
statement 9 76 11.8
branch 0 18 0.0
condition 0 3 0.0
subroutine 3 10 30.0
pod 7 7 100.0
total 19 114 16.6


line stmt bran cond sub pod time code
1             package WWW::FetchStory::Fetcher::Ashwinder;
2             $WWW::FetchStory::Fetcher::Ashwinder::VERSION = '0.2602';
3 1     1   218956 use strict;
  1         2  
  1         48  
4 1     1   7 use warnings;
  1         3  
  1         89  
5             =head1 NAME
6              
7             WWW::FetchStory::Fetcher::Ashwinder - fetching module for WWW::FetchStory
8              
9             =head1 VERSION
10              
11             version 0.2602
12              
13             =head1 DESCRIPTION
14              
15             This is the Ashwinder story-fetching plugin for WWW::FetchStory.
16              
17             =cut
18              
19 1     1   10 use parent qw(WWW::FetchStory::Fetcher);
  1         2  
  1         9  
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://ashwinder.sycophanthex.com/) A Severus Snape/Hermione Granger 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 Ashwinder fetcher, and then refinements for particular
44             Ashwinder 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 =~ /ashwinder\.sycophanthex\.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 0           $info{url} = $args{url};
122 0           my $sid='';
123 0 0         if ($args{url} =~ m#sid=(\d+)#)
124             {
125 0           $sid = $1;
126             }
127             else
128             {
129 0           return $self->SUPER::parse_toc(%args);
130             }
131              
132 0           $info{title} = $self->parse_title(%args);
133 0           $info{author} = $self->parse_author(%args);
134 0           $info{summary} = $self->parse_summary(%args);
135              
136             # if this is a single-chapter story, the summary is on the author page
137 0 0 0       if (!$info{summary} and $content =~ m#<a href="viewuser.php\?uid=(\d+)">#s)
138             {
139 0           my $auth_url = sprintf("http://ashwinder.sycophanthex.com/viewuser.php?uid=%d", $1);
140 0           my $auth_page = $self->get_page($auth_url);
141 0 0         if ($auth_page =~ m#<a href="viewstory.php\?sid=${sid}">.*?<br>\s*([^<]+)\s*<br>#s)
142             {
143 0           $info{summary} = $1;
144             }
145             }
146             else # not a single-chapter story
147             {
148             # remove the wordcount
149 0           $info{summary} =~ s/\s*\(\d+ words\)//;
150             }
151 0           $info{characters} = 'Hermione Granger, Severus Snape';
152 0           $info{universe} = 'Harry Potter';
153              
154 0           $info{chapters} = $self->parse_chapter_urls(%args, sid=>$sid);
155              
156 0           return %info;
157             } # parse_toc
158              
159             =head2 parse_chapter_urls
160              
161             Figure out the URLs for the chapters of this story.
162              
163             =cut
164             sub parse_chapter_urls {
165 0     0 1   my $self = shift;
166 0           my %args = (
167             urls=>undef,
168             content=>'',
169             @_
170             );
171 0           my $content = $args{content};
172 0           my $sid = $args{sid};
173 0           my @chapters = ();
174              
175 0 0         if (defined $args{urls})
176             {
177 0           @chapters = @{$args{urls}};
  0            
178             }
179              
180 0 0         if (@chapters == 1)
181             {
182             # Ashwinder does not have a sane chapter system
183 0           my $fmt = 'http://ashwinder.sycophanthex.com/viewstory.php?action=printable&sid=%d';
184 0 0         if ($content =~ m#i=1"#s)
185             {
186 0           @chapters = ();
187 0           my $count = 1;
188 0           while ($content =~ m#viewstory\.php\?sid=(\d+)#sg)
189             {
190 0           my $ch_sid = $1;
191 0           my $ch_url = sprintf($fmt, $ch_sid);
192 0 0         warn "chapter[$count]=$ch_url\n" if ($self->{verbose} > 1);
193 0           push @chapters, $ch_url;
194 0           $count++;
195             }
196             }
197             else
198             {
199 0           @chapters = (sprintf($fmt, $sid));
200             }
201             }
202              
203 0           return \@chapters;
204             } # parse_chapter_urls
205              
206             =head2 parse_title
207              
208             Get the title from the content
209              
210             =cut
211             sub parse_title {
212 0     0 1   my $self = shift;
213 0           my %args = (
214             url=>'',
215             content=>'',
216             @_
217             );
218              
219 0           my $content = $args{content};
220 0           my $title = '';
221 0 0         if ($content =~ m#<b><a href="viewstory.php\?sid=\d+">([^<]+)</a></b> by <b><a href="viewuser.php#s)
222             {
223 0           $title = $1;
224             }
225             else
226             {
227 0           $title = $self->SUPER::parse_title(%args);
228             }
229 0           return $title;
230             } # parse_title
231              
232             =head2 parse_author
233              
234             Get the author from the content
235              
236             =cut
237             sub parse_author {
238 0     0 1   my $self = shift;
239 0           my %args = (
240             url=>'',
241             content=>'',
242             @_
243             );
244              
245 0           my $content = $args{content};
246 0           my $author = '';
247 0 0         if ($content =~ m#<a href="viewuser.php\?uid=\d+">([^<]+)</a>#s)
248             {
249 0           $author = $1;
250             }
251             else
252             {
253 0           $author = $self->SUPER::parse_author(%args);
254             }
255 0           return $author;
256             } # parse_author
257              
258             1; # End of WWW::FetchStory::Fetcher::Ashwinder
259             __END__