File Coverage

blib/lib/Path/Class/URI.pm
Criterion Covered Total %
statement 38 38 100.0
branch 6 8 75.0
condition n/a
subroutine 12 12 100.0
pod 2 4 50.0
total 58 62 93.5


line stmt bran cond sub pod time code
1             package Path::Class::URI;
2              
3 4     4   252582 use strict;
  4         6  
  4         133  
4 4     4   79 use 5.008_001;
  4         11  
  4         157  
5             our $VERSION = '0.08';
6              
7 4     4   1985 use URI;
  4         15690  
  4         89  
8 4     4   2650 use URI::file;
  4         18916  
  4         108  
9 4     4   2095 use Exporter::Lite;
  4         2226  
  4         23  
10 4     4   622 use Path::Class;
  4         40062  
  4         213  
11 4     4   21 use Scalar::Util qw(blessed);
  4         7  
  4         170  
12 4     4   20 use URI::Escape;
  4         5  
  4         1735  
13              
14             our @EXPORT = qw( file_from_uri dir_from_uri );
15              
16             sub file_from_uri {
17 7     7 1 2008 Path::Class::File->from_uri(shift);
18             }
19              
20             sub dir_from_uri {
21 3     3 1 104 Path::Class::Dir->from_uri(shift);
22             }
23              
24             sub Path::Class::Entity::uri {
25 12     12 0 37807 my $self = shift;
26 12         35 my $escaped_self = $self->new( map { uri_escape($_) } $self->components );
  45         480  
27             # escape the components so that URI can see them as path segments
28 12         710 my $path = $escaped_self->stringify;
29 12 50       295 $path =~ tr!\\!/! if $^O eq "MSWin32";
30 12 100       73 $path .= '/' if $self->isa('Path::Class::Dir'); # preserve directory if used as base URI
31 12 100       41 if ($self->is_absolute) {
32 10         264 return URI->new("file://$path");
33             } else {
34 2         61 return URI->new("file:$path");
35             }
36             }
37              
38             sub Path::Class::Entity::from_uri {
39 10     10 0 17 my($class, $uri) = @_;
40 10 50       67 $uri = URI->new($uri) unless blessed $uri;;
41 10         34 $class->new( $uri->file('unix') );
42             }
43              
44             1;
45             __END__