File Coverage

blib/lib/URI/jar.pm
Criterion Covered Total %
statement 26 30 86.6
branch 8 12 66.6
condition n/a
subroutine 6 6 100.0
pod 2 2 100.0
total 42 50 84.0


line stmt bran cond sub pod time code
1             package URI::jar;
2              
3 3     3   27306 use strict;
  3         7  
  3         103  
4 3     3   15 use warnings;
  3         7  
  3         91  
5              
6 3     3   15 use base qw(URI::_generic);
  3         6  
  3         2591  
7 3     3   25322 use URI;
  3         9  
  3         983  
8              
9             =head1 NAME
10              
11             URI::jar - Java ARchive URI
12              
13             =head1 VERSION
14              
15             version 0.02
16              
17             =cut
18              
19             our $VERSION = '0.02';
20              
21             =head1 SYNOPSIS
22              
23             use URI;
24             use URI::jar;
25              
26             my $jar_uri = URI->jar("jar:http://www.art-code.org/foo/bar.jar!/content/baz/zigorou.js");
27             local $\ = "\n";
28             print $jar_uri->jar_entry_name; # will print "/content/baz/zigorou.js"
29             print $jar_uri->jar_file_uri; # will print "http://www.art-code.org/foo/bar.jar"
30              
31             =head1 METHOD
32              
33             =head2 jar_entry_name()
34              
35             Return entry name in jar file.
36              
37             =cut
38              
39             sub jar_entry_name {
40 6     6 1 143 my ($self, $jar_entry_name) = @_;
41 6         24 my @leaf = split(/!/, $$self);
42              
43 6 50       16 if (@leaf == 2) {
44 6 100       15 if ($jar_entry_name) {
45 2         10 $self->path(join("!", $leaf[0], $jar_entry_name));
46             }
47             else {
48 4         20 return $leaf[1];
49             }
50             }
51             else {
52 0         0 return;
53             }
54             }
55              
56             =head2 jar_file_uri()
57              
58             Return jar file's uri as L object.
59              
60             =cut
61              
62             sub jar_file_uri {
63 8     8 1 46 my ($self, $jar_file_uri) = @_;
64              
65 8         37 my @leaf = split(/!/, $self->path);
66              
67 8 50       112 if (@leaf == 2) {
68 8 100       14 if ($jar_file_uri) {
69 2 50       14 if (UNIVERSAL::isa($jar_file_uri, "URI")) {
70 0         0 $jar_file_uri = $jar_file_uri->as_string;
71             }
72              
73 2         11 $self->path(join("!", $jar_file_uri, $leaf[1]));
74             }
75             else {
76 6 50       25 if ($leaf[0] =~ /^([^:]+)\:/) {
77 6         25 return URI->new($leaf[0]);
78             }
79             else {
80 0           return URI->new($leaf[0], "file");
81             }
82             }
83             }
84             else {
85 0           return;
86             }
87             }
88              
89             =head1 AUTHOR
90              
91             Toru Yamaguchi, C<< >>
92              
93             =head1 BUGS
94              
95             Please report any bugs or feature requests to
96             C, or through the web interface at
97             L. I will be notified, and then you'll automatically be
98             notified of progress on your bug as I make changes.
99              
100             =head1 COPYRIGHT & LICENSE
101              
102             Copyright 2007 Toru Yamaguchi, All Rights Reserved.
103              
104             This program is free software; you can redistribute it and/or modify it
105             under the same terms as Perl itself.
106              
107             =cut
108              
109             1; # End of URI::jar