File Coverage

blib/lib/WWW/Shorten/generic.pm
Criterion Covered Total %
statement 38 38 100.0
branch 8 8 100.0
condition 2 3 66.7
subroutine 8 8 100.0
pod 1 1 100.0
total 57 58 98.3


line stmt bran cond sub pod time code
1             # $Id$
2              
3             =head1 NAME
4            
5             WWW::Shorten::generic - Methods shared across all WWW::Shorten modules
6            
7             =head1 SYNOPSIS
8            
9             use WWW::Shorten 'SomeSubclass';
10            
11             =head1 DESCRIPTION
12            
13             Contains methds that are shared across all WWW::Shorten implemenation
14             modules.
15            
16             =cut
17              
18             package WWW::Shorten::generic;
19              
20 9     9   1434 use 5.006;
  9         26  
  9         141  
21 9     9   31 use strict;
  9         13  
  9         145  
22 9     9   25 use warnings;
  9         7  
  9         278  
23              
24             our $VERSION = 1.92;
25              
26 9     9   2170 use LWP;
  9         192183  
  9         179  
27 9     9   31 use Carp;
  9         9  
  9         944  
28              
29             my %name_sets =
30             (
31                 default => [qw( makeashorterlink makealongerlink )],
32                 short => [qw( short_link long_link )],
33             );
34              
35             sub import
36             {
37 10     10   79751     my $class = shift;
38 10         22     my ($package) = caller;
39 10 100       39     ($package) = caller(1) if $package eq 'WWW::Shorten';
40 10         13     my $set = shift;
41 10 100 66     42     if (defined $set and $set =~ /^ : (\w+) $/x) {
42 3         7 $set = $1;
43                 } else {
44 7         11 $set = 'default';
45                 }
46 10 100       20     if ( exists $name_sets{$set} )
47                 {
48 9     9   34 no strict 'refs';
  9         10  
  9         1276  
49 9         32 *{"${package}::$name_sets{$set}[0]"} =
  9         25  
50 9         9 *{ "${class}::$name_sets{default}[0]"};
51 9         44321 *{"${package}::$name_sets{$set}[1]"} =
  9         20  
52 9         9 *{ "${class}::$name_sets{default}[1]"};
53                 }
54                 else
55                 {
56 1         107 croak "Unknown function set - $set.";
57                 }
58             }
59              
60             my $ua;
61              
62             =head1 FUNCTIONS
63            
64             =head2 ua
65            
66             Returns the object's LWP::Useragent attribute. Creates a new one if one
67             doesn't already exist.
68            
69             =cut
70              
71             sub ua
72             {
73 7     7 1 21     my $self = shift;
74 7 100       72     return $ua if defined $ua;
75 2         74     my $v = $self->VERSION();
76 2         19     $ua = LWP::UserAgent->new(
77             env_proxy => 1,
78             timeout => 30,
79             agent => "$self/$v",
80             requests_redirectable => [],
81                 );
82 2         3690     return $ua;
83             }
84              
85             1;
86