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   382 use strict;
  65         124  
  65         1512  
6 65     65   306 use Exporter ();
  65         104  
  65         948  
7 65     65   281 use Digest::MD5 ();
  65         137  
  65         1291  
8 65     65   18842 use Params::Util qw{_INSTANCE _SCALAR0 _ARRAY0};
  65         251916  
  65         5908  
9              
10             our $VERSION = '1.276';
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   423 use constant HAVE_UNICODE => !! ( $] >= 5.008007 );
  65         101  
  65         31509  
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   1201 shift if @_ > 1;
35 17 50       37 return undef unless defined $_[0];
36 17         89 require PPI::Document;
37 17 100       55 return PPI::Document->new(shift) unless ref $_[0];
38 16 100       55 return PPI::Document->new(shift) if _SCALAR0($_[0]);
39 10 100       36 return PPI::Document->new(shift) if _ARRAY0($_[0]);
40 9 100       67 return shift if _INSTANCE($_[0], 'PPI::Document');
41 2         5 return undef;
42             }
43              
44             # Provide a simple _slurp implementation
45             sub _slurp {
46 661     661   1618 my $file = shift;
47 661         2260 local $/ = undef;
48 661         1745 local *FILE;
49 661 50       26662 open( FILE, '<', $file ) or return "open($file) failed: $!";
50 661         30211 my $source = ;
51 661 50       7415 close( FILE ) or return "close($file) failed: $!";
52 661         5092 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 329     329 0 971 my $string = shift;
59 329         101626 $string =~ s/(?:\015{1,2}\012|\015|\012)/\015/gs;
60 329         4621 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 160     160 0 1947 my $file = shift;
66 160         379 my $content = _slurp($file);
67 160 50       610 return undef unless ref $content;
68 160         51676 $$content =~ s/(?:\015{1,2}\012|\015|\012)/\n/gs;
69 160         640 md5hex($$content);
70             }
71              
72             1;