File Coverage

blib/lib/Devel/IPerl/Display/Role/MIMESource.pm
Criterion Covered Total %
statement 34 42 80.9
branch 6 14 42.8
condition 2 3 66.6
subroutine 10 10 100.0
pod n/a
total 52 69 75.3


line stmt bran cond sub pod time code
1             package Devel::IPerl::Display::Role::MIMESource;
2             $Devel::IPerl::Display::Role::MIMESource::VERSION = '0.008';
3 2     2   6856 use strict;
  2         4  
  2         51  
4 2     2   8 use warnings;
  2         4  
  2         42  
5              
6 2     2   554 use autodie;
  2         22144  
  2         10  
7 2     2   14508 use Moo::Role;
  2         5  
  2         25  
8 2     2   2468 use MooX::Types::MooseLike::Base qw(Bool);
  2         15948  
  2         202  
9 2     2   1187 use LWP::UserAgent;
  2         80877  
  2         80  
10 2     2   785 use MIME::Base64;
  2         1213  
  2         136  
11 2     2   321 use Path::Class;
  2         38119  
  2         927  
12              
13             with qw(Devel::IPerl::Display::Role::Source Devel::IPerl::Display::Role::MIMEType);
14              
15             has use_data_uri => ( is => 'rw', isa => Bool, default => sub { 1 } );
16              
17             has _data => ( is => 'lazy', clearer => 1, builder => 1 );
18              
19             sub _build__data {
20 5     5   37 my ($self) = @_;
21 5 50       30 if( $self->bytestream ) {
    50          
    0          
22 0         0 return $self->bytestream;
23             } elsif( $self->filename ) {
24 5         33 my $data = file( $self->filename )->slurp( iomode => '<:raw' );
25 5         1431 return $data;
26             } elsif( $self->uri ) {
27 0         0 my $ua = LWP::UserAgent->new();
28 0         0 my $response = $ua->get( $self->uri );
29 0 0       0 die "Could not retrieve data" unless $response->is_success;
30 0         0 my $data = $response->decoded_content;
31 0         0 return $data;
32             }
33 0         0 die "No data to build display"; # TODO create exception class
34             }
35              
36             sub _html_uri {
37 5     5   11 my ($self) = @_;
38 5 100 66     105 if( $self->bytestream || $self->use_data_uri ) {
    50          
    50          
39 4         32 return "data:@{[ $self->mimetype ]};base64,@{[ encode_base64($self->_data) ]}";
  4         15  
  4         57  
40             } elsif( $self->uri ) {
41 0         0 return $self->uri;
42             } elsif( $self->filename ) {
43 1         29 return file($self->filename)->absolute; # TODO should this be a URI? Use Path::Class:URI for that.
44             }
45             }
46              
47             1;
48              
49             __END__
50              
51             =pod
52              
53             =encoding UTF-8
54              
55             =head1 NAME
56              
57             Devel::IPerl::Display::Role::MIMESource
58              
59             =head1 VERSION
60              
61             version 0.008
62              
63             =head1 AUTHOR
64              
65             Zakariyya Mughal <zmughal@cpan.org>
66              
67             =head1 COPYRIGHT AND LICENSE
68              
69             This software is copyright (c) 2014 by Zakariyya Mughal.
70              
71             This is free software; you can redistribute it and/or modify it under
72             the same terms as the Perl 5 programming language system itself.
73              
74             =cut