App-cpanminus

 view release on metacpan or  search on metacpan

lib/App/cpanminus/fatscript.pm  view on Meta::CPAN

      return $uri;
  }
  
  sub file_get {
      my($self, $uri) = @_;
      my $file = $self->uri_to_file($uri);
      open my $fh, "<$file" or return;
      join '', <$fh>;
  }
  
  sub file_mirror {
      my($self, $uri, $path) = @_;
      my $file = $self->uri_to_file($uri);
  
      my $source_mtime = (stat $file)[9];
  
      # Don't mirror a file that's already there (like the index)
      return 1 if -e $path && (stat $path)[9] >= $source_mtime;
  
      File::Copy::copy($file, $path);
  
      utime $source_mtime, $source_mtime, $path;
  }
  
  sub has_working_lwp {
      my($self, $mirrors) = @_;
      my $https = grep /^https:/, @$mirrors;
      eval {
          require LWP::UserAgent; # no fatpack
          LWP::UserAgent->VERSION(5.802);
          require LWP::Protocol::https if $https; # no fatpack
          1;
      };
  }
  
  sub init_tools {
      my $self = shift;
  
      return if $self->{initialized}++;
  
      if ($self->{make} = $self->which($Config{make})) {
          $self->chat("You have make $self->{make}\n");
      }
  
      # use --no-lwp if they have a broken LWP, to upgrade LWP
      if ($self->{try_lwp} && $self->has_working_lwp($self->{mirrors})) {
          $self->chat("You have LWP $LWP::VERSION\n");
          my $ua = sub {
              LWP::UserAgent->new(
                  parse_head => 0,
                  env_proxy => 1,
                  agent => $self->agent,
                  timeout => 30,
                  @_,
              );
          };
          $self->{_backends}{get} = sub {
              my $self = shift;
              my $res = $ua->()->request(HTTP::Request->new(GET => $_[0]));
              return unless $res->is_success;
              return $res->decoded_content;
          };
          $self->{_backends}{mirror} = sub {
              my $self = shift;
              my $res = $ua->()->mirror(@_);
              die $res->content if $res->code == 501;
              $res->code;
          };
      } elsif ($self->{try_wget} and my $wget = $self->which('wget')) {
          $self->chat("You have $wget\n");
          my @common = (
              '--user-agent', $self->agent,
              '--retry-connrefused',
              ($self->{verbose} ? () : ('-q')),
          );
          $self->{_backends}{get} = sub {
              my($self, $uri) = @_;
              $self->safeexec( my $fh, $wget, $uri, @common, '-O', '-' ) or die "wget $uri: $!";
              local $/;
              <$fh>;
          };
          $self->{_backends}{mirror} = sub {
              my($self, $uri, $path) = @_;
              $self->safeexec( my $fh, $wget, $uri, @common, '-O', $path ) or die "wget $uri: $!";
              local $/;
              <$fh>;
          };
      } elsif ($self->{try_curl} and my $curl = $self->which('curl')) {
          $self->chat("You have $curl\n");
          my @common = (
              '--location',
              '--user-agent', $self->agent,
              ($self->{verbose} ? () : '-s'),
          );
          $self->{_backends}{get} = sub {
              my($self, $uri) = @_;
              $self->safeexec( my $fh, $curl, @common, $uri ) or die "curl $uri: $!";
              local $/;
              <$fh>;
          };
          $self->{_backends}{mirror} = sub {
              my($self, $uri, $path) = @_;
              $self->safeexec( my $fh, $curl, @common, $uri, '-#', '-o', $path ) or die "curl $uri: $!";
              local $/;
              <$fh>;
          };
      } else {
          require HTTP::Tiny;
          $self->chat("Falling back to HTTP::Tiny $HTTP::Tiny::VERSION\n");
          my %common = (
              agent => $self->agent,
          );
          $self->{_backends}{get} = sub {
              my $self = shift;
              my $res = HTTP::Tiny->new(%common)->get($_[0]);
              return unless $res->{success};
              return $res->{content};
          };
          $self->{_backends}{mirror} = sub {
              my $self = shift;
              my $res = HTTP::Tiny->new(%common)->mirror(@_);

lib/App/cpanminus/fatscript.pm  view on Meta::CPAN

  =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
  Perl.
  
  
  =head1 HOW DO I DECODE A DATA FROM OUTER AND ENCODE TO OUTER
  
  This section supposes that your perl vresion is 5.8 or later.
  
  If you know a JSON text from an outer world - a network, a file content, and so on,
  is encoded in UTF-8, you should use C<decode_json> or C<JSON> module object
  with C<utf8> enable. And the decoded result will contain UNICODE characters.
  
    # from network
    my $json        = JSON::PP->new->utf8;
    my $json_text   = CGI->new->param( 'json_data' );
    my $perl_scalar = $json->decode( $json_text );
    
    # from file content
    local $/;
    open( my $fh, '<', 'json.data' );
    $json_text   = <$fh>;
    $perl_scalar = decode_json( $json_text );
  
  If an outer data is not encoded in UTF-8, firstly you should C<decode> it.
  
    use Encode;
    local $/;
    open( my $fh, '<', 'json.data' );
    my $encoding = 'cp932';
    my $unicode_json_text = decode( $encoding, <$fh> ); # UNICODE
    
    # or you can write the below code.
    #
    # open( my $fh, "<:encoding($encoding)", 'json.data' );
    # $unicode_json_text = <$fh>;
  
  In this case, C<$unicode_json_text> is of course UNICODE string.
  So you B<cannot> use C<decode_json> nor C<JSON> module object with C<utf8> enable.
  Instead of them, you use C<JSON> module object with C<utf8> disable.
  
    $perl_scalar = $json->utf8(0)->decode( $unicode_json_text );
  
  Or C<encode 'utf8'> and C<decode_json>:
  
    $perl_scalar = decode_json( encode( 'utf8', $unicode_json_text ) );
    # this way is not efficient.
  
  And now, you want to convert your C<$perl_scalar> into JSON data and
  send it to an outer world - a network or a file content, and so on.
  
  Your data usually contains UNICODE strings and you want the converted data to be encoded
  in UTF-8, you should use C<encode_json> or C<JSON> module object with C<utf8> enable.
  
    print encode_json( $perl_scalar ); # to a network? file? or display?
    # or
    print $json->utf8->encode( $perl_scalar );
  
  If C<$perl_scalar> does not contain UNICODE but C<$encoding>-encoded strings
  for some reason, then its characters are regarded as B<latin1> for perl
  (because it does not concern with your $encoding).
  You B<cannot> use C<encode_json> nor C<JSON> module object with C<utf8> enable.
  Instead of them, you use C<JSON> module object with C<utf8> disable.
  Note that the resulted text is a UNICODE string but no problem to print it.
  
    # $perl_scalar contains $encoding encoded string values
    $unicode_json_text = $json->utf8(0)->encode( $perl_scalar );
    # $unicode_json_text consists of characters less than 0x100
    print $unicode_json_text;
  
  Or C<decode $encoding> all string values and C<encode_json>:
  

lib/App/cpanminus/fatscript.pm  view on Meta::CPAN

  sub is_indexable {
    my ($self, $package) = @_;
  
    my @indexable_packages = grep $_ ne 'main', $self->packages_inside;
  
    # check for specific package, if provided
    return !! grep $_ eq $package, @indexable_packages if $package;
  
    # otherwise, check for any indexable packages at all
    return !! @indexable_packages;
  }
  
  1;
  
  __END__
  
  =pod
  
  =encoding UTF-8
  
  =head1 NAME
  
  Module::Metadata - Gather package and POD information from perl module files
  
  =head1 VERSION
  
  version 1.000038
  
  =head1 SYNOPSIS
  
    use Module::Metadata;
  
    # information about a .pm file
    my $info = Module::Metadata->new_from_file( $file );
    my $version = $info->version;
  
    # CPAN META 'provides' field for .pm files in a directory
    my $provides = Module::Metadata->provides(
      dir => 'lib', version => 2
    );
  
  =head1 DESCRIPTION
  
  This module provides a standard way to gather metadata about a .pm file through
  (mostly) static analysis and (some) code execution.  When determining the
  version of a module, the C<$VERSION> assignment is C<eval>ed, as is traditional
  in the CPAN toolchain.
  
  =head1 CLASS METHODS
  
  =head2 C<< new_from_file($filename, collect_pod => 1, decode_pod => 1) >>
  
  Constructs a C<Module::Metadata> object given the path to a file.  Returns
  undef if the filename does not exist.
  
  C<collect_pod> is a optional boolean argument that determines whether POD
  data is collected and stored for reference.  POD data is not collected by
  default.  POD headings are always collected.
  
  If the file begins by an UTF-8, UTF-16BE or UTF-16LE byte-order mark, then
  it is skipped before processing, and the content of the file is also decoded
  appropriately starting from perl 5.8.
  
  Alternatively, if C<decode_pod> is set, it will decode the collected pod
  sections according to the C<=encoding> declaration.
  
  =head2 C<< new_from_handle($handle, $filename, collect_pod => 1, decode_pod => 1) >>
  
  This works just like C<new_from_file>, except that a handle can be provided
  as the first argument.
  
  Note that there is no validation to confirm that the handle is a handle or
  something that can act like one.  Passing something that isn't a handle will
  cause a exception when trying to read from it.  The C<filename> argument is
  mandatory or undef will be returned.
  
  You are responsible for setting the decoding layers on C<$handle> if
  required.
  
  =head2 C<< new_from_module($module, collect_pod => 1, inc => \@dirs, decode_pod => 1) >>
  
  Constructs a C<Module::Metadata> object given a module or package name.
  Returns undef if the module cannot be found.
  
  In addition to accepting the C<collect_pod> and C<decode_pod> arguments as
  described above, this method accepts a C<inc> argument which is a reference to
  an array of directories to search for the module.  If none are given, the
  default is @INC.
  
  If the file that contains the module begins by an UTF-8, UTF-16BE or
  UTF-16LE byte-order mark, then it is skipped before processing, and the
  content of the file is also decoded appropriately starting from perl 5.8.
  
  =head2 C<< find_module_by_name($module, \@dirs) >>
  
  Returns the path to a module given the module or package name. 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<< 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' => {

lib/App/cpanminus/fatscript.pm  view on Meta::CPAN

    croak $@ if $@;
    return $object;
  }
  
  1;
  
  __END__
  
  =pod
  
  =encoding UTF-8
  
  =head1 NAME
  
  Parse::CPAN::Meta - Parse META.yml and META.json CPAN metadata files
  
  =head1 VERSION
  
  version 1.4414
  
  =head1 SYNOPSIS
  
      #############################################
      # In your file
      
      ---
      name: My-Distribution
      version: 1.23
      resources:
        homepage: "http://example.com/dist/My-Distribution"
      
      
      #############################################
      # In your program
      
      use Parse::CPAN::Meta;
      
      my $distmeta = Parse::CPAN::Meta->load_file('META.yml');
      
      # Reading properties
      my $name     = $distmeta->{name};
      my $version  = $distmeta->{version};
      my $homepage = $distmeta->{resources}{homepage};
  
  =head1 DESCRIPTION
  
  B<Parse::CPAN::Meta> is a parser for F<META.json> and F<META.yml> files, using
  L<JSON::PP> and/or L<CPAN::Meta::YAML>.
  
  B<Parse::CPAN::Meta> provides three methods: C<load_file>, C<load_json_string>,
  and C<load_yaml_string>.  These will read and deserialize CPAN metafiles, and
  are described below in detail.
  
  B<Parse::CPAN::Meta> provides a legacy API of only two functions,
  based on the YAML functions of the same name. Wherever possible,
  identical calling semantics are used.  These may only be used with YAML sources.
  
  All error reporting is done with exceptions (die'ing).
  
  Note that META files are expected to be in UTF-8 encoding, only.  When
  converted string data, it must first be decoded from UTF-8.
  
  =begin Pod::Coverage
  
  
  
  
  =end Pod::Coverage
  
  =head1 METHODS
  
  =head2 load_file
  
    my $metadata_structure = Parse::CPAN::Meta->load_file('META.json');
  
    my $metadata_structure = Parse::CPAN::Meta->load_file('META.yml');
  
  This method will read the named file and deserialize it to a data structure,
  determining whether it should be JSON or YAML based on the filename.
  The file will be read using the ":utf8" IO layer.
  
  =head2 load_yaml_string
  
    my $metadata_structure = Parse::CPAN::Meta->load_yaml_string($yaml_string);
  
  This method deserializes the given string of YAML and returns the first
  document in it.  (CPAN metadata files should always have only one document.)
  If the source was UTF-8 encoded, the string must be decoded before calling
  C<load_yaml_string>.
  
  =head2 load_json_string
  
    my $metadata_structure = Parse::CPAN::Meta->load_json_string($json_string);
  
  This method deserializes the given string of JSON and the result.  
  If the source was UTF-8 encoded, the string must be decoded before calling
  C<load_json_string>.
  
  =head2 load_string
  
    my $metadata_structure = Parse::CPAN::Meta->load_string($some_string);
  
  If you don't know whether a string contains YAML or JSON data, this method
  will use some heuristics and guess.  If it can't tell, it assumes YAML.
  
  =head2 yaml_backend
  
    my $backend = Parse::CPAN::Meta->yaml_backend;
  
  Returns the module name of the YAML serializer. See L</ENVIRONMENT>
  for details.
  
  =head2 json_backend
  
    my $backend = Parse::CPAN::Meta->json_backend;
  
  Returns the module name of the JSON serializer.  This will either
  be L<JSON::PP> or L<JSON>.  Even if C<PERL_JSON_BACKEND> is set,
  this will return L<JSON> as further delegation is handled by
  the L<JSON> module.  See L</ENVIRONMENT> for details.
  
  =head1 FUNCTIONS
  
  For maintenance clarity, no functions are exported by default.  These functions
  are available for backwards compatibility only and are best avoided in favor of
  C<load_file>.
  
  =head2 Load
  
    my @yaml = Parse::CPAN::Meta::Load( $string );
  
  Parses a string containing a valid YAML stream into a list of Perl data
  structures.
  
  =head2 LoadFile
  
    my @yaml = Parse::CPAN::Meta::LoadFile( 'META.yml' );
  
  Reads the YAML stream from a file instead of a string.
  
  =head1 ENVIRONMENT
  
  =head2 PERL_JSON_BACKEND
  
  By default, L<JSON::PP> will be used for deserializing JSON data. If the
  C<PERL_JSON_BACKEND> environment variable exists, is true and is not
  "JSON::PP", then the L<JSON> module (version 2.5 or greater) will be loaded and
  used to interpret C<PERL_JSON_BACKEND>.  If L<JSON> is not installed or is too
  old, an exception will be thrown.
  
  =head2 PERL_YAML_BACKEND
  
  By default, L<CPAN::Meta::YAML> will be used for deserializing YAML data. If
  the C<PERL_YAML_BACKEND> environment variable is defined, then it is interpreted
  as a module to use for deserialization.  The given module must be installed,
  must load correctly and must implement the C<Load()> function or an exception



( run in 1.696 second using v1.01-cache-2.11-cpan-600a1bdf6e4 )