Alien-ROOT

 view release on metacpan or  search on metacpan

inc/inc_File-Fetch/File/Fetch.pm  view on Meta::CPAN

                 "Could not open '%1' for writing: %2",$to,$!));
        }

        $fh->autoflush(1);
        binmode $fh;

        my $path = File::Spec::Unix->catfile( $self->path, $self->file );
        my $req = "GET $path HTTP/1.0\x0d\x0aHost: " . $self->host . "\x0d\x0a\x0d\x0a";
        $sock->send( $req );

        my $select = IO::Select->new( $sock );

        my $resp = '';
        my $normal = 0;
        while ( $select->can_read( $TIMEOUT || 60 ) ) {
          my $ret = $sock->sysread( $resp, 4096, length($resp) );
          if ( !defined $ret or $ret == 0 ) {
            $select->remove( $sock );
            $normal++;
          }
        }
        close $sock;

        unless ( $normal ) {
            return $self->_error(loc("Socket timed out after '%1' seconds", ( $TIMEOUT || 60 )));
        }

        # Check the "response"

inc/inc_IPC-Cmd/IPC/Cmd.pm  view on Meta::CPAN

      'block_size' => ($child_out->stat)[11] || 1024,
      },
    $child_err->fileno => {
      'parent_socket' => $opts->{'parent_stderr'},
      'scalar_buffer' => "",
      'child_handle' => $child_err,
      'block_size' => ($child_err->stat)[11] || 1024,
      },
    };

  my $select = IO::Select->new();
  $select->add($child_out, $child_err);

  # pass any signal to the child
  # effectively creating process
  # strongly attached to the child:
  # it will terminate only after child
  # has terminated (except for SIGKILL,
  # which is specially handled)
  foreach my $s (keys %SIG) {
    my $sig_handler;
    $sig_handler = sub {

inc/inc_IPC-Cmd/IPC/Cmd.pm  view on Meta::CPAN

      # with $opts->{'clean_up_children'}
      # in run_forked
      #
      kill(-9, $$);

      POSIX::_exit 1;
    }

    if ($got_sig_child) {
      if (time() - $got_sig_child > 1) {
        # select->can_read doesn't return 0 after SIG_CHLD
        #
        # "On POSIX-compliant platforms, SIGCHLD is the signal
        # sent to a process when a child process terminates."
        # http://en.wikipedia.org/wiki/SIGCHLD
        #
        # nevertheless kill KILL wouldn't break anything here
        #
        kill (9, $pid);
        $child_finished = 1;
      }
    }

    Time::HiRes::usleep(1);

    foreach my $fd ($select->can_read(1/100)) {
      my $str = $child_output->{$fd->fileno};
      psSnake::die("child stream not found: $fd") unless $str;

      my $data;
      my $count = $fd->sysread($data, $str->{'block_size'});

      if ($count) {
        if ($str->{'parent_socket'}) {
          my $ph = $str->{'parent_socket'};
          print $ph $data;
        }
        else {
          $str->{'scalar_buffer'} .= $data;
        }
      }
      elsif ($count eq 0) {
        $select->remove($fd);
        $fd->close();
      }
      else {
        psSnake::die("error during sysread: " . $!);
      }
    }
  }

  my $waitpid_ret = waitpid($pid, 0);
  my $real_exit = $?;

