Acme-Perl-Consensual

 view release on metacpan or  search on metacpan

inc/Module/AutoInstall.pm  view on Meta::CPAN

    my @args  = @_ or return;
    my $core_all;

    print "*** $class version " . $class->VERSION . "\n";
    print "*** Checking for Perl dependencies...\n";

    my $cwd = Cwd::cwd();

    $Config = [];

    my $maxlen = length(
        (
            sort   { length($b) <=> length($a) }
              grep { /^[^\-]/ }
              map  {
                ref($_)
                  ? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} )
                  : ''
              }
              map { +{@args}->{$_} }
              grep { /^[^\-]/ or /^-core$/i } keys %{ +{@args} }
        )[0]
    );

inc/Module/Install.pm  view on Meta::CPAN

sub _version ($) {
	my $s = shift || 0;
	my $d =()= $s =~ /(\.)/g;
	if ( $d >= 2 ) {
		# Normalise multipart versions
		$s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
	}
	$s =~ s/^(\d+)\.?//;
	my $l = $1 || 0;
	my @v = map {
		$_ . '0' x (3 - length $_)
	} $s =~ /(\d{1,3})\D?/g;
	$l = $l . '.' . join '', @v if @v;
	return $l + 0;
}

sub _cmp ($$) {
	_version($_[1]) <=> _version($_[2]);
}

# Cloned from Params::Util::_CLASS

inc/Module/Install/Makefile.pm  view on Meta::CPAN

	for my $subdir (@_) {
		push @$subdirs, $subdir;
	}
}

sub clean_files {
	my $self  = shift;
	my $clean = $self->makemaker_args->{clean} ||= {};
	  %$clean = (
		%$clean,
		FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_),
	);
}

sub realclean_files {
	my $self      = shift;
	my $realclean = $self->makemaker_args->{realclean} ||= {};
	  %$realclean = (
		%$realclean,
		FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_),
	);
}

sub libs {
	my $self = shift;
	my $libs = ref $_[0] ? shift : [ shift ];
	$self->makemaker_args( LIBS => $libs );
}

