File Coverage

blib/lib/Catalyst/Controller/SimpleCAS/MimeUriResolver.pm
Criterion Covered Total %
statement 15 27 55.5
branch 0 2 0.0
condition n/a
subroutine 5 7 71.4
pod 1 1 100.0
total 21 37 56.7


line stmt bran cond sub pod time code
1             package Catalyst::Controller::SimpleCAS::MimeUriResolver;
2 1     1   3 use Moose;
  1         1  
  1         7  
3              
4 1     1   4432 use strict;
  1         2  
  1         15  
5 1     1   3 use warnings;
  1         1  
  1         20  
6              
7 1     1   2 use Try::Tiny;
  1         2  
  1         41  
8              
9 1     1   4 use Email::MIME::CreateHTML::Resolver::LWP;
  1         1  
  1         186  
10              
11             has 'Cas' => (
12             is => 'ro',
13             isa => 'Catalyst::Controller::SimpleCAS',
14             required => 1
15             );
16              
17             has 'Resolver' => (
18             is => 'ro',
19             isa => 'Object',
20             lazy => 1,
21             default => sub {
22             my $self = shift;
23             return Email::MIME::CreateHTML::Resolver::LWP->new({ base => $self->base });
24             }
25             );
26              
27             has 'base' => (
28             is => 'ro',
29             isa => 'Str',
30             required => 1
31             );
32              
33              
34             sub get_resource {
35 0     0 1   my $self = shift;
36 0           my ($uri) = @_;
37            
38 0           my ($content,$filename,$mimetype,$xfer_encoding);
39            
40 0           my $Content = $self->Cas->uri_find_Content($uri);
41 0 0         if($Content) {
42 0           $content = $Content->content;
43 0           $filename = $Content->MIME->filename(1);
44 0           $mimetype = $Content->MIME->content_type;
45 0           $xfer_encoding = $Content->MIME->header('Content-Transfer-Encoding');
46             }
47             else {
48             try {
49             # TODO:
50             # This will throw an exception if the url is relative:
51             # "Could not fetch <url> : 400 URL must be absolute"
52             # Relative urls probably indicate it is a resource of the
53             # local application; we should handle this case by setting
54             # up a virtual/internal request. In the mean time, we
55             # are wrapping in a try block to avoid dumping the whole
56             # request, so at least something can be returned, even if
57             # it is missing some inline images, etc
58 0     0     ($content,$filename,$mimetype,$xfer_encoding) = $self->Resolver->get_resource(@_);
59             }
60 0           }
61            
62 0           return ($content,$filename,$mimetype,$xfer_encoding);
63             }
64              
65              
66             1;
67              
68             __END__
69              
70             =head1 NAME
71              
72             Catalyst::Controller::SimpleCAS::MimeUriResolver - Internal MIME resource resolver for SimpleCAS
73              
74             =head1 SYNOPSIS
75              
76             use Catalyst::Controller::SimpleCAS;
77             ...
78              
79             =head1 DESCRIPTION
80              
81             This class is used internally by L<Catalyst::Controller::SimpleCAS::Role::TextTranscode> and
82             should not called/used directly.
83              
84             =head1 ATTRIBUTES
85              
86             =head2 Cas
87              
88             =head2 Resolver
89              
90             =head2 base
91              
92             =head1 METHODS
93              
94             =head2 get_resource
95              
96             =head1 SEE ALSO
97              
98             =over
99              
100             =item *
101              
102             L<Catalyst::Controller::SimpleCAS::Role::TextTranscode>
103              
104             =item *
105              
106             L<Catalyst::Controller::SimpleCAS>
107              
108             =back
109              
110             =head1 AUTHOR
111              
112             Henry Van Styn <vanstyn@cpan.org>
113              
114             =head1 COPYRIGHT AND LICENSE
115              
116             This software is copyright (c) 2014 by IntelliTree Solutions llc.
117              
118             This is free software; you can redistribute it and/or modify it under
119             the same terms as the Perl 5 programming language system itself.
120              
121             =cut