File Coverage

blib/lib/PPI/Util.pm

Criterion	Covered	Total	%
statement	38	38	100.0
branch	16	20	80.0
condition			n/a
subroutine	9	9	100.0
pod	0	2	0.0
total	63	69	91.3

package PPI::Util;

# Provides some common utility functions that can be imported

use strict;
use Exporter     ();
use Digest::MD5  ();
use Params::Util qw{_INSTANCE _SCALAR0 _ARRAY0};

our $VERSION = '1.287';

our @ISA       = 'Exporter';
our @EXPORT_OK = qw{ _Document _slurp };

# 5.8.7 was the first version to resolve the notorious
# "unicode length caching" bug.
use constant HAVE_UNICODE => !! ( $] >= 5.008007 );

# Common reusable true and false functions
# This makes it easy to upgrade many places in PPI::XS
sub TRUE  () { 1  }
sub FALSE () { '' }





#####################################################################
# Functions

# Allows a sub that takes a L to handle the full range
# of different things, including file names, SCALAR source, etc.
sub _Document {
	shift if @_ > 1;
	return undef unless defined $_[0];
	require PPI::Document;
	return PPI::Document->new(shift) unless ref $_[0];
	return PPI::Document->new(shift) if _SCALAR0($_[0]);
	return PPI::Document->new(shift) if _ARRAY0($_[0]);
	return shift if _INSTANCE($_[0], 'PPI::Document');
	return undef;
}

# Provide a simple _slurp implementation
sub _slurp {
	my $file = shift or return "_slurp() failed: no filename provided";
	local $/ = undef;
	local *FILE;
	open( FILE, '<', $file ) or return "open($file) failed: $!";
	my $source = ;
	close( FILE ) or return "close($file) failed: $!";
	return \$source;
}

# Provides a version of Digest::MD5's md5hex that explicitly
# works on the unix-newlined version of the content.
sub md5hex {
	my $string = shift;
	$string =~ s/(?:\015{1,2}\012|\015|\012)/\015/gs;
	Digest::MD5::md5_hex($string);
}

# As above but slurps and calculates the id for a file by name
sub md5hex_file {
	my $file    = shift;
	my $content = _slurp($file);
	return undef unless ref $content;
	$$content =~ s/(?:\015{1,2}\012|\015|\012)/\n/gs;
	md5hex($$content);
}

1;