sub inc {

inc/YAML/Tiny.pm  view on Meta::CPAN

			die \"Stream has a non UTF-8 BOM";
		} else {
			# Strip UTF-8 bom if found, we'll just ignore it
			$string =~ s/^\357\273\277//;
		}

		# Try to decode as utf8
		utf8::decode($string) if HAVE_UTF8;

		# Check for some special cases
		return $self unless length $string;
		unless ( $string =~ /[\012\015]+\z/ ) {
			die \"Stream does not end with newline character";
		}

		# Split the file into lines
		my @lines = grep { ! /^\s*(?:\#.*)?\z/ }
			    split /(?:\015{1,2}\012|\015|\012)/, $string;

		# Strip the initial YAML header
		@lines and $lines[0] =~ /^\%YAML[: ][\d\.]+.*\z/ and shift @lines;

inc/YAML/Tiny.pm  view on Meta::CPAN

			} elsif ( $lines[0] =~ /^\s*\-/ ) {
				# An array at the root
				my $document = [ ];
				push @$self, $document;
				$self->_read_array( $document, [ 0 ], \@lines );

			} elsif ( $lines[0] =~ /^(\s*)\S/ ) {
				# A hash at the root
				my $document = { };
				push @$self, $document;
				$self->_read_hash( $document, [ length($1) ], \@lines );

			} else {
				die \"YAML::Tiny failed to classify the line '$lines[0]'";
			}
		}
	};
	if ( ref $@ eq 'SCALAR' ) {
		return $self->_error(${$@});
	} elsif ( $@ ) {
		require Carp;

inc/YAML/Tiny.pm  view on Meta::CPAN

	# Double quote.
	# The commented out form is simpler, but overloaded the Perl regex
	# engine due to recursion and backtracking problems on strings
	# larger than 32,000ish characters. Keep it for reference purposes.
	# if ( $string =~ /^\"((?:\\.|[^\"])*)\"\z/ ) {
	if ( $string =~ /^\"([^\\"]*(?:\\.[^\\"]*)*)\"(?:\s+\#.*)?\z/ ) {
		# Reusing the variable is a little ugly,
		# but avoids a new variable and a string copy.
		$string = $1;
		$string =~ s/\\"/"/g;
		$string =~ s/\\([never\\fartz]|x([0-9a-fA-F]{2}))/(length($1)>1)?pack("H2",$2):$UNESCAPES{$1}/gex;
		return $string;
	}

	# Special cases
	if ( $string =~ /^[\'\"!&]/ ) {
		die \"YAML::Tiny does not support a feature in line '$string'";
	}
	return {} if $string =~ /^{}(?:\s+\#.*)?\z/;
	return [] if $string =~ /^\[\](?:\s+\#.*)?\z/;

inc/YAML/Tiny.pm  view on Meta::CPAN

		}
		$string =~ s/\s+#.*\z//;
		return $string;
	}

	# Error
	die \"YAML::Tiny failed to find multi-line scalar content" unless @$lines;

	# Check the indent depth
	$lines->[0]   =~ /^(\s*)/;
	$indent->[-1] = length("$1");
	if ( defined $indent->[-2] and $indent->[-1] <= $indent->[-2] ) {
		die \"YAML::Tiny found bad indenting in line '$lines->[0]'";
	}

	# Pull the lines
	my @multiline = ();
	while ( @$lines ) {
		$lines->[0] =~ /^(\s*)/;
		last unless length($1) >= $indent->[-1];
		push @multiline, substr(shift(@$lines), length($1));
	}

	my $j = (substr($string, 0, 1) eq '>') ? ' ' : "\n";
	my $t = (substr($string, 1, 1) eq '-') ? ''  : "\n";
	return join( $j, @multiline ) . $t;
}

# Parse an array
sub _read_array {
	my ($self, $array, $indent, $lines) = @_;

inc/YAML/Tiny.pm  view on Meta::CPAN

		# Check for a new document
		if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) {
			while ( @$lines and $lines->[0] !~ /^---/ ) {
				shift @$lines;
			}
			return 1;
		}

		# Check the indent level
		$lines->[0] =~ /^(\s*)/;
		if ( length($1) < $indent->[-1] ) {
			return 1;
		} elsif ( length($1) > $indent->[-1] ) {
			die \"YAML::Tiny found bad indenting in line '$lines->[0]'";
		}

		if ( $lines->[0] =~ /^(\s*\-\s+)[^\'\"]\S*\s*:(?:\s+|$)/ ) {
			# Inline nested hash
			my $indent2 = length("$1");
			$lines->[0] =~ s/-/ /;
			push @$array, { };
			$self->_read_hash( $array->[-1], [ @$indent, $indent2 ], $lines );

		} elsif ( $lines->[0] =~ /^\s*\-(\s*)(.+?)\s*\z/ ) {
			# Array entry with a value
			shift @$lines;
			push @$array, $self->_read_scalar( "$2", [ @$indent, undef ], $lines );

		} elsif ( $lines->[0] =~ /^\s*\-\s*\z/ ) {
			shift @$lines;
			unless ( @$lines ) {
				push @$array, undef;
				return 1;
			}
			if ( $lines->[0] =~ /^(\s*)\-/ ) {
				my $indent2 = length("$1");
				if ( $indent->[-1] == $indent2 ) {
					# Null array entry
					push @$array, undef;
				} else {
					# Naked indenter
					push @$array, [ ];
					$self->_read_array( $array->[-1], [ @$indent, $indent2 ], $lines );
				}

			} elsif ( $lines->[0] =~ /^(\s*)\S/ ) {
				push @$array, { };
				$self->_read_hash( $array->[-1], [ @$indent, length("$1") ], $lines );

			} else {
				die \"YAML::Tiny failed to classify line '$lines->[0]'";
			}

		} elsif ( defined $indent->[-2] and $indent->[-1] == $indent->[-2] ) {
			# This is probably a structure like the following...
			# ---
			# foo:
			# - list

inc/YAML/Tiny.pm  view on Meta::CPAN

		# Check for a new document
		if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) {
			while ( @$lines and $lines->[0] !~ /^---/ ) {
				shift @$lines;
			}
			return 1;
		}

		# Check the indent level
		$lines->[0] =~ /^(\s*)/;
		if ( length($1) < $indent->[-1] ) {
			return 1;
		} elsif ( length($1) > $indent->[-1] ) {
			die \"YAML::Tiny found bad indenting in line '$lines->[0]'";
		}

		# Get the key
		unless ( $lines->[0] =~ s/^\s*([^\'\" ][^\n]*?)\s*:(\s+(?:\#.*)?|$)// ) {
			if ( $lines->[0] =~ /^\s*[?\'\"]/ ) {
				die \"YAML::Tiny does not support a feature in line '$lines->[0]'";
			}
			die \"YAML::Tiny failed to classify line '$lines->[0]'";
		}
		my $key = $1;

		# Do we have a value?
		if ( length $lines->[0] ) {
			# Yes
			$hash->{$key} = $self->_read_scalar( shift(@$lines), [ @$indent, undef ], $lines );
		} else {
			# An indent
			shift @$lines;
			unless ( @$lines ) {
				$hash->{$key} = undef;
				return 1;
			}
			if ( $lines->[0] =~ /^(\s*)-/ ) {
				$hash->{$key} = [];
				$self->_read_array( $hash->{$key}, [ @$indent, length($1) ], $lines );
			} elsif ( $lines->[0] =~ /^(\s*)./ ) {
				my $indent2 = length("$1");
				if ( $indent->[-1] >= $indent2 ) {
					# Null hash entry
					$hash->{$key} = undef;
				} else {
					$hash->{$key} = {};
					$self->_read_hash( $hash->{$key}, [ @$indent, length($1) ], $lines );
				}
			}
		}
	}

	return 1;
}

# Save an object to a file
sub write {

inc/YAML/Tiny.pm  view on Meta::CPAN

			Carp::croak("Cannot serialize " . ref($cursor));
		}
	}

	join '', map { "$_\n" } @lines;
}

sub _write_scalar {
	my $string = $_[1];
	return '~'  unless defined $string;
	return "''" unless length  $string;
	if ( $string =~ /[\x00-\x08\x0b-\x0d\x0e-\x1f\"\'\n]/ ) {
		$string =~ s/\\/\\\\/g;
		$string =~ s/"/\\"/g;
		$string =~ s/\n/\\n/g;
		$string =~ s/([\x00-\x1f])/\\$UNPRINTABLE[ord($1)]/g;
		return qq|"$string"|;
	}
	if ( $string =~ /(?:^\W|\s|:\z)/ or $QUOTE{$string} ) {
		return "'$string'";
	}



( run in 0.419 second using v1.01-cache-2.11-cpan-65fba6d93b7 )