File Coverage

blib/lib/WWW/FetchStory/Fetcher/DigitalQuill.pm
Criterion Covered Total %
statement 9 59 15.2
branch 0 10 0.0
condition n/a
subroutine 3 9 33.3
pod 6 6 100.0
total 18 84 21.4


line stmt bran cond sub pod time code
1             package WWW::FetchStory::Fetcher::DigitalQuill;
2             $WWW::FetchStory::Fetcher::DigitalQuill::VERSION = '0.2602';
3 1     1   174928 use strict;
  1         1  
  1         57  
4 1     1   5 use warnings;
  1         2  
  1         59  
5             =head1 NAME
6              
7             WWW::FetchStory::Fetcher::DigitalQuill - fetching module for WWW::FetchStory
8              
9             =head1 VERSION
10              
11             version 0.2602
12              
13             =head1 DESCRIPTION
14              
15             This is the DigitalQuill story-fetching plugin for WWW::FetchStory.
16              
17             =cut
18              
19 1     1   3 use parent qw(WWW::FetchStory::Fetcher);
  1         5  
  1         7  
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.digital-quill.org/) A Harry Potter 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 DigitalQuill fetcher, and then refinements for particular
44             DigitalQuill 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 =~ /www\.digital-quill\.org/);
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           my @chapters = ();
122 0           $info{url} = $args{url};
123 0           my $sid='';
124 0 0         if ($args{url} =~ m#sid=(\d+)#)
125             {
126 0           $sid = $1;
127             }
128             else
129             {
130 0           return $self->SUPER::parse_toc(%args);
131             }
132              
133 0           $info{title} = $self->parse_title(%args);
134 0           $info{author} = $self->parse_author(%args);
135 0           $info{summary} = $self->parse_summary(%args);
136 0           $info{characters} = $self->parse_characters(%args);
137              
138 0           $info{universe} = 'Harry Potter';
139 0           $info{chapters} = $self->parse_chapter_urls(%args, sid=>$sid);
140              
141 0           return %info;
142             } # parse_toc
143              
144             =head2 parse_chapter_urls
145              
146             Figure out the URLs for the chapters of this story.
147              
148             =cut
149             sub parse_chapter_urls {
150 0     0 1   my $self = shift;
151 0           my %args = (
152             url=>'',
153             content=>'',
154             @_
155             );
156 0           my $content = $args{content};
157 0           my $sid = $args{sid};
158 0           my @chapters = ();
159 0 0         if (defined $args{urls})
160             {
161 0           @chapters = @{$args{urls}};
  0            
162             }
163              
164 0 0         if (@chapters == 1)
165             {
166 0           @chapters = ();
167             # DigitalQuill does not have a sane chapter system
168 0           my $fmt = 'http://www.digital-quill.org/viewstory.php?action=printable&sid=%d';
169 0           while ($content =~ m#viewstory.php\?sid=(\d+)#sg)
170             {
171 0           my $ch_sid = $1;
172 0           my $ch_url = sprintf($fmt, $ch_sid);
173 0 0         warn "chapter=$ch_url\n" if ($self->{verbose} > 1);
174 0           push @chapters, $ch_url;
175             }
176             }
177              
178 0           return \@chapters;
179             } # parse_chapter_urls
180              
181             =head2 parse_author
182              
183             Get the author from the content
184              
185             =cut
186             sub parse_author {
187 0     0 1   my $self = shift;
188 0           my %args = (
189             url=>'',
190             content=>'',
191             @_
192             );
193              
194 0           my $content = $args{content};
195 0           my $author = '';
196 0 0         if ($content =~ m#<a href="viewuser.php\?uid=\d+">([^<]+)</a>#s)
197             {
198 0           $author = $1;
199             }
200             else
201             {
202 0           $author = $self->SUPER::parse_author(%args);
203             }
204 0           return $author;
205             } # parse_author
206              
207             1; # End of WWW::FetchStory::Fetcher::DigitalQuill
208             __END__