File Coverage

blib/lib/Text/Template/Simple/Base/Examine.pm
Criterion Covered Total %
statement 37 47 78.7
branch 12 22 54.5
condition 2 6 33.3
subroutine 6 7 85.7
pod n/a
total 57 82 69.5


line stmt bran cond sub pod time code
1             ## no critic (ProhibitUnusedPrivateSubroutines)
2             package Text::Template::Simple::Base::Examine;
3 60     60   299 use strict;
  60         78  
  60         1368  
4 60     60   191 use warnings;
  60         60  
  60         1363  
5              
6 60     60   197 use Text::Template::Simple::Util qw(:all);
  60         62  
  60         7051  
7 60     60   264 use Text::Template::Simple::Constants qw(:all);
  60         69  
  60         38938  
8              
9             our $VERSION = '0.90';
10              
11             sub _examine {
12 772     772   666 my $self = shift;
13 772         669 my $TMP = shift;
14 772         1261 my($type, $thing) = $self->_examine_type( $TMP );
15 772         669 my $rv;
16              
17 772 50       1526 if ( $type eq 'ERROR' ) {
    50          
18 0         0 $rv = $thing;
19 0         0 $self->[TYPE] = $type;
20             }
21             elsif ( $type eq 'GLOB' ) {
22 0         0 $rv = $self->_examine_glob( $thing );
23 0         0 $self->[TYPE] = $type;
24             }
25             else {
26 772 100       1478 if ( my $path = $self->io->file_exists( $thing ) ) {
27 566         952 $rv = $self->io->slurp( $path );
28 566         807 $self->[TYPE] = 'FILE';
29 566         689 $self->[TYPE_FILE] = $path;
30             }
31             else {
32             # just die if file is absent, but user forced the type as FILE
33 206 100       349 $self->io->slurp( $thing ) if $type eq 'FILE';
34 202         190 $rv = $thing;
35 202         317 $self->[TYPE] = 'STRING';
36             }
37             }
38              
39 768 50       1665 LOG( EXAMINE => sprintf q{%s; LENGTH: %s}, $self->[TYPE], length $rv ) if DEBUG;
40 768         1509 return $rv;
41             }
42              
43             sub _examine_glob {
44 0     0   0 my($self, $thing) = @_;
45 0         0 my $type = ref $thing;
46 0 0       0 fatal( 'tts.base.examine.notglob' => $type ) if $type ne 'GLOB';
47 0 0       0 fatal( 'tts.base.examine.notfh' ) if ! fileno $thing;
48 0         0 return $self->io->slurp( $thing );
49             }
50              
51             sub _examine_type {
52 772     772   620 my $self = shift;
53 772         600 my $TMP = shift;
54 772         660 my $ref = ref $TMP;
55              
56 772 100       1846 return EMPTY_STRING , $TMP if ! $ref;
57 4 50       11 return GLOB => $TMP if $ref eq 'GLOB';
58              
59 4 50       13 if ( ref $TMP eq 'ARRAY' ) {
60 4   33     6 my $ftype = shift @{ $TMP } || fatal('tts.base.examine._examine_type.ftype');
61 4   33     6 my $fthing = shift @{ $TMP } || fatal('tts.base.examine._examine_type.fthing');
62 4 50       4 fatal('tts.base.examine._examine_type.extra') if @{ $TMP };
  4         17  
63 4         13 return uc $ftype, $fthing;
64             }
65              
66 0           return fatal('tts.base.examine._examine_type.unknown', $ref);
67             }
68              
69             1;
70              
71             __END__
72              
73             =head1 NAME
74              
75             Text::Template::Simple::Base::Examine - Base class for Text::Template::Simple
76              
77             =head1 SYNOPSIS
78              
79             Private module.
80              
81             =head1 DESCRIPTION
82              
83             This document describes version C<0.90> of C<Text::Template::Simple::Base::Examine>
84             released on C<5 July 2016>.
85              
86             Private module.
87              
88             =head1 AUTHOR
89              
90             Burak Gursoy <burak@cpan.org>.
91              
92             =head1 COPYRIGHT
93              
94             Copyright 2004 - 2016 Burak Gursoy. All rights reserved.
95              
96             =head1 LICENSE
97              
98             This library is free software; you can redistribute it and/or modify
99             it under the same terms as Perl itself, either Perl version 5.24.0 or,
100             at your option, any later version of Perl 5 you may have available.
101             =cut