File Coverage

lib/Comics/Plugin/Base.pm
Criterion Covered Total %
statement 9 58 15.5
branch 0 16 0.0
condition 0 9 0.0
subroutine 3 7 42.8
pod 2 3 66.6
total 14 93 15.0


line stmt bran cond sub pod time code
1             #! perl
2              
3 1     1   451 use strict;
  1         2  
  1         29  
4 1     1   5 use warnings;
  1         2  
  1         106  
5              
6             package Comics::Plugin::Base;
7              
8             =head1 NAME
9              
10             Comics::Plugin::Base -- Base class for Plugins.
11              
12             =head1 SYNOPSIS
13              
14             This base class is only used indirectly via the Fetchers.
15              
16             =head1 DESCRIPTION
17              
18             The Plugin Base class provides tools for Plugins.
19              
20             =cut
21              
22             our $VERSION = "1.00";
23              
24             =head1 CONSTRUCTOR
25              
26             =head2 register( { ... } )
27              
28             Registers the plugin to the aggregator.
29              
30             The method takes a hash ref with arguments. What arguments are
31             possible depends on the plugin's Fetcher type. See the documentation
32             of the Fetchers for more info.
33              
34             As of API 1.1, the preferred way of specifying the data is by using
35             package variables. These will be transferred to the hash using
36             introspection.
37              
38             Common arguments are:
39              
40             =over 8
41              
42             =item name
43              
44             The full name of this comic, e.g. "Fokke en Sukke".
45              
46             =item url
47              
48             The url of this comic's home page.
49              
50             =item tag
51              
52             A short identifier for this comic. This will be automatically provided
53             if not specified.
54              
55             The tag is used to generate file names for images and HTML fragments.
56              
57             =back
58              
59             =cut
60              
61             sub register {
62 0     0 1   my ( $pkg, $init ) = @_;
63              
64             # API 1.0 - change to new naming.
65 0           $init->{pattern} = delete $init->{pat};
66 0           $init->{patterns} = delete $init->{pats};
67              
68             # API 1.1 - fill %init with package variables.
69 1     1   7 my %stash = do { no strict 'refs'; %{"${pkg}::"} };
  1         2  
  1         638  
  0            
  0            
  0            
70             # Iterate through the symbol table, which contains glob values
71             # indexed by symbol names.
72 0           while ( my ( $var, $glob ) = each(%stash) ) {
73 0 0         if (defined ${*{$glob}{SCALAR}} ) {
  0            
  0            
74             # Copy value.
75 0           $init->{$var} = ${*{$glob}{SCALAR}};
  0            
  0            
76             }
77 0 0         if ( defined *{$glob}{ARRAY} ) {
  0            
78             # Copy ref.
79 0           $init->{$var} = *{$glob}{ARRAY};
  0            
80             }
81 0 0         if ( defined *{$glob}{HASH} ) {
  0            
82             # Copy ref.
83 0           $init->{$var} = *{$glob}{HASH};
  0            
84             }
85             }
86              
87 0           my $self = { %$init };
88 0           bless $self, $pkg;
89 0   0       $self->{tag} ||= $self->tag_from_package;
90              
91 0           return $self;
92             }
93              
94             =head1 METHODS
95              
96             =head2 html
97              
98             Generates an HTML fragment for a fetched image.
99              
100             =cut
101              
102             sub html {
103 0     0 1   my ( $self ) = @_;
104 0           my $state = $self->{state};
105              
106 0           my $w = $state->{c_width};
107 0           my $h = $state->{c_height};
108 0 0 0       if ( $h && $w ) {
109 0 0         if ( $w > 1024 ) {
110 0           $w = 1024;
111 0           $h = int( $h * $w/$state->{c_width} );
112             }
113             }
114              
115             my $res =
116             qq{\n} . \n} . \n \n \n
117             qq{
} .
118             qq{} . _html($self->{name}) . qq{
\n} .
119             qq{ Last update: } .
120 0           localtime($state->{update}) .
121             qq{
122             qq{
} .
123             qq{
124              
125             # Alt and title are extracted from HTML, so they should be
126             # properly escaped.
127             $res .= qq{alt="} . $state->{c_alt} . qq{" }
128 0 0         if $state->{c_alt};
129             $res .= qq{title="} . $state->{c_title} . qq{" }
130 0 0         if $state->{c_title};
131 0 0 0       $res .= qq{width="$w" height="$h" }
132             if $w && $h;
133              
134 0           $res .= qq{src="$state->{c_img}">
\n};
135              
136 0           return $res;
137             }
138              
139             sub _html {
140 0     0     my ( $t ) = @_;
141              
142 0           $t =~ s/&/&/g;
143 0           $t =~ s/
144 0           $t =~ s/>/>/g;
145 0           $t =~ s/"/"e;/g;
146              
147 0           return $t;
148             }
149              
150             =head2 html
151              
152             Generates a tag (identifier) from the name of the plugin.
153              
154             =cut
155              
156             sub tag_from_package {
157 0     0 0   my $self = shift;
158 0           my $tag = lc(ref($self));
159 0           $tag =~ s/^.*:://;
160 0           return $tag;
161             }
162              
163             1;