[catagits/Gitalist.git] / local-lib5 / lib / perl5 / PPI / Util.pm

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};

use vars qw{$VERSION @ISA @EXPORT_OK};
BEGIN {
	$VERSION   = '1.206';
	@ISA       = 'Exporter';
	@EXPORT_OK = qw{_Document _slurp};
}

# Alarms are used to catch unexpectedly slow and complex documents
use constant HAVE_ALARM   => !  ( $^O eq 'MSWin32' or $^O eq 'cygwin' );

# 5.8.7 was the first version to resolve the notorious
# "unicode length caching" bug. See RT #FIXME
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<PPI::Document> 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;
	local $/ = undef;
	local *FILE;
	open( FILE, '<', $file ) or return "open($file) failed: $!";
	my $source = <FILE>;
	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;
Commit	Line	Data
3fea05b9	1	package PPI::Util;
	2
	3	# Provides some common utility functions that can be imported
	4
	5	use strict;
	6	use Exporter ();
	7	use Digest::MD5 ();
	8	use Params::Util qw{_INSTANCE _SCALAR0 _ARRAY0};
	9
	10	use vars qw{$VERSION @ISA @EXPORT_OK};
	11	BEGIN {
	12	$VERSION = '1.206';
	13	@ISA = 'Exporter';
	14	@EXPORT_OK = qw{_Document _slurp};
	15	}
	16
	17	# Alarms are used to catch unexpectedly slow and complex documents
	18	use constant HAVE_ALARM => ! ( $^O eq 'MSWin32' or $^O eq 'cygwin' );
	19
	20	# 5.8.7 was the first version to resolve the notorious
	21	# "unicode length caching" bug. See RT #FIXME
	22	use constant HAVE_UNICODE => !! ( $] >= 5.008007 );
	23
	24	# Common reusable true and false functions
	25	# This makes it easy to upgrade many places in PPI::XS
	26	sub TRUE () { 1 }
	27	sub FALSE () { '' }
	28
	29
	30
	31
	32
	33	#####################################################################
	34	# Functions
	35
	36	# Allows a sub that takes a L<PPI::Document> to handle the full range
	37	# of different things, including file names, SCALAR source, etc.
	38	sub _Document {
	39	shift if @_ > 1;
	40	return undef unless defined $_[0];
	41	require PPI::Document;
	42	return PPI::Document->new(shift) unless ref $_[0];
	43	return PPI::Document->new(shift) if _SCALAR0($_[0]);
	44	return PPI::Document->new(shift) if _ARRAY0($_[0]);
	45	return shift if _INSTANCE($_[0], 'PPI::Document');
	46	return undef;
	47	}
	48
	49	# Provide a simple _slurp implementation
	50	sub _slurp {
	51	my $file = shift;
	52	local $/ = undef;
	53	local *FILE;
	54	open( FILE, '<', $file ) or return "open($file) failed: $!";
	55	my $source = <FILE>;
	56	close( FILE ) or return "close($file) failed: $!";
	57	return \$source;
	58	}
	59
	60	# Provides a version of Digest::MD5's md5hex that explicitly
	61	# works on the unix-newlined version of the content.
	62	sub md5hex {
	63	my $string = shift;
	64	$string =~ s/(?:\015{1,2}\012\|\015\|\012)/\015/gs;
65	Digest::MD5::md5_hex($string);
66	}
67
68	# As above but slurps and calculates the id for a file by name
69	sub md5hex_file {
70	my $file = shift;
71	my $content = _slurp($file);
72	return undef unless ref $content;
73	$$content =~ s/(?:\015{1,2}\012\|\015\|\012)/\n/gs;
74	md5hex($$content);
75	}
76
77	1;