Skip to content

Commit

Permalink
add Module::Install incs to repo
Browse files Browse the repository at this point in the history
  • Loading branch information
yko committed Jul 14, 2011
1 parent 22540fe commit 5be8f31
Show file tree
Hide file tree
Showing 7 changed files with 746 additions and 1 deletion.
2 changes: 1 addition & 1 deletion Makefile.PL
Expand Up @@ -20,7 +20,7 @@ build_requires 'Symbol';
resources resources
license => "http://dev.perl.org/licenses", license => "http://dev.perl.org/licenses",
homepage => "http://monitis.com/api/api.html", homepage => "http://monitis.com/api/api.html",
repository => "https://github.com/monitisexchange/Perl-SDK", repository => "https://github.com/monitisexchange/Perl-SDK";


install_script 'monitis-agent-install'; install_script 'monitis-agent-install';


Expand Down
81 changes: 81 additions & 0 deletions inc/Module/Install/Can.pm
@@ -0,0 +1,81 @@
#line 1
package Module::Install::Can;

use strict;
use Config ();
use File::Spec ();
use ExtUtils::MakeMaker ();
use Module::Install::Base ();

use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.01';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}

# check if we can load some module
### Upgrade this to not have to load the module if possible
sub can_use {
my ($self, $mod, $ver) = @_;
$mod =~ s{::|\\}{/}g;
$mod .= '.pm' unless $mod =~ /\.pm$/i;

my $pkg = $mod;
$pkg =~ s{/}{::}g;
$pkg =~ s{\.pm$}{}i;

local $@;
eval { require $mod; $pkg->VERSION($ver || 0); 1 };
}

# check if we can run some command
sub can_run {
my ($self, $cmd) = @_;

my $_cmd = $cmd;
return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd));

for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
next if $dir eq '';
my $abs = File::Spec->catfile($dir, $_[1]);
return $abs if (-x $abs or $abs = MM->maybe_command($abs));
}

return;
}

# can we locate a (the) C compiler
sub can_cc {
my $self = shift;
my @chunks = split(/ /, $Config::Config{cc}) or return;

# $Config{cc} may contain args; try to find out the program part
while (@chunks) {
return $self->can_run("@chunks") || (pop(@chunks), next);
}

return;
}

# Fix Cygwin bug on maybe_command();
if ( $^O eq 'cygwin' ) {
require ExtUtils::MM_Cygwin;
require ExtUtils::MM_Win32;
if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) {
*ExtUtils::MM_Cygwin::maybe_command = sub {
my ($self, $file) = @_;
if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) {
ExtUtils::MM_Win32->maybe_command($file);
} else {
ExtUtils::MM_Unix->maybe_command($file);
}
}
}
}

1;

__END__
#line 156
93 changes: 93 additions & 0 deletions inc/Module/Install/Fetch.pm
@@ -0,0 +1,93 @@
#line 1
package Module::Install::Fetch;

use strict;
use Module::Install::Base ();

use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.01';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}

sub get_file {
my ($self, %args) = @_;
my ($scheme, $host, $path, $file) =
$args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;

if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) {
$args{url} = $args{ftp_url}
or (warn("LWP support unavailable!\n"), return);
($scheme, $host, $path, $file) =
$args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
}

$|++;
print "Fetching '$file' from $host... ";

unless (eval { require Socket; Socket::inet_aton($host) }) {
warn "'$host' resolve failed!\n";
return;
}

return unless $scheme eq 'ftp' or $scheme eq 'http';

require Cwd;
my $dir = Cwd::getcwd();
chdir $args{local_dir} or return if exists $args{local_dir};

if (eval { require LWP::Simple; 1 }) {
LWP::Simple::mirror($args{url}, $file);
}
elsif (eval { require Net::FTP; 1 }) { eval {
# use Net::FTP to get past firewall
my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600);
$ftp->login("anonymous", 'anonymous@example.com');
$ftp->cwd($path);
$ftp->binary;
$ftp->get($file) or (warn("$!\n"), return);
$ftp->quit;
} }
elsif (my $ftp = $self->can_run('ftp')) { eval {
# no Net::FTP, fallback to ftp.exe
require FileHandle;
my $fh = FileHandle->new;

local $SIG{CHLD} = 'IGNORE';
unless ($fh->open("|$ftp -n")) {
warn "Couldn't open ftp: $!\n";
chdir $dir; return;
}

my @dialog = split(/\n/, <<"END_FTP");
open $host
user anonymous anonymous\@example.com
cd $path
binary
get $file $file
quit
END_FTP
foreach (@dialog) { $fh->print("$_\n") }
$fh->close;
} }
else {
warn "No working 'ftp' program available!\n";
chdir $dir; return;
}

unless (-f $file) {
warn "Fetching failed: $@\n";
chdir $dir; return;
}

return if exists $args{size} and -s $file != $args{size};
system($args{run}) if exists $args{run};
unlink($file) if $args{remove};

print(((!exists $args{check_for} or -e $args{check_for})
? "done!" : "failed! ($!)"), "\n");
chdir $dir; return !$?;
}

1;

0 comments on commit 5be8f31

Please sign in to comment.