inc/inc_IPC-Cmd/IPC/Cmd.pm  view on Meta::CPAN

  my %objs;

  $objs{ fileno( $fr_chld ) } = $outhand;
  $objs{ fileno( $fr_chld_err ) } = $errhand;
  $in_sel->add( $fr_chld );
  $in_sel->add( $fr_chld_err );

  close($to_chld);

  while ($in_sel->count() + $out_sel->count()) {
    my ($ins, $outs) = IO::Select::select($in_sel, $out_sel, undef);

    for my $fh (@$ins) {
        my $obj = $objs{ fileno($fh) };
        my $buf;
        my $bytes_read = sysread($fh, $buf, 64*1024 ); #, length($buf));
        if (!$bytes_read) {
            $in_sel->remove($fh);
        }
        else {
	          $obj->( "$buf" );

inc/inc_IPC-Cmd/IPC/Cmd.pm  view on Meta::CPAN

    ### open3 error occurred
    if( $@ and $@ =~ /^open3:/ ) {
        $self->ok( 0 );
        $self->error( $@ );
        return;
    };

    ### use OUR stdin, not $kidin. Somehow,
    ### we never get the input.. so jump through
    ### some hoops to do it :(
    my $selector = IO::Select->new(
                        (IS_WIN32 ? \*STDERR : $kiderror),
                        \*STDIN,
                        (IS_WIN32 ? \*STDOUT : $kidout)
                    );

    STDOUT->autoflush(1);   STDERR->autoflush(1);   STDIN->autoflush(1);
    $kidout->autoflush(1)   if UNIVERSAL::can($kidout,   'autoflush');
    $kiderror->autoflush(1) if UNIVERSAL::can($kiderror, 'autoflush');

    ### add an explicit break statement
    ### code courtesy of theorbtwo from #london.pm
    my $stdout_done = 0;
    my $stderr_done = 0;
    OUTER: while ( my @ready = $selector->can_read ) {

        for my $h ( @ready ) {
            my $buf;

            ### $len is the amount of bytes read
            my $len = sysread( $h, $buf, 4096 );    # try to read 4096 bytes

            ### see perldoc -f sysread: it returns undef on error,
            ### so bail out.
            if( not defined $len ) {

inc/inc_Module-Build/Module/Build.pm  view on Meta::CPAN

=back

Four other parameters let you control various aspects of how
installation paths are determined:

=over 4

=item installdirs

The default destinations for these installable things come from
entries in your system's C<Config.pm>.  You can select from three
different sets of default locations by setting the C<installdirs>
parameter as follows:

                          'installdirs' set to:
                   core          site                vendor

              uses the following defaults from Config.pm:

  lib     => installprivlib  installsitelib      installvendorlib
  arch    => installarchlib  installsitearch     installvendorarch

inc/inc_Module-Build/Module/Build.pm  view on Meta::CPAN

=item *

There are several architectural decisions in C<MakeMaker> that make it
very difficult to customize its behavior.  For instance, when using
C<MakeMaker> you do C<use ExtUtils::MakeMaker>, but the object created in
C<WriteMakefile()> is actually blessed into a package name that's
created on the fly, so you can't simply subclass
C<ExtUtils::MakeMaker>.  There is a workaround C<MY> package that lets
you override certain C<MakeMaker> methods, but only certain explicitly
preselected (by C<MakeMaker>) methods can be overridden.  Also, the method
of customization is very crude: you have to modify a string containing
the Makefile text for the particular target.  Since these strings
aren't documented, and I<can't> be documented (they take on different
values depending on the platform, version of perl, version of
C<MakeMaker>, etc.), you have no guarantee that your modifications will
work on someone else's machine or after an upgrade of C<MakeMaker> or
perl.

=item *

inc/inc_Module-Build/Module/Build/Base.pm  view on Meta::CPAN

}

sub args {
    my $self = shift;
    return wantarray ? %{ $self->{args} } : $self->{args} unless @_;
    my $key = shift;
    $self->{args}{$key} = shift if @_;
    return $self->{args}{$key};
}

# allows select parameters (with underscores) to be spoken with dashes
# when used as command-line options
sub _translate_option {
  my $self = shift;
  my $opt  = shift;

  (my $tr_opt = $opt) =~ tr/-/_/;

  return $tr_opt if grep $tr_opt =~ /^(?:no_?)?$_$/, qw(
    create_license
    create_makefile_pl

inc/inc_Module-Build/Module/Build/Base.pm  view on Meta::CPAN

    extra_linker_flags
    install_base
    install_path
    meta_add
    meta_merge
    test_files
    use_rcfile
    use_tap_harness
    tap_harness_args
    cpan_client
  ); # normalize only selected option names

  return $opt;
}

my %singular_argument = map { ($_ => 1) } qw/install_base prefix destdir installdir verbose quiet uninst debug sign/;

sub _read_arg {
  my ($self, $args, $key, $val) = @_;

  $key = $self->_translate_option($key);

inc/inc_Module-Build/Module/Build/Base.pm  view on Meta::CPAN

      } else {
        push( @{$alt{$package}}, {
                                  file    => $mapped_filename,
                                  version => $version,
                                 } );
      }
    }
  }

  # Then we iterate over all the packages found above, identifying conflicts
  # and selecting the "best" candidate for recording the file & version
  # for each package.
  foreach my $package ( keys( %alt ) ) {
    my $result = $self->_resolve_module_versions( $alt{$package} );

    if ( exists( $prime{$package} ) ) { # primary package selected

      if ( $result->{err} ) {
        # Use the selected primary package, but there are conflicting
        # errors among multiple alternative packages that need to be
        # reported
        $self->log_warn(
          "Found conflicting versions for package '$package'\n" .
          "  $prime{$package}{file} ($prime{$package}{version})\n" .
          $result->{err}
        );

      } elsif ( defined( $result->{version} ) ) {
        # There is a primary package selected, and exactly one
        # alternative package

        if ( exists( $prime{$package}{version} ) &&
             defined( $prime{$package}{version} ) ) {
          # Unless the version of the primary package agrees with the
          # version of the alternative package, report a conflict
          if ( $self->compare_versions( $prime{$package}{version}, '!=',
                                        $result->{version} ) ) {
            $self->log_warn(
              "Found conflicting versions for package '$package'\n" .
              "  $prime{$package}{file} ($prime{$package}{version})\n" .
              "  $result->{file} ($result->{version})\n"
            );
          }

        } else {
          # The prime package selected has no version so, we choose to
          # use any alternative package that does have a version
          $prime{$package}{file}    = $result->{file};
          $prime{$package}{version} = $result->{version};
        }

      } else {
        # no alt package found with a version, but we have a prime
        # package so we use it whether it has a version or not
      }

    } else { # No primary package was selected, use the best alternative

      if ( $result->{err} ) {
        $self->log_warn(
          "Found conflicting versions for package '$package'\n" .
          $result->{err}
        );
      }

      # Despite possible conflicting versions, we choose to record
      # something rather than nothing