File Coverage

blib/lib/Path/Class/URI.pm
Criterion Covered Total %
statement 24 38 63.1
branch 0 8 0.0
condition n/a
subroutine 8 12 66.6
pod 2 4 50.0
total 34 62 54.8


line stmt bran cond sub pod time code
1             package Path::Class::URI;
2              
3 1     1   25658 use strict;
  1         2  
  1         47  
4 1     1   34 use 5.008_001;
  1         3  
  1         66  
5             our $VERSION = '0.06';
6              
7 1     1   769 use URI;
  1         8575  
  1         44  
8 1     1   5471 use URI::file;
  1         7512  
  1         54  
9 1     1   745 use Exporter::Lite;
  1         939  
  1         7  
10 1     1   682 use Path::Class;
  1         57663  
  1         100  
11 1     1   16 use Scalar::Util qw(blessed);
  1         3  
  1         65  
12 1     1   7 use URI::Escape;
  1         3  
  1         1324  
13              
14             our @EXPORT = qw( file_from_uri dir_from_uri );
15              
16             sub file_from_uri {
17 0     0 1   Path::Class::File->from_uri(shift);
18             }
19              
20             sub dir_from_uri {
21 0     0 1   Path::Class::Dir->from_uri(shift);
22             }
23              
24             sub Path::Class::Entity::uri {
25 0     0 0   my $self = shift;
26 0           my $escaped_self = $self->new( map { uri_escape($_) } $self->components );
  0            
27             # escape the components so that URI can see them as path segments
28 0           my $path = $escaped_self->stringify;
29 0 0         $path =~ tr!\\!/! if $^O eq "MSWin32";
30 0 0         $path .= '/' if $self->isa('Path::Class::Dir'); # preserve directory if used as base URI
31 0 0         if ($self->is_absolute) {
32 0           return URI->new("file://$path");
33             } else {
34 0           return URI->new("file:$path");
35             }
36             }
37              
38             sub Path::Class::Entity::from_uri {
39 0     0 0   my($class, $uri) = @_;
40 0 0         $uri = URI->new($uri) unless blessed $uri;;
41 0           $class->new( $uri->file('unix') );
42             }
43              
44             1;
45             __END__