App-cpanminus
view release on metacpan or search on metacpan
lib/App/cpanminus/fatscript.pm view on Meta::CPAN
# Iterate over the documents
my $indent = 0;
my @lines = ();
eval {
foreach my $cursor ( @$self ) {
push @lines, '---';
# An empty document
if ( ! defined $cursor ) {
# Do nothing
# A scalar document
} elsif ( ! ref $cursor ) {
$lines[-1] .= ' ' . $self->_dump_scalar( $cursor );
# A list at the root
} elsif ( ref $cursor eq 'ARRAY' ) {
unless ( @$cursor ) {
$lines[-1] .= ' []';
next;
}
push @lines, $self->_dump_array( $cursor, $indent, {} );
# A hash at the root
} elsif ( ref $cursor eq 'HASH' ) {
unless ( %$cursor ) {
$lines[-1] .= ' {}';
next;
}
push @lines, $self->_dump_hash( $cursor, $indent, {} );
} else {
die \("Cannot serialize " . ref($cursor));
}
}
};
if ( ref $@ eq 'SCALAR' ) {
$self->_error(${$@});
} elsif ( $@ ) {
$self->_error($@);
}
join '', map { "$_\n" } @lines;
}
sub _has_internal_string_value {
my $value = shift;
my $b_obj = B::svref_2object(\$value); # for round trip problem
return $b_obj->FLAGS & B::SVf_POK();
}
sub _dump_scalar {
my $string = $_[1];
my $is_key = $_[2];
# Check this before checking length or it winds up looking like a string!
my $has_string_flag = _has_internal_string_value($string);
return '~' unless defined $string;
return "''" unless length $string;
if (Scalar::Util::looks_like_number($string)) {
# keys and values that have been used as strings get quoted
if ( $is_key || $has_string_flag ) {
return qq['$string'];
}
else {
return $string;
}
}
if ( $string =~ /[\x00-\x09\x0b-\x0d\x0e-\x1f\x7f-\x9f\'\n]/ ) {
$string =~ s/\\/\\\\/g;
$string =~ s/"/\\"/g;
$string =~ s/\n/\\n/g;
$string =~ s/[\x85]/\\N/g;
$string =~ s/([\x00-\x1f])/\\$UNPRINTABLE[ord($1)]/g;
$string =~ s/([\x7f-\x9f])/'\x' . sprintf("%X",ord($1))/ge;
return qq|"$string"|;
}
if ( $string =~ /(?:^[~!@#%&*|>?:,'"`{}\[\]]|^-+$|\s|:\z)/ or
$QUOTE{$string}
) {
return "'$string'";
}
return $string;
}
sub _dump_array {
my ($self, $array, $indent, $seen) = @_;
if ( $seen->{refaddr($array)}++ ) {
die \"CPAN::Meta::YAML does not support circular references";
}
my @lines = ();
foreach my $el ( @$array ) {
my $line = (' ' x $indent) . '-';
my $type = ref $el;
if ( ! $type ) {
$line .= ' ' . $self->_dump_scalar( $el );
push @lines, $line;
} elsif ( $type eq 'ARRAY' ) {
if ( @$el ) {
push @lines, $line;
push @lines, $self->_dump_array( $el, $indent + 1, $seen );
} else {
$line .= ' []';
push @lines, $line;
}
} elsif ( $type eq 'HASH' ) {
if ( keys %$el ) {
push @lines, $line;
push @lines, $self->_dump_hash( $el, $indent + 1, $seen );
} else {
$line .= ' {}';
push @lines, $line;
}
} else {
die \"CPAN::Meta::YAML does not support $type references";
}
}
lib/App/cpanminus/fatscript.pm view on Meta::CPAN
All listed symbols must be in your C<@EXPORT> or C<@EXPORT_OK>, else an error
occurs. The advanced export features of Exporter are accessed like this,
but with list entries that are syntactically distinct from symbol names.
=back
Unless you want to use its advanced features, this is probably all you
need to know to use Exporter.
=head1 Advanced Features
=head2 Specialised Import Lists
If any of the entries in an import list begins with !, : or / then
the list is treated as a series of specifications which either add to
or delete from the list of names to import. They are processed left to
right. Specifications are in the form:
[!]name This name only
[!]:DEFAULT All names in @EXPORT
[!]:tag All names in $EXPORT_TAGS{tag} anonymous list
[!]/pattern/ All names in @EXPORT and @EXPORT_OK which match
A leading ! indicates that matching names should be deleted from the
list of names to import. If the first specification is a deletion it
is treated as though preceded by :DEFAULT. If you just want to import
extra names in addition to the default set you will still need to
include :DEFAULT explicitly.
e.g., F<Module.pm> defines:
@EXPORT = qw(A1 A2 A3 A4 A5);
@EXPORT_OK = qw(B1 B2 B3 B4 B5);
%EXPORT_TAGS = (T1 => [qw(A1 A2 B1 B2)], T2 => [qw(A1 A2 B3 B4)]);
Note that you cannot use tags in @EXPORT or @EXPORT_OK.
Names in EXPORT_TAGS must also appear in @EXPORT or @EXPORT_OK.
An application using Module can say something like:
use Module qw(:DEFAULT :T2 !B3 A3);
Other examples include:
use Socket qw(!/^[AP]F_/ !SOMAXCONN !SOL_SOCKET);
use POSIX qw(:errno_h :termios_h !TCSADRAIN !/^EXIT/);
Remember that most patterns (using //) will need to be anchored
with a leading ^, e.g., C</^EXIT/> rather than C</EXIT/>.
You can say C<BEGIN { $Exporter::Verbose=1 }> to see how the
specifications are being processed and what is actually being imported
into modules.
=head2 Exporting Without Using Exporter's import Method
Exporter has a special method, 'export_to_level' which is used in situations
where you can't directly call Exporter's
import method. The export_to_level
method looks like:
MyPackage->export_to_level(
$where_to_export, $package, @what_to_export
);
where C<$where_to_export> is an integer telling how far up the calling stack
to export your symbols, and C<@what_to_export> is an array telling what
symbols *to* export (usually this is C<@_>). The C<$package> argument is
currently unused.
For example, suppose that you have a module, A, which already has an
import function:
package A;
@ISA = qw(Exporter);
@EXPORT_OK = qw($b);
sub import
{
$A::b = 1; # not a very useful import method
}
and you want to Export symbol C<$A::b> back to the module that called
package A. Since Exporter relies on the import method to work, via
inheritance, as it stands Exporter::import() will never get called.
Instead, say the following:
package A;
@ISA = qw(Exporter);
@EXPORT_OK = qw($b);
sub import
{
$A::b = 1;
A->export_to_level(1, @_);
}
This will export the symbols one level 'above' the current package - ie: to
the program or module that used package A.
Note: Be careful not to modify C<@_> at all before you call export_to_level
- or people using your package will get very unexplained results!
=head2 Exporting Without Inheriting from Exporter
By including Exporter in your C<@ISA> you inherit an Exporter's import() method
but you also inherit several other helper methods which you probably don't
want. To avoid this you can do:
package YourModule;
use Exporter qw(import);
which will export Exporter's own import() method into YourModule.
Everything will work as before but you won't need to include Exporter in
C<@YourModule::ISA>.
Note: This feature was introduced in version 5.57
of Exporter, released with perl 5.8.3.
lib/App/cpanminus/fatscript.pm view on Meta::CPAN
# exported functions, they croak on error
# and expect/generate UTF-8
$utf8_encoded_json_text = encode_json $perl_hash_or_arrayref;
$perl_hash_or_arrayref = decode_json $utf8_encoded_json_text;
# OO-interface
$coder = JSON::PP->new->ascii->pretty->allow_nonref;
$json_text = $json->encode( $perl_scalar );
$perl_scalar = $json->decode( $json_text );
$pretty_printed = $json->pretty->encode( $perl_scalar ); # pretty-printing
# Note that JSON version 2.0 and above will automatically use
# JSON::XS or JSON::PP, so you should be able to just:
use JSON;
=head1 VERSION
2.27300
L<JSON::XS> 2.27 (~2.30) compatible.
=head1 NOTE
JSON::PP had been inculded in JSON distribution (CPAN module).
It was a perl core module in Perl 5.14.
=head1 DESCRIPTION
This module is L<JSON::XS> compatible pure Perl module.
(Perl 5.8 or later is recommended)
JSON::XS is the fastest and most proper JSON module on CPAN.
It is written by Marc Lehmann in C, so must be compiled and
installed in the used environment.
JSON::PP is a pure-Perl module and has compatibility to JSON::XS.
=head2 FEATURES
=over
=item * correct unicode handling
This module knows how to handle Unicode (depending on Perl version).
See to L<JSON::XS/A FEW NOTES ON UNICODE AND PERL> and L<UNICODE HANDLING ON PERLS>.
=item * round-trip integrity
When you serialise a perl data structure using only data types supported
by JSON and Perl, the deserialised data structure is identical on the Perl
level. (e.g. the string "2.0" doesn't suddenly become "2" just because
it looks like a number). There I<are> minor exceptions to this, read the
MAPPING section below to learn about those.
=item * strict checking of JSON correctness
There is no guessing, no generating of illegal JSON texts by default,
and only JSON is accepted as input by default (the latter is a security feature).
But when some options are set, loose chcking features are available.
=back
=head1 FUNCTIONAL INTERFACE
Some documents are copied and modified from L<JSON::XS/FUNCTIONAL INTERFACE>.
=head2 encode_json
$json_text = encode_json $perl_scalar
Converts the given Perl data structure to a UTF-8 encoded, binary string.
This function call is functionally identical to:
$json_text = JSON::PP->new->utf8->encode($perl_scalar)
=head2 decode_json
$perl_scalar = decode_json $json_text
The opposite of C<encode_json>: expects an UTF-8 (binary) string and tries
to parse that as an UTF-8 encoded JSON text, returning the resulting
reference.
This function call is functionally identical to:
$perl_scalar = JSON::PP->new->utf8->decode($json_text)
=head2 JSON::PP::is_bool
$is_boolean = JSON::PP::is_bool($scalar)
Returns true if the passed scalar represents either JSON::PP::true or
JSON::PP::false, two constants that act like C<1> and C<0> respectively
and are also used to represent JSON C<true> and C<false> in Perl strings.
=head2 JSON::PP::true
Returns JSON true value which is blessed object.
It C<isa> JSON::PP::Boolean object.
=head2 JSON::PP::false
Returns JSON false value which is blessed object.
It C<isa> JSON::PP::Boolean object.
=head2 JSON::PP::null
Returns C<undef>.
See L<MAPPING>, below, for more information on how JSON values are mapped to
lib/App/cpanminus/fatscript.pm view on Meta::CPAN
returns other blessed objects, those will be handled in the same
way. C<TO_JSON> must take care of not causing an endless recursion cycle
(== crash) in this case. The name of C<TO_JSON> was chosen because other
methods called by the Perl core (== not by the user of the object) are
usually in upper case letters and to avoid collisions with the C<to_json>
function or method.
This setting does not yet influence C<decode> in any way.
If C<$enable> is false, then the C<allow_blessed> setting will decide what
to do when a blessed object is found.
=head2 filter_json_object
$json = $json->filter_json_object([$coderef])
When C<$coderef> is specified, it will be called from C<decode> each
time it decodes a JSON object. The only argument passed to the coderef
is a reference to the newly-created hash. If the code references returns
a single scalar (which need not be a reference), this value
(i.e. a copy of that scalar to avoid aliasing) is inserted into the
deserialised data structure. If it returns an empty list
(NOTE: I<not> C<undef>, which is a valid scalar), the original deserialised
hash will be inserted. This setting can slow down decoding considerably.
When C<$coderef> is omitted or undefined, any existing callback will
be removed and C<decode> will not change the deserialised hash in any
way.
Example, convert all JSON objects into the integer 5:
my $js = JSON::PP->new->filter_json_object (sub { 5 });
# returns [5]
$js->decode ('[{}]'); # the given subroutine takes a hash reference.
# throw an exception because allow_nonref is not enabled
# so a lone 5 is not allowed.
$js->decode ('{"a":1, "b":2}');
=head2 filter_json_single_key_object
$json = $json->filter_json_single_key_object($key [=> $coderef])
Works remotely similar to C<filter_json_object>, but is only called for
JSON objects having a single key named C<$key>.
This C<$coderef> is called before the one specified via
C<filter_json_object>, if any. It gets passed the single value in the JSON
object. If it returns a single value, it will be inserted into the data
structure. If it returns nothing (not even C<undef> but the empty list),
the callback from C<filter_json_object> will be called next, as if no
single-key callback were specified.
If C<$coderef> is omitted or undefined, the corresponding callback will be
disabled. There can only ever be one callback for a given key.
As this callback gets called less often then the C<filter_json_object>
one, decoding speed will not usually suffer as much. Therefore, single-key
objects make excellent targets to serialise Perl objects into, especially
as single-key JSON objects are as close to the type-tagged value concept
as JSON gets (it's basically an ID/VALUE tuple). Of course, JSON does not
support this in any way, so you need to make sure your data never looks
like a serialised Perl hash.
Typical names for the single object key are C<__class_whatever__>, or
C<$__dollars_are_rarely_used__$> or C<}ugly_brace_placement>, or even
things like C<__class_md5sum(classname)__>, to reduce the risk of clashing
with real hashes.
Example, decode JSON objects of the form C<< { "__widget__" => <id> } >>
into the corresponding C<< $WIDGET{<id>} >> object:
# return whatever is in $WIDGET{5}:
JSON::PP
->new
->filter_json_single_key_object (__widget__ => sub {
$WIDGET{ $_[0] }
})
->decode ('{"__widget__": 5')
# this can be used with a TO_JSON method in some "widget" class
# for serialisation to json:
sub WidgetBase::TO_JSON {
my ($self) = @_;
unless ($self->{id}) {
$self->{id} = ..get..some..id..;
$WIDGET{$self->{id}} = $self;
}
{ __widget__ => $self->{id} }
}
=head2 shrink
$json = $json->shrink([$enable])
$enabled = $json->get_shrink
In JSON::XS, this flag resizes strings generated by either
C<encode> or C<decode> to their minimum size possible.
It will also try to downgrade any strings to octet-form if possible.
In JSON::PP, it is noop about resizing strings but tries
C<utf8::downgrade> to the returned string by C<encode>.
See to L<utf8>.
See to L<JSON::XS/OBJECT-ORIENTED INTERFACE>
=head2 max_depth
$json = $json->max_depth([$maximum_nesting_depth])
$max_depth = $json->get_max_depth
Sets the maximum nesting level (default C<512>) accepted while encoding
or decoding. If a higher nesting level is detected in JSON text or a Perl
data structure, then the encoder and decoder will stop and croak at that
point.
Nesting level is defined by number of hash- or arrayrefs that the encoder
needs to traverse to reach a given point or the number of C<{> or C<[>
lib/App/cpanminus/fatscript.pm view on Meta::CPAN
if ($self->{filename} =~ /\.pm$/) {
my ($v, $d, $f) = File::Spec->splitpath($self->{filename});
$f =~ s/\..+$//;
my @candidates = grep /(^|::)$f$/, @{$self->{packages}};
$self->{module} = shift(@candidates); # this may be undef
}
else {
# this seems like an atrocious heuristic, albeit marginally better than
# what was here before. It should be rewritten entirely to be more like
# "if it's not a .pm file, it's not require()able as a name, therefore
# name() should be undef."
if ((grep /main/, @{$self->{packages}})
or (grep /main/, keys %{$self->{versions}})) {
$self->{module} = 'main';
}
else {
# TODO: this should maybe default to undef instead
$self->{module} = $self->{packages}[0] || '';
}
}
}
$self->{version} = $self->{versions}{$self->{module}}
if defined( $self->{module} );
return $self;
}
# class method
sub _do_find_module {
my $class = shift;
my $module = shift || croak 'find_module_by_name() requires a package name';
my $dirs = shift || \@INC;
my $file = File::Spec->catfile(split( /::/, $module));
foreach my $dir ( @$dirs ) {
my $testfile = File::Spec->catfile($dir, $file);
return [ File::Spec->rel2abs( $testfile ), $dir ]
if -e $testfile and !-d _; # For stuff like ExtUtils::xsubpp
# CAVEAT (possible TODO): .pmc files are not discoverable here
$testfile .= '.pm';
return [ File::Spec->rel2abs( $testfile ), $dir ]
if -e $testfile;
}
return;
}
# class method
sub find_module_by_name {
my $found = shift()->_do_find_module(@_) or return;
return $found->[0];
}
# class method
sub find_module_dir_by_name {
my $found = shift()->_do_find_module(@_) or return;
return $found->[1];
}
# given a line of perl code, attempt to parse it if it looks like a
# $VERSION assignment, returning sigil, full name, & package name
sub _parse_version_expression {
my $self = shift;
my $line = shift;
my( $sigil, $variable_name, $package);
if ( $line =~ /$VERS_REGEXP/o ) {
( $sigil, $variable_name, $package) = $2 ? ( $1, $2, $3 ) : ( $4, $5, $6 );
if ( $package ) {
$package = ($package eq '::') ? 'main' : $package;
$package =~ s/::$//;
}
}
return ( $sigil, $variable_name, $package );
}
# Look for a UTF-8/UTF-16BE/UTF-16LE BOM at the beginning of the stream.
# If there's one, then skip it and set the :encoding layer appropriately.
sub _handle_bom {
my ($self, $fh, $filename) = @_;
my $pos = tell $fh;
return unless defined $pos;
my $buf = ' ' x 2;
my $count = read $fh, $buf, length $buf;
return unless defined $count and $count >= 2;
my $encoding;
if ( $buf eq "\x{FE}\x{FF}" ) {
$encoding = 'UTF-16BE';
}
elsif ( $buf eq "\x{FF}\x{FE}" ) {
$encoding = 'UTF-16LE';
}
elsif ( $buf eq "\x{EF}\x{BB}" ) {
$buf = ' ';
$count = read $fh, $buf, length $buf;
if ( defined $count and $count >= 1 and $buf eq "\x{BF}" ) {
$encoding = 'UTF-8';
}
}
if ( defined $encoding ) {
if ( "$]" >= 5.008 ) {
binmode( $fh, ":encoding($encoding)" );
}
}
else {
seek $fh, $pos, SEEK_SET
or croak( sprintf "Can't reset position to the top of '$filename'" );
}
return $encoding;
}
sub _parse_fh {
my ($self, $fh) = @_;
lib/App/cpanminus/fatscript.pm view on Meta::CPAN
=head2 C<< find_module_dir_by_name($module, \@dirs) >>
Returns the entry in C<@dirs> (or C<@INC> by default) that contains
the module C<$module>. A list of directories can be passed in as an
optional parameter, otherwise @INC is searched.
Can be called as either an object or a class method.
=head2 C<< provides( %options ) >>
This is a convenience wrapper around C<package_versions_from_directory>
to generate a CPAN META C<provides> data structure. It takes key/value
pairs. Valid option keys include:
=over
=item version B<(required)>
Specifies which version of the L<CPAN::Meta::Spec> should be used as
the format of the C<provides> output. Currently only '1.4' and '2'
are supported (and their format is identical). This may change in
the future as the definition of C<provides> changes.
The C<version> option is required. If it is omitted or if
an unsupported version is given, then C<provides> will throw an error.
=item dir
Directory to search recursively for F<.pm> files. May not be specified with
C<files>.
=item files
Array reference of files to examine. May not be specified with C<dir>.
=item prefix
String to prepend to the C<file> field of the resulting output. This defaults
to F<lib>, which is the common case for most CPAN distributions with their
F<.pm> files in F<lib>. This option ensures the META information has the
correct relative path even when the C<dir> or C<files> arguments are
absolute or have relative paths from a location other than the distribution
root.
=back
For example, given C<dir> of 'lib' and C<prefix> of 'lib', the return value
is a hashref of the form:
{
'Package::Name' => {
version => '0.123',
file => 'lib/Package/Name.pm'
},
'OtherPackage::Name' => ...
}
=head2 C<< package_versions_from_directory($dir, \@files?) >>
Scans C<$dir> for .pm files (unless C<@files> is given, in which case looks
for those files in C<$dir> - and reads each file for packages and versions,
returning a hashref of the form:
{
'Package::Name' => {
version => '0.123',
file => 'Package/Name.pm'
},
'OtherPackage::Name' => ...
}
The C<DB> and C<main> packages are always omitted, as are any "private"
packages that have leading underscores in the namespace (e.g.
C<Foo::_private>)
Note that the file path is relative to C<$dir> if that is specified.
This B<must not> be used directly for CPAN META C<provides>. See
the C<provides> method instead.
=head2 C<< log_info (internal) >>
Used internally to perform logging; imported from Log::Contextual if
Log::Contextual has already been loaded, otherwise simply calls warn.
=head1 OBJECT METHODS
=head2 C<< name() >>
Returns the name of the package represented by this module. If there
is more than one package, it makes a best guess based on the
filename. If it's a script (i.e. not a *.pm) the package name is
'main'.
=head2 C<< version($package) >>
Returns the version as defined by the $VERSION variable for the
package as returned by the C<name> method if no arguments are
given. If given the name of a package it will attempt to return the
version of that package if it is specified in the file.
=head2 C<< filename() >>
Returns the absolute path to the file.
Note that this file may not actually exist on disk yet, e.g. if the module was read from an in-memory filehandle.
=head2 C<< packages_inside() >>
Returns a list of packages. Note: this is a raw list of packages
discovered (or assumed, in the case of C<main>). It is not
filtered for C<DB>, C<main> or private packages the way the
C<provides> method does. Invalid package names are not returned,
for example "Foo:Bar". Strange but valid package names are
returned, for example "Foo::Bar::", and are left up to the caller
on how to handle.
=head2 C<< pod_inside() >>
Returns a list of POD sections.
=head2 C<< contains_pod() >>
lib/App/cpanminus/fatscript.pm view on Meta::CPAN
Kent Fredric <kentnl@cpan.org>
=item *
Leon Timmermans <fawaka@gmail.com>
=item *
Peter Rabbitson <ribasushi@cpan.org>
=item *
Steve Hay <steve.m.hay@googlemail.com>
=back
=head1 COPYRIGHT & LICENSE
Original code Copyright (c) 2001-2011 Ken Williams.
Additional code Copyright (c) 2010-2011 Matt Trout and David Golden.
All rights reserved.
This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=cut
MODULE_METADATA
$fatpacked{"Parse/CPAN/Meta.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PARSE_CPAN_META';
use 5.008001;
use strict;
package Parse::CPAN::Meta;
# ABSTRACT: Parse META.yml and META.json CPAN metadata files
our $VERSION = '1.4414'; # VERSION
use Exporter;
use Carp 'croak';
our @ISA = qw/Exporter/;
our @EXPORT_OK = qw/Load LoadFile/;
sub load_file {
my ($class, $filename) = @_;
my $meta = _slurp($filename);
if ($filename =~ /\.ya?ml$/) {
return $class->load_yaml_string($meta);
}
elsif ($filename =~ /\.json$/) {
return $class->load_json_string($meta);
}
else {
$class->load_string($meta); # try to detect yaml/json
}
}
sub load_string {
my ($class, $string) = @_;
if ( $string =~ /^---/ ) { # looks like YAML
return $class->load_yaml_string($string);
}
elsif ( $string =~ /^\s*\{/ ) { # looks like JSON
return $class->load_json_string($string);
}
else { # maybe doc-marker-free YAML
return $class->load_yaml_string($string);
}
}
sub load_yaml_string {
my ($class, $string) = @_;
my $backend = $class->yaml_backend();
my $data = eval { no strict 'refs'; &{"$backend\::Load"}($string) };
croak $@ if $@;
return $data || {}; # in case document was valid but empty
}
sub load_json_string {
my ($class, $string) = @_;
my $data = eval { $class->json_backend()->new->decode($string) };
croak $@ if $@;
return $data || {};
}
sub yaml_backend {
if (! defined $ENV{PERL_YAML_BACKEND} ) {
_can_load( 'CPAN::Meta::YAML', 0.011 )
or croak "CPAN::Meta::YAML 0.011 is not available\n";
return "CPAN::Meta::YAML";
}
else {
my $backend = $ENV{PERL_YAML_BACKEND};
_can_load( $backend )
or croak "Could not load PERL_YAML_BACKEND '$backend'\n";
$backend->can("Load")
or croak "PERL_YAML_BACKEND '$backend' does not implement Load()\n";
return $backend;
}
}
sub json_backend {
if (! $ENV{PERL_JSON_BACKEND} or $ENV{PERL_JSON_BACKEND} eq 'JSON::PP') {
_can_load( 'JSON::PP' => 2.27103 )
or croak "JSON::PP 2.27103 is not available\n";
return 'JSON::PP';
}
else {
_can_load( 'JSON' => 2.5 )
or croak "JSON 2.5 is required for " .
"\$ENV{PERL_JSON_BACKEND} = '$ENV{PERL_JSON_BACKEND}'\n";
return "JSON";
}
}
sub _slurp {
require Encode;
open my $fh, "<:raw", "$_[0]" ## no critic
or die "can't open $_[0] for reading: $!";
my $content = do { local $/; <$fh> };
$content = Encode::decode('UTF-8', $content, Encode::PERLQQ());
return $content;
}
lib/App/cpanminus/fatscript.pm view on Meta::CPAN
local @ENV{qw(PATH IFS CDPATH ENV BASH_ENV)};
my $cmd = $drive ? "eval { Cwd::getdcwd(q($drive)) }"
: 'getcwd';
my $cwd = `"$_PERL" -MCwd -le "print $cmd"`;
chomp $cwd;
if (!length $cwd && $drive) {
$cwd = $drive;
}
$cwd =~ s/$_DIR_SPLIT?$/$_DIR_JOIN/;
$cwd;
}
sub _catdir {
if (_USE_FSPEC) {
require File::Spec;
File::Spec->catdir(@_);
}
else {
my $dir = join($_DIR_JOIN, @_);
$dir =~ s{($_DIR_SPLIT)(?:\.?$_DIR_SPLIT)+}{$1}g;
$dir;
}
}
sub _is_abs {
if (_USE_FSPEC) {
require File::Spec;
File::Spec->file_name_is_absolute($_[0]);
}
else {
$_[0] =~ $_ROOT;
}
}
sub _rel2abs {
my ($dir, $base) = @_;
return $dir
if _is_abs($dir);
$base = _WIN32 && $dir =~ s/^([A-Za-z]:)// ? _cwd("$1")
: $base ? $base
: _cwd;
return _catdir($base, $dir);
}
sub import {
my ($class, @args) = @_;
push @args, @ARGV
if $0 eq '-';
my @steps;
my %opts;
my $shelltype;
while (@args) {
my $arg = shift @args;
# check for lethal dash first to stop processing before causing problems
# the fancy dash is U+2212 or \xE2\x88\x92
if ($arg =~ /\xE2\x88\x92/ or $arg =~ /−/) {
die <<'DEATH';
WHOA THERE! It looks like you've got some fancy dashes in your commandline!
These are *not* the traditional -- dashes that software recognizes. You
probably got these by copy-pasting from the perldoc for this module as
rendered by a UTF8-capable formatter. This most typically happens on an OS X
terminal, but can happen elsewhere too. Please try again after replacing the
dashes with normal minus signs.
DEATH
}
elsif ($arg eq '--self-contained') {
die <<'DEATH';
FATAL: The local::lib --self-contained flag has never worked reliably and the
original author, Mark Stosberg, was unable or unwilling to maintain it. As
such, this flag has been removed from the local::lib codebase in order to
prevent misunderstandings and potentially broken builds. The local::lib authors
recommend that you look at the lib::core::only module shipped with this
distribution in order to create a more robust environment that is equivalent to
what --self-contained provided (although quite possibly not what you originally
thought it provided due to the poor quality of the documentation, for which we
apologise).
DEATH
}
elsif( $arg =~ /^--deactivate(?:=(.*))?$/ ) {
my $path = defined $1 ? $1 : shift @args;
push @steps, ['deactivate', $path];
}
elsif ( $arg eq '--deactivate-all' ) {
push @steps, ['deactivate_all'];
}
elsif ( $arg =~ /^--shelltype(?:=(.*))?$/ ) {
$shelltype = defined $1 ? $1 : shift @args;
}
elsif ( $arg eq '--no-create' ) {
$opts{no_create} = 1;
}
elsif ( $arg =~ /^--/ ) {
die "Unknown import argument: $arg";
}
else {
push @steps, ['activate', $arg];
}
}
if (!@steps) {
push @steps, ['activate', undef];
}
my $self = $class->new(%opts);
for (@steps) {
my ($method, @args) = @$_;
$self = $self->$method(@args);
}
if ($0 eq '-') {
print $self->environment_vars_string($shelltype);
exit 0;
}
else {
$self->setup_local_lib;
}
}
lib/App/cpanminus/fatscript.pm view on Meta::CPAN
assumed to be a C shell or something compatible, and everything else is assumed
to be Bourne, except on Win32 systems. If the C<SHELL> environment variable is
not set, a Bourne-compatible shell is assumed.
=item * Kills any existing PERL_MM_OPT or PERL_MB_OPT.
=item * Should probably auto-fixup CPAN config if not already done.
=item * On VMS and MacOS Classic (pre-OS X), local::lib loads L<File::Spec>.
This means any L<File::Spec> version installed in the local::lib will be
ignored by scripts using local::lib. A workaround for this is using
C<use lib "$local_lib/lib/perl5";> instead of using C<local::lib> directly.
=item * Conflicts with L<ExtUtils::MakeMaker>'s C<PREFIX> option.
C<local::lib> uses the C<INSTALL_BASE> option, as it has more predictable and
sane behavior. If something attempts to use the C<PREFIX> option when running
a F<Makefile.PL>, L<ExtUtils::MakeMaker> will refuse to run, as the two
options conflict. This can be worked around by temporarily unsetting the
C<PERL_MM_OPT> environment variable.
=item * Conflicts with L<Module::Build>'s C<--prefix> option. Similar to the
previous limitation, but any C<--prefix> option specified will be ignored.
This can be worked around by temporarily unsetting the C<PERL_MB_OPT>
environment variable.
=back
Patches very much welcome for any of the above.
=over 4
=item * On Win32 systems, does not have a way to write the created environment
variables to the registry, so that they can persist through a reboot.
=back
=head1 TROUBLESHOOTING
If you've configured local::lib to install CPAN modules somewhere in to your
home directory, and at some point later you try to install a module with C<cpan
-i Foo::Bar>, but it fails with an error like: C<Warning: You do not have
permissions to install into /usr/lib64/perl5/site_perl/5.8.8/x86_64-linux at
/usr/lib64/perl5/5.8.8/Foo/Bar.pm> and buried within the install log is an
error saying C<'INSTALL_BASE' is not a known MakeMaker parameter name>, then
you've somehow lost your updated ExtUtils::MakeMaker module.
To remedy this situation, rerun the bootstrapping procedure documented above.
Then, run C<rm -r ~/.cpan/build/Foo-Bar*>
Finally, re-run C<cpan -i Foo::Bar> and it should install without problems.
=head1 ENVIRONMENT
=over 4
=item SHELL
=item COMSPEC
local::lib looks at the user's C<SHELL> environment variable when printing out
commands to add to the shell configuration file.
On Win32 systems, C<COMSPEC> is also examined.
=back
=head1 SEE ALSO
=over 4
=item * L<Perl Advent article, 2011|http://perladvent.org/2011/2011-12-01.html>
=back
=head1 SUPPORT
IRC:
Join #local-lib on irc.perl.org.
=head1 AUTHOR
Matt S Trout <mst@shadowcat.co.uk> http://www.shadowcat.co.uk/
auto_install fixes kindly sponsored by http://www.takkle.com/
=head1 CONTRIBUTORS
Patches to correctly output commands for csh style shells, as well as some
documentation additions, contributed by Christopher Nehren <apeiron@cpan.org>.
Doc patches for a custom local::lib directory, more cleanups in the english
documentation and a L<german documentation|POD2::DE::local::lib> contributed by
Torsten Raudssus <torsten@raudssus.de>.
Hans Dieter Pearcey <hdp@cpan.org> sent in some additional tests for ensuring
things will install properly, submitted a fix for the bug causing problems with
writing Makefiles during bootstrapping, contributed an example program, and
submitted yet another fix to ensure that local::lib can install and bootstrap
properly. Many, many thanks!
pattern of Freenode IRC contributed the beginnings of the Troubleshooting
section. Many thanks!
Patch to add Win32 support contributed by Curtis Jewell <csjewell@cpan.org>.
Warnings for missing PATH/PERL5LIB (as when not running interactively) silenced
by a patch from Marco Emilio Poleggi.
Mark Stosberg <mark@summersault.com> provided the code for the now deleted
'--self-contained' option.
Documentation patches to make win32 usage clearer by
David Mertens <dcmertens.perl@gmail.com> (run4flat).
Brazilian L<portuguese translation|POD2::PT_BR::local::lib> and minor doc
patches contributed by Breno G. de Oliveira <garu@cpan.org>.
Improvements to stacking multiple local::lib dirs and removing them from the
environment later on contributed by Andrew Rodland <arodland@cpan.org>.
( run in 2.520 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )