File Coverage

blib/lib/Petal/Utils/Create_Href.pm
Criterion Covered Total %
statement 30 30 100.0
branch 3 4 75.0
condition 4 8 50.0
subroutine 7 7 100.0
pod 0 1 0.0
total 44 50 88.0


line stmt bran cond sub pod time code
1             package Petal::Utils::Create_Href;
2              
3 3     3   15 use strict;
  3         5  
  3         94  
4 3     3   16 use warnings::register;
  3         94  
  3         393  
5              
6 3     3   17 use Carp;
  3         6  
  3         197  
7              
8 3     3   16 use base qw( Petal::Utils::Base );
  3         5  
  3         250  
9              
10 3     3   15 use constant name => 'create_href';
  3         4  
  3         371  
11 3     3   15 use constant aliases => qw();
  3         3  
  3         785  
12              
13             our $VERSION = ((require Petal::Utils), $Petal::Utils::VERSION)[1];
14             our $REVISION = (split(/ /, ' $Revision: 1.2 $ '))[2];
15              
16             sub process {
17 4     4 0 18925 my $class = shift;
18 4         7 my $hash = shift;
19 4   33     10 my $args = shift || confess( "'create_href' expects 1 or 2 variables (got nothing)!" );
20              
21 4         18 my @args = $class->split_args( $args );
22 4   33     11 my $key = $args[0] || confess( "1st arg to 'limit' should be a variable (got nothing)!" );
23 4   100     14 my $protocol = $args[1] || 'http';
24              
25 4         14 my $href = $hash->fetch($key);
26 4 100       313 unless ($href =~ /^$protocol:/) {
27 2         5 $protocol = "$protocol://";
28 2 50       7 $protocol .= '/' if $protocol =~ /file/i;
29 2         4 $href = $protocol . $href;
30             }
31 4         19 return $href;
32              
33             }
34              
35             1;
36              
37             __END__