File Coverage

blib/lib/PPI/Util.pm
Criterion Covered Total %
statement 38 38 100.0
branch 13 18 72.2
condition n/a
subroutine 9 9 100.0
pod 0 2 0.0
total 60 67 89.5


line stmt bran cond sub pod time code
1             package PPI::Util;
2              
3             # Provides some common utility functions that can be imported
4              
5 65     65   467 use strict;
  65         150  
  65         1911  
6 65     65   410 use Exporter ();
  65         154  
  65         985  
7 65     65   334 use Digest::MD5 ();
  65         161  
  65         1527  
8 65     65   23598 use Params::Util qw{_INSTANCE _SCALAR0 _ARRAY0};
  65         314925  
  65         7436  
9              
10             our $VERSION = '1.277';
11              
12             our @ISA = 'Exporter';
13             our @EXPORT_OK = qw{ _Document _slurp };
14              
15             # 5.8.7 was the first version to resolve the notorious
16             # "unicode length caching" bug.
17 65     65   506 use constant HAVE_UNICODE => !! ( $] >= 5.008007 );
  65         122  
  65         39611  
18              
19             # Common reusable true and false functions
20             # This makes it easy to upgrade many places in PPI::XS
21             sub TRUE () { 1 }
22             sub FALSE () { '' }
23              
24              
25              
26              
27              
28             #####################################################################
29             # Functions
30              
31             # Allows a sub that takes a L to handle the full range
32             # of different things, including file names, SCALAR source, etc.
33             sub _Document {
34 17 50   17   2224 shift if @_ > 1;
35 17 50       53 return undef unless defined $_[0];
36 17         98 require PPI::Document;
37 17 100       48 return PPI::Document->new(shift) unless ref $_[0];
38 16 100       77 return PPI::Document->new(shift) if _SCALAR0($_[0]);
39 10 100       38 return PPI::Document->new(shift) if _ARRAY0($_[0]);
40 9 100       81 return shift if _INSTANCE($_[0], 'PPI::Document');
41 2         7 return undef;
42             }
43              
44             # Provide a simple _slurp implementation
45             sub _slurp {
46 669     669   2317 my $file = shift;
47 669         2887 local $/ = undef;
48 669         2095 local *FILE;
49 669 50       36400 open( FILE, '<', $file ) or return "open($file) failed: $!";
50 669         40362 my $source = ;
51 669 50       9750 close( FILE ) or return "close($file) failed: $!";
52 669         6882 return \$source;
53             }
54              
55             # Provides a version of Digest::MD5's md5hex that explicitly
56             # works on the unix-newlined version of the content.
57             sub md5hex {
58 333     333 0 1404 my $string = shift;
59 333         126244 $string =~ s/(?:\015{1,2}\012|\015|\012)/\015/gs;
60 333         6332 Digest::MD5::md5_hex($string);
61             }
62              
63             # As above but slurps and calculates the id for a file by name
64             sub md5hex_file {
65 162     162 0 1877 my $file = shift;
66 162         609 my $content = _slurp($file);
67 162 50       821 return undef unless ref $content;
68 162         66575 $$content =~ s/(?:\015{1,2}\012|\015|\012)/\n/gs;
69 162         834 md5hex($$content);
70             }
71              
72             1;