Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

infrastructure housekeeping

  • Loading branch information...
commit c0553766554b248563e8882ec4475ee9889e7ff8 1 parent e6bbaa3
Kevin Falcone authored August 27, 2012
12  .gitignore
... ...
@@ -0,0 +1,12 @@
  1
+blib*
  2
+Makefile
  3
+Makefile.old
  4
+pm_to_blib*
  5
+*.tar.gz
  6
+.lwpcookies
  7
+cover_db
  8
+pod2htm*.tmp
  9
+/RT-Extension-MobileUI*
  10
+*.bak
  11
+*.swp
  12
+/MYMETA.*
1  MANIFEST.SKIP
@@ -10,3 +10,4 @@ pm_to_blib
10 10
 .prove
11 11
 ^.shipit$
12 12
 cover_db/
  13
+^MYMETA.*
23  META.yml
... ...
@@ -0,0 +1,23 @@
  1
+---
  2
+abstract: 'A phone friendly web interface for RT'
  3
+author:
  4
+  - 'Jesse Vincent <jesse@bestpractical.com>'
  5
+build_requires:
  6
+  ExtUtils::MakeMaker: 6.36
  7
+configure_requires:
  8
+  ExtUtils::MakeMaker: 6.36
  9
+distribution_type: module
  10
+dynamic_config: 1
  11
+generated_by: 'Module::Install version 1.06'
  12
+license: gpl
  13
+meta-spec:
  14
+  url: http://module-build.sourceforge.net/META-spec-v1.4.html
  15
+  version: 1.4
  16
+name: RT-Extension-MobileUI
  17
+no_index:
  18
+  directory:
  19
+    - html
  20
+    - inc
  21
+resources:
  22
+  license: http://opensource.org/licenses/gpl-license.php
  23
+version: 1.02
470  inc/Module/Install.pm
... ...
@@ -0,0 +1,470 @@
  1
+#line 1
  2
+package Module::Install;
  3
+
  4
+# For any maintainers:
  5
+# The load order for Module::Install is a bit magic.
  6
+# It goes something like this...
  7
+#
  8
+# IF ( host has Module::Install installed, creating author mode ) {
  9
+#     1. Makefile.PL calls "use inc::Module::Install"
  10
+#     2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install
  11
+#     3. The installed version of inc::Module::Install loads
  12
+#     4. inc::Module::Install calls "require Module::Install"
  13
+#     5. The ./inc/ version of Module::Install loads
  14
+# } ELSE {
  15
+#     1. Makefile.PL calls "use inc::Module::Install"
  16
+#     2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install
  17
+#     3. The ./inc/ version of Module::Install loads
  18
+# }
  19
+
  20
+use 5.005;
  21
+use strict 'vars';
  22
+use Cwd        ();
  23
+use File::Find ();
  24
+use File::Path ();
  25
+
  26
+use vars qw{$VERSION $MAIN};
  27
+BEGIN {
  28
+	# All Module::Install core packages now require synchronised versions.
  29
+	# This will be used to ensure we don't accidentally load old or
  30
+	# different versions of modules.
  31
+	# This is not enforced yet, but will be some time in the next few
  32
+	# releases once we can make sure it won't clash with custom
  33
+	# Module::Install extensions.
  34
+	$VERSION = '1.06';
  35
+
  36
+	# Storage for the pseudo-singleton
  37
+	$MAIN    = undef;
  38
+
  39
+	*inc::Module::Install::VERSION = *VERSION;
  40
+	@inc::Module::Install::ISA     = __PACKAGE__;
  41
+
  42
+}
  43
+
  44
+sub import {
  45
+	my $class = shift;
  46
+	my $self  = $class->new(@_);
  47
+	my $who   = $self->_caller;
  48
+
  49
+	#-------------------------------------------------------------
  50
+	# all of the following checks should be included in import(),
  51
+	# to allow "eval 'require Module::Install; 1' to test
  52
+	# installation of Module::Install. (RT #51267)
  53
+	#-------------------------------------------------------------
  54
+
  55
+	# Whether or not inc::Module::Install is actually loaded, the
  56
+	# $INC{inc/Module/Install.pm} is what will still get set as long as
  57
+	# the caller loaded module this in the documented manner.
  58
+	# If not set, the caller may NOT have loaded the bundled version, and thus
  59
+	# they may not have a MI version that works with the Makefile.PL. This would
  60
+	# result in false errors or unexpected behaviour. And we don't want that.
  61
+	my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
  62
+	unless ( $INC{$file} ) { die <<"END_DIE" }
  63
+
  64
+Please invoke ${\__PACKAGE__} with:
  65
+
  66
+	use inc::${\__PACKAGE__};
  67
+
  68
+not:
  69
+
  70
+	use ${\__PACKAGE__};
  71
+
  72
+END_DIE
  73
+
  74
+	# This reportedly fixes a rare Win32 UTC file time issue, but
  75
+	# as this is a non-cross-platform XS module not in the core,
  76
+	# we shouldn't really depend on it. See RT #24194 for detail.
  77
+	# (Also, this module only supports Perl 5.6 and above).
  78
+	eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006;
  79
+
  80
+	# If the script that is loading Module::Install is from the future,
  81
+	# then make will detect this and cause it to re-run over and over
  82
+	# again. This is bad. Rather than taking action to touch it (which
  83
+	# is unreliable on some platforms and requires write permissions)
  84
+	# for now we should catch this and refuse to run.
  85
+	if ( -f $0 ) {
  86
+		my $s = (stat($0))[9];
  87
+
  88
+		# If the modification time is only slightly in the future,
  89
+		# sleep briefly to remove the problem.
  90
+		my $a = $s - time;
  91
+		if ( $a > 0 and $a < 5 ) { sleep 5 }
  92
+
  93
+		# Too far in the future, throw an error.
  94
+		my $t = time;
  95
+		if ( $s > $t ) { die <<"END_DIE" }
  96
+
  97
+Your installer $0 has a modification time in the future ($s > $t).
  98
+
  99
+This is known to create infinite loops in make.
  100
+
  101
+Please correct this, then run $0 again.
  102
+
  103
+END_DIE
  104
+	}
  105
+
  106
+
  107
+	# Build.PL was formerly supported, but no longer is due to excessive
  108
+	# difficulty in implementing every single feature twice.
  109
+	if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" }
  110
+
  111
+Module::Install no longer supports Build.PL.
  112
+
  113
+It was impossible to maintain duel backends, and has been deprecated.
  114
+
  115
+Please remove all Build.PL files and only use the Makefile.PL installer.
  116
+
  117
+END_DIE
  118
+
  119
+	#-------------------------------------------------------------
  120
+
  121
+	# To save some more typing in Module::Install installers, every...
  122
+	# use inc::Module::Install
  123
+	# ...also acts as an implicit use strict.
  124
+	$^H |= strict::bits(qw(refs subs vars));
  125
+
  126
+	#-------------------------------------------------------------
  127
+
  128
+	unless ( -f $self->{file} ) {
  129
+		foreach my $key (keys %INC) {
  130
+			delete $INC{$key} if $key =~ /Module\/Install/;
  131
+		}
  132
+
  133
+		local $^W;
  134
+		require "$self->{path}/$self->{dispatch}.pm";
  135
+		File::Path::mkpath("$self->{prefix}/$self->{author}");
  136
+		$self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
  137
+		$self->{admin}->init;
  138
+		@_ = ($class, _self => $self);
  139
+		goto &{"$self->{name}::import"};
  140
+	}
  141
+
  142
+	local $^W;
  143
+	*{"${who}::AUTOLOAD"} = $self->autoload;
  144
+	$self->preload;
  145
+
  146
+	# Unregister loader and worker packages so subdirs can use them again
  147
+	delete $INC{'inc/Module/Install.pm'};
  148
+	delete $INC{'Module/Install.pm'};
  149
+
  150
+	# Save to the singleton
  151
+	$MAIN = $self;
  152
+
  153
+	return 1;
  154
+}
  155
+
  156
+sub autoload {
  157
+	my $self = shift;
  158
+	my $who  = $self->_caller;
  159
+	my $cwd  = Cwd::cwd();
  160
+	my $sym  = "${who}::AUTOLOAD";
  161
+	$sym->{$cwd} = sub {
  162
+		my $pwd = Cwd::cwd();
  163
+		if ( my $code = $sym->{$pwd} ) {
  164
+			# Delegate back to parent dirs
  165
+			goto &$code unless $cwd eq $pwd;
  166
+		}
  167
+		unless ($$sym =~ s/([^:]+)$//) {
  168
+			# XXX: it looks like we can't retrieve the missing function
  169
+			# via $$sym (usually $main::AUTOLOAD) in this case.
  170
+			# I'm still wondering if we should slurp Makefile.PL to
  171
+			# get some context or not ...
  172
+			my ($package, $file, $line) = caller;
  173
+			die <<"EOT";
  174
+Unknown function is found at $file line $line.
  175
+Execution of $file aborted due to runtime errors.
  176
+
  177
+If you're a contributor to a project, you may need to install
  178
+some Module::Install extensions from CPAN (or other repository).
  179
+If you're a user of a module, please contact the author.
  180
+EOT
  181
+		}
  182
+		my $method = $1;
  183
+		if ( uc($method) eq $method ) {
  184
+			# Do nothing
  185
+			return;
  186
+		} elsif ( $method =~ /^_/ and $self->can($method) ) {
  187
+			# Dispatch to the root M:I class
  188
+			return $self->$method(@_);
  189
+		}
  190
+
  191
+		# Dispatch to the appropriate plugin
  192
+		unshift @_, ( $self, $1 );
  193
+		goto &{$self->can('call')};
  194
+	};
  195
+}
  196
+
  197
+sub preload {
  198
+	my $self = shift;
  199
+	unless ( $self->{extensions} ) {
  200
+		$self->load_extensions(
  201
+			"$self->{prefix}/$self->{path}", $self
  202
+		);
  203
+	}
  204
+
  205
+	my @exts = @{$self->{extensions}};
  206
+	unless ( @exts ) {
  207
+		@exts = $self->{admin}->load_all_extensions;
  208
+	}
  209
+
  210
+	my %seen;
  211
+	foreach my $obj ( @exts ) {
  212
+		while (my ($method, $glob) = each %{ref($obj) . '::'}) {
  213
+			next unless $obj->can($method);
  214
+			next if $method =~ /^_/;
  215
+			next if $method eq uc($method);
  216
+			$seen{$method}++;
  217
+		}
  218
+	}
  219
+
  220
+	my $who = $self->_caller;
  221
+	foreach my $name ( sort keys %seen ) {
  222
+		local $^W;
  223
+		*{"${who}::$name"} = sub {
  224
+			${"${who}::AUTOLOAD"} = "${who}::$name";
  225
+			goto &{"${who}::AUTOLOAD"};
  226
+		};
  227
+	}
  228
+}
  229
+
  230
+sub new {
  231
+	my ($class, %args) = @_;
  232
+
  233
+	delete $INC{'FindBin.pm'};
  234
+	{
  235
+		# to suppress the redefine warning
  236
+		local $SIG{__WARN__} = sub {};
  237
+		require FindBin;
  238
+	}
  239
+
  240
+	# ignore the prefix on extension modules built from top level.
  241
+	my $base_path = Cwd::abs_path($FindBin::Bin);
  242
+	unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) {
  243
+		delete $args{prefix};
  244
+	}
  245
+	return $args{_self} if $args{_self};
  246
+
  247
+	$args{dispatch} ||= 'Admin';
  248
+	$args{prefix}   ||= 'inc';
  249
+	$args{author}   ||= ($^O eq 'VMS' ? '_author' : '.author');
  250
+	$args{bundle}   ||= 'inc/BUNDLES';
  251
+	$args{base}     ||= $base_path;
  252
+	$class =~ s/^\Q$args{prefix}\E:://;
  253
+	$args{name}     ||= $class;
  254
+	$args{version}  ||= $class->VERSION;
  255
+	unless ( $args{path} ) {
  256
+		$args{path}  = $args{name};
  257
+		$args{path}  =~ s!::!/!g;
  258
+	}
  259
+	$args{file}     ||= "$args{base}/$args{prefix}/$args{path}.pm";
  260
+	$args{wrote}      = 0;
  261
+
  262
+	bless( \%args, $class );
  263
+}
  264
+
  265
+sub call {
  266
+	my ($self, $method) = @_;
  267
+	my $obj = $self->load($method) or return;
  268
+        splice(@_, 0, 2, $obj);
  269
+	goto &{$obj->can($method)};
  270
+}
  271
+
  272
+sub load {
  273
+	my ($self, $method) = @_;
  274
+
  275
+	$self->load_extensions(
  276
+		"$self->{prefix}/$self->{path}", $self
  277
+	) unless $self->{extensions};
  278
+
  279
+	foreach my $obj (@{$self->{extensions}}) {
  280
+		return $obj if $obj->can($method);
  281
+	}
  282
+
  283
+	my $admin = $self->{admin} or die <<"END_DIE";
  284
+The '$method' method does not exist in the '$self->{prefix}' path!
  285
+Please remove the '$self->{prefix}' directory and run $0 again to load it.
  286
+END_DIE
  287
+
  288
+	my $obj = $admin->load($method, 1);
  289
+	push @{$self->{extensions}}, $obj;
  290
+
  291
+	$obj;
  292
+}
  293
+
  294
+sub load_extensions {
  295
+	my ($self, $path, $top) = @_;
  296
+
  297
+	my $should_reload = 0;
  298
+	unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
  299
+		unshift @INC, $self->{prefix};
  300
+		$should_reload = 1;
  301
+	}
  302
+
  303
+	foreach my $rv ( $self->find_extensions($path) ) {
  304
+		my ($file, $pkg) = @{$rv};
  305
+		next if $self->{pathnames}{$pkg};
  306
+
  307
+		local $@;
  308
+		my $new = eval { local $^W; require $file; $pkg->can('new') };
  309
+		unless ( $new ) {
  310
+			warn $@ if $@;
  311
+			next;
  312
+		}
  313
+		$self->{pathnames}{$pkg} =
  314
+			$should_reload ? delete $INC{$file} : $INC{$file};
  315
+		push @{$self->{extensions}}, &{$new}($pkg, _top => $top );
  316
+	}
  317
+
  318
+	$self->{extensions} ||= [];
  319
+}
  320
+
  321
+sub find_extensions {
  322
+	my ($self, $path) = @_;
  323
+
  324
+	my @found;
  325
+	File::Find::find( sub {
  326
+		my $file = $File::Find::name;
  327
+		return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
  328
+		my $subpath = $1;
  329
+		return if lc($subpath) eq lc($self->{dispatch});
  330
+
  331
+		$file = "$self->{path}/$subpath.pm";
  332
+		my $pkg = "$self->{name}::$subpath";
  333
+		$pkg =~ s!/!::!g;
  334
+
  335
+		# If we have a mixed-case package name, assume case has been preserved
  336
+		# correctly.  Otherwise, root through the file to locate the case-preserved
  337
+		# version of the package name.
  338
+		if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) {
  339
+			my $content = Module::Install::_read($subpath . '.pm');
  340
+			my $in_pod  = 0;
  341
+			foreach ( split //, $content ) {
  342
+				$in_pod = 1 if /^=\w/;
  343
+				$in_pod = 0 if /^=cut/;
  344
+				next if ($in_pod || /^=cut/);  # skip pod text
  345
+				next if /^\s*#/;               # and comments
  346
+				if ( m/^\s*package\s+($pkg)\s*;/i ) {
  347
+					$pkg = $1;
  348
+					last;
  349
+				}
  350
+			}
  351
+		}
  352
+
  353
+		push @found, [ $file, $pkg ];
  354
+	}, $path ) if -d $path;
  355
+
  356
+	@found;
  357
+}
  358
+
  359
+
  360
+
  361
+
  362
+
  363
+#####################################################################
  364
+# Common Utility Functions
  365
+
  366
+sub _caller {
  367
+	my $depth = 0;
  368
+	my $call  = caller($depth);
  369
+	while ( $call eq __PACKAGE__ ) {
  370
+		$depth++;
  371
+		$call = caller($depth);
  372
+	}
  373
+	return $call;
  374
+}
  375
+
  376
+# Done in evals to avoid confusing Perl::MinimumVersion
  377
+eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
  378
+sub _read {
  379
+	local *FH;
  380
+	open( FH, '<', $_[0] ) or die "open($_[0]): $!";
  381
+	my $string = do { local $/; <FH> };
  382
+	close FH or die "close($_[0]): $!";
  383
+	return $string;
  384
+}
  385
+END_NEW
  386
+sub _read {
  387
+	local *FH;
  388
+	open( FH, "< $_[0]"  ) or die "open($_[0]): $!";
  389
+	my $string = do { local $/; <FH> };
  390
+	close FH or die "close($_[0]): $!";
  391
+	return $string;
  392
+}
  393
+END_OLD
  394
+
  395
+sub _readperl {
  396
+	my $string = Module::Install::_read($_[0]);
  397
+	$string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
  398
+	$string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s;
  399
+	$string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg;
  400
+	return $string;
  401
+}
  402
+
  403
+sub _readpod {
  404
+	my $string = Module::Install::_read($_[0]);
  405
+	$string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
  406
+	return $string if $_[0] =~ /\.pod\z/;
  407
+	$string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg;
  408
+	$string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg;
  409
+	$string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg;
  410
+	$string =~ s/^\n+//s;
  411
+	return $string;
  412
+}
  413
+
  414
+# Done in evals to avoid confusing Perl::MinimumVersion
  415
+eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
  416
+sub _write {
  417
+	local *FH;
  418
+	open( FH, '>', $_[0] ) or die "open($_[0]): $!";
  419
+	foreach ( 1 .. $#_ ) {
  420
+		print FH $_[$_] or die "print($_[0]): $!";
  421
+	}
  422
+	close FH or die "close($_[0]): $!";
  423
+}
  424
+END_NEW
  425
+sub _write {
  426
+	local *FH;
  427
+	open( FH, "> $_[0]"  ) or die "open($_[0]): $!";
  428
+	foreach ( 1 .. $#_ ) {
  429
+		print FH $_[$_] or die "print($_[0]): $!";
  430
+	}
  431
+	close FH or die "close($_[0]): $!";
  432
+}
  433
+END_OLD
  434
+
  435
+# _version is for processing module versions (eg, 1.03_05) not
  436
+# Perl versions (eg, 5.8.1).
  437
+sub _version ($) {
  438
+	my $s = shift || 0;
  439
+	my $d =()= $s =~ /(\.)/g;
  440
+	if ( $d >= 2 ) {
  441
+		# Normalise multipart versions
  442
+		$s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
  443
+	}
  444
+	$s =~ s/^(\d+)\.?//;
  445
+	my $l = $1 || 0;
  446
+	my @v = map {
  447
+		$_ . '0' x (3 - length $_)
  448
+	} $s =~ /(\d{1,3})\D?/g;
  449
+	$l = $l . '.' . join '', @v if @v;
  450
+	return $l + 0;
  451
+}
  452
+
  453
+sub _cmp ($$) {
  454
+	_version($_[1]) <=> _version($_[2]);
  455
+}
  456
+
  457
+# Cloned from Params::Util::_CLASS
  458
+sub _CLASS ($) {
  459
+	(
  460
+		defined $_[0]
  461
+		and
  462
+		! ref $_[0]
  463
+		and
  464
+		$_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s
  465
+	) ? $_[0] : undef;
  466
+}
  467
+
  468
+1;
  469
+
  470
+# Copyright 2008 - 2012 Adam Kennedy.
83  inc/Module/Install/Base.pm
... ...
@@ -0,0 +1,83 @@
  1
+#line 1
  2
+package Module::Install::Base;
  3
+
  4
+use strict 'vars';
  5
+use vars qw{$VERSION};
  6
+BEGIN {
  7
+	$VERSION = '1.06';
  8
+}
  9
+
  10
+# Suspend handler for "redefined" warnings
  11
+BEGIN {
  12
+	my $w = $SIG{__WARN__};
  13
+	$SIG{__WARN__} = sub { $w };
  14
+}
  15
+
  16
+#line 42
  17
+
  18
+sub new {
  19
+	my $class = shift;
  20
+	unless ( defined &{"${class}::call"} ) {
  21
+		*{"${class}::call"} = sub { shift->_top->call(@_) };
  22
+	}
  23
+	unless ( defined &{"${class}::load"} ) {
  24
+		*{"${class}::load"} = sub { shift->_top->load(@_) };
  25
+	}
  26
+	bless { @_ }, $class;
  27
+}
  28
+
  29
+#line 61
  30
+
  31
+sub AUTOLOAD {
  32
+	local $@;
  33
+	my $func = eval { shift->_top->autoload } or return;
  34
+	goto &$func;
  35
+}
  36
+
  37
+#line 75
  38
+
  39
+sub _top {
  40
+	$_[0]->{_top};
  41
+}
  42
+
  43
+#line 90
  44
+
  45
+sub admin {
  46
+	$_[0]->_top->{admin}
  47
+	or
  48
+	Module::Install::Base::FakeAdmin->new;
  49
+}
  50
+
  51
+#line 106
  52
+
  53
+sub is_admin {
  54
+	! $_[0]->admin->isa('Module::Install::Base::FakeAdmin');
  55
+}
  56
+
  57
+sub DESTROY {}
  58
+
  59
+package Module::Install::Base::FakeAdmin;
  60
+
  61
+use vars qw{$VERSION};
  62
+BEGIN {
  63
+	$VERSION = $Module::Install::Base::VERSION;
  64
+}
  65
+
  66
+my $fake;
  67
+
  68
+sub new {
  69
+	$fake ||= bless(\@_, $_[0]);
  70
+}
  71
+
  72
+sub AUTOLOAD {}
  73
+
  74
+sub DESTROY {}
  75
+
  76
+# Restore warning handler
  77
+BEGIN {
  78
+	$SIG{__WARN__} = $SIG{__WARN__}->();
  79
+}
  80
+
  81
+1;
  82
+
  83
+#line 159
154  inc/Module/Install/Can.pm
... ...
@@ -0,0 +1,154 @@
  1
+#line 1
  2
+package Module::Install::Can;
  3
+
  4
+use strict;
  5
+use Config                ();
  6
+use ExtUtils::MakeMaker   ();
  7
+use Module::Install::Base ();
  8
+
  9
+use vars qw{$VERSION @ISA $ISCORE};
  10
+BEGIN {
  11
+	$VERSION = '1.06';
  12
+	@ISA     = 'Module::Install::Base';
  13
+	$ISCORE  = 1;
  14
+}
  15
+
  16
+# check if we can load some module
  17
+### Upgrade this to not have to load the module if possible
  18
+sub can_use {
  19
+	my ($self, $mod, $ver) = @_;
  20
+	$mod =~ s{::|\\}{/}g;
  21
+	$mod .= '.pm' unless $mod =~ /\.pm$/i;
  22
+
  23
+	my $pkg = $mod;
  24
+	$pkg =~ s{/}{::}g;
  25
+	$pkg =~ s{\.pm$}{}i;
  26
+
  27
+	local $@;
  28
+	eval { require $mod; $pkg->VERSION($ver || 0); 1 };
  29
+}
  30
+
  31
+# Check if we can run some command
  32
+sub can_run {
  33
+	my ($self, $cmd) = @_;
  34
+
  35
+	my $_cmd = $cmd;
  36
+	return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd));
  37
+
  38
+	for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
  39
+		next if $dir eq '';
  40
+		require File::Spec;
  41
+		my $abs = File::Spec->catfile($dir, $cmd);
  42
+		return $abs if (-x $abs or $abs = MM->maybe_command($abs));
  43
+	}
  44
+
  45
+	return;
  46
+}
  47
+
  48
+# Can our C compiler environment build XS files
  49
+sub can_xs {
  50
+	my $self = shift;
  51
+
  52
+	# Ensure we have the CBuilder module
  53
+	$self->configure_requires( 'ExtUtils::CBuilder' => 0.27 );
  54
+
  55
+	# Do we have the configure_requires checker?
  56
+	local $@;
  57
+	eval "require ExtUtils::CBuilder;";
  58
+	if ( $@ ) {
  59
+		# They don't obey configure_requires, so it is
  60
+		# someone old and delicate. Try to avoid hurting
  61
+		# them by falling back to an older simpler test.
  62
+		return $self->can_cc();
  63
+	}
  64
+
  65
+	# Do we have a working C compiler
  66
+	my $builder = ExtUtils::CBuilder->new(
  67
+		quiet => 1,
  68
+	);
  69
+	unless ( $builder->have_compiler ) {
  70
+		# No working C compiler
  71
+		return 0;
  72
+	}
  73
+
  74
+	# Write a C file representative of what XS becomes
  75
+	require File::Temp;
  76
+	my ( $FH, $tmpfile ) = File::Temp::tempfile(
  77
+		"compilexs-XXXXX",
  78
+		SUFFIX => '.c',
  79
+	);
  80
+	binmode $FH;
  81
+	print $FH <<'END_C';
  82
+#include "EXTERN.h"
  83
+#include "perl.h"
  84
+#include "XSUB.h"
  85
+
  86
+int main(int argc, char **argv) {
  87
+    return 0;
  88
+}
  89
+
  90
+int boot_sanexs() {
  91
+    return 1;
  92
+}
  93
+
  94
+END_C
  95
+	close $FH;
  96
+
  97
+	# Can the C compiler access the same headers XS does
  98
+	my @libs   = ();
  99
+	my $object = undef;
  100
+	eval {
  101
+		local $^W = 0;
  102
+		$object = $builder->compile(
  103
+			source => $tmpfile,
  104
+		);
  105
+		@libs = $builder->link(
  106
+			objects     => $object,
  107
+			module_name => 'sanexs',
  108
+		);
  109
+	};
  110
+	my $result = $@ ? 0 : 1;
  111
+
  112
+	# Clean up all the build files
  113
+	foreach ( $tmpfile, $object, @libs ) {
  114
+		next unless defined $_;
  115
+		1 while unlink;
  116
+	}
  117
+
  118
+	return $result;
  119
+}
  120
+
  121
+# Can we locate a (the) C compiler
  122
+sub can_cc {
  123
+	my $self   = shift;
  124
+	my @chunks = split(/ /, $Config::Config{cc}) or return;
  125
+
  126
+	# $Config{cc} may contain args; try to find out the program part
  127
+	while (@chunks) {
  128
+		return $self->can_run("@chunks") || (pop(@chunks), next);
  129
+	}
  130
+
  131
+	return;
  132
+}
  133
+
  134
+# Fix Cygwin bug on maybe_command();
  135
+if ( $^O eq 'cygwin' ) {
  136
+	require ExtUtils::MM_Cygwin;
  137
+	require ExtUtils::MM_Win32;
  138
+	if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) {
  139
+		*ExtUtils::MM_Cygwin::maybe_command = sub {
  140
+			my ($self, $file) = @_;
  141
+			if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) {
  142
+				ExtUtils::MM_Win32->maybe_command($file);
  143
+			} else {
  144
+				ExtUtils::MM_Unix->maybe_command($file);
  145
+			}
  146
+		}
  147
+	}
  148
+}
  149
+
  150
+1;
  151
+
  152
+__END__
  153
+
  154
+#line 236
93  inc/Module/Install/Fetch.pm
... ...
@@ -0,0 +1,93 @@
  1
+#line 1
  2
+package Module::Install::Fetch;
  3
+
  4
+use strict;
  5
+use Module::Install::Base ();
  6
+
  7
+use vars qw{$VERSION @ISA $ISCORE};
  8
+BEGIN {
  9
+	$VERSION = '1.06';
  10
+	@ISA     = 'Module::Install::Base';
  11
+	$ISCORE  = 1;
  12
+}
  13
+
  14
+sub get_file {
  15
+    my ($self, %args) = @_;
  16
+    my ($scheme, $host, $path, $file) =
  17
+        $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
  18
+
  19
+    if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) {
  20
+        $args{url} = $args{ftp_url}
  21
+            or (warn("LWP support unavailable!\n"), return);
  22
+        ($scheme, $host, $path, $file) =
  23
+            $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
  24
+    }
  25
+
  26
+    $|++;
  27
+    print "Fetching '$file' from $host... ";
  28
+
  29
+    unless (eval { require Socket; Socket::inet_aton($host) }) {
  30
+        warn "'$host' resolve failed!\n";
  31
+        return;
  32
+    }
  33
+
  34
+    return unless $scheme eq 'ftp' or $scheme eq 'http';
  35
+
  36
+    require Cwd;
  37
+    my $dir = Cwd::getcwd();
  38
+    chdir $args{local_dir} or return if exists $args{local_dir};
  39
+
  40
+    if (eval { require LWP::Simple; 1 }) {
  41
+        LWP::Simple::mirror($args{url}, $file);
  42
+    }
  43
+    elsif (eval { require Net::FTP; 1 }) { eval {
  44
+        # use Net::FTP to get past firewall
  45
+        my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600);
  46
+        $ftp->login("anonymous", 'anonymous@example.com');
  47
+        $ftp->cwd($path);
  48
+        $ftp->binary;
  49
+        $ftp->get($file) or (warn("$!\n"), return);
  50
+        $ftp->quit;
  51
+    } }
  52
+    elsif (my $ftp = $self->can_run('ftp')) { eval {
  53
+        # no Net::FTP, fallback to ftp.exe
  54
+        require FileHandle;
  55
+        my $fh = FileHandle->new;
  56
+
  57
+        local $SIG{CHLD} = 'IGNORE';
  58
+        unless ($fh->open("|$ftp -n")) {
  59
+            warn "Couldn't open ftp: $!\n";
  60
+            chdir $dir; return;
  61
+        }
  62
+
  63
+        my @dialog = split(/\n/, <<"END_FTP");
  64
+open $host
  65
+user anonymous anonymous\@example.com
  66
+cd $path
  67
+binary
  68
+get $file $file
  69
+quit
  70
+END_FTP
  71
+        foreach (@dialog) { $fh->print("$_\n") }
  72
+        $fh->close;
  73
+    } }
  74
+    else {
  75
+        warn "No working 'ftp' program available!\n";
  76
+        chdir $dir; return;
  77
+    }
  78
+
  79
+    unless (-f $file) {
  80
+        warn "Fetching failed: $@\n";
  81
+        chdir $dir; return;
  82
+    }
  83
+
  84
+    return if exists $args{size} and -s $file != $args{size};
  85
+    system($args{run}) if exists $args{run};
  86
+    unlink($file) if $args{remove};
  87
+
  88
+    print(((!exists $args{check_for} or -e $args{check_for})
  89
+        ? "done!" : "failed! ($!)"), "\n");
  90
+    chdir $dir; return !$?;
  91
+}
  92
+
  93
+1;
418  inc/Module/Install/Makefile.pm
... ...
@@ -0,0 +1,418 @@
  1
+#line 1
  2
+package Module::Install::Makefile;
  3
+
  4
+use strict 'vars';
  5
+use ExtUtils::MakeMaker   ();
  6
+use Module::Install::Base ();
  7
+use Fcntl qw/:flock :seek/;
  8
+
  9
+use vars qw{$VERSION @ISA $ISCORE};
  10
+BEGIN {
  11
+	$VERSION = '1.06';
  12
+	@ISA     = 'Module::Install::Base';
  13
+	$ISCORE  = 1;
  14
+}
  15
+
  16
+sub Makefile { $_[0] }
  17
+
  18
+my %seen = ();
  19
+
  20
+sub prompt {
  21
+	shift;
  22
+
  23
+	# Infinite loop protection
  24
+	my @c = caller();
  25
+	if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) {
  26
+		die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])";
  27
+	}
  28
+
  29
+	# In automated testing or non-interactive session, always use defaults
  30
+	if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) {
  31
+		local $ENV{PERL_MM_USE_DEFAULT} = 1;
  32
+		goto &ExtUtils::MakeMaker::prompt;
  33
+	} else {
  34
+		goto &ExtUtils::MakeMaker::prompt;
  35
+	}
  36
+}
  37
+
  38
+# Store a cleaned up version of the MakeMaker version,
  39
+# since we need to behave differently in a variety of
  40
+# ways based on the MM version.
  41
+my $makemaker = eval $ExtUtils::MakeMaker::VERSION;
  42
+
  43
+# If we are passed a param, do a "newer than" comparison.
  44
+# Otherwise, just return the MakeMaker version.
  45
+sub makemaker {
  46
+	( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0
  47
+}
  48
+
  49
+# Ripped from ExtUtils::MakeMaker 6.56, and slightly modified
  50
+# as we only need to know here whether the attribute is an array
  51
+# or a hash or something else (which may or may not be appendable).
  52
+my %makemaker_argtype = (
  53
+ C                  => 'ARRAY',
  54
+ CONFIG             => 'ARRAY',
  55
+# CONFIGURE          => 'CODE', # ignore
  56
+ DIR                => 'ARRAY',
  57
+ DL_FUNCS           => 'HASH',
  58
+ DL_VARS            => 'ARRAY',
  59
+ EXCLUDE_EXT        => 'ARRAY',
  60
+ EXE_FILES          => 'ARRAY',
  61
+ FUNCLIST           => 'ARRAY',
  62
+ H                  => 'ARRAY',
  63
+ IMPORTS            => 'HASH',
  64
+ INCLUDE_EXT        => 'ARRAY',
  65
+ LIBS               => 'ARRAY', # ignore ''
  66
+ MAN1PODS           => 'HASH',
  67
+ MAN3PODS           => 'HASH',
  68
+ META_ADD           => 'HASH',
  69
+ META_MERGE         => 'HASH',
  70
+ PL_FILES           => 'HASH',
  71
+ PM                 => 'HASH',
  72
+ PMLIBDIRS          => 'ARRAY',
  73
+ PMLIBPARENTDIRS    => 'ARRAY',
  74
+ PREREQ_PM          => 'HASH',
  75
+ CONFIGURE_REQUIRES => 'HASH',
  76
+ SKIP               => 'ARRAY',
  77
+ TYPEMAPS           => 'ARRAY',
  78
+ XS                 => 'HASH',
  79
+# VERSION            => ['version',''],  # ignore
  80
+# _KEEP_AFTER_FLUSH  => '',
  81
+
  82
+ clean      => 'HASH',
  83
+ depend     => 'HASH',
  84
+ dist       => 'HASH',
  85
+ dynamic_lib=> 'HASH',
  86
+ linkext    => 'HASH',
  87
+ macro      => 'HASH',
  88
+ postamble  => 'HASH',
  89
+ realclean  => 'HASH',
  90
+ test       => 'HASH',
  91
+ tool_autosplit => 'HASH',
  92
+
  93
+ # special cases where you can use makemaker_append
  94
+ CCFLAGS   => 'APPENDABLE',
  95
+ DEFINE    => 'APPENDABLE',
  96
+ INC       => 'APPENDABLE',
  97
+ LDDLFLAGS => 'APPENDABLE',
  98
+ LDFROM    => 'APPENDABLE',
  99
+);
  100
+
  101
+sub makemaker_args {
  102
+	my ($self, %new_args) = @_;
  103
+	my $args = ( $self->{makemaker_args} ||= {} );
  104
+	foreach my $key (keys %new_args) {
  105
+		if ($makemaker_argtype{$key}) {
  106
+			if ($makemaker_argtype{$key} eq 'ARRAY') {
  107
+				$args->{$key} = [] unless defined $args->{$key};
  108
+				unless (ref $args->{$key} eq 'ARRAY') {
  109
+					$args->{$key} = [$args->{$key}]
  110
+				}
  111
+				push @{$args->{$key}},
  112
+					ref $new_args{$key} eq 'ARRAY'
  113
+						? @{$new_args{$key}}
  114
+						: $new_args{$key};
  115
+			}
  116
+			elsif ($makemaker_argtype{$key} eq 'HASH') {
  117
+				$args->{$key} = {} unless defined $args->{$key};
  118
+				foreach my $skey (keys %{ $new_args{$key} }) {
  119
+					$args->{$key}{$skey} = $new_args{$key}{$skey};
  120
+				}
  121
+			}
  122
+			elsif ($makemaker_argtype{$key} eq 'APPENDABLE') {
  123
+				$self->makemaker_append($key => $new_args{$key});
  124
+			}
  125
+		}
  126
+		else {
  127
+			if (defined $args->{$key}) {
  128
+				warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n};
  129
+			}
  130
+			$args->{$key} = $new_args{$key};
  131
+		}
  132
+	}
  133
+	return $args;
  134
+}
  135
+
  136
+# For mm args that take multiple space-seperated args,
  137
+# append an argument to the current list.
  138
+sub makemaker_append {
  139
+	my $self = shift;
  140
+	my $name = shift;
  141
+	my $args = $self->makemaker_args;
  142
+	$args->{$name} = defined $args->{$name}
  143
+		? join( ' ', $args->{$name}, @_ )
  144
+		: join( ' ', @_ );
  145
+}
  146
+
  147
+sub build_subdirs {
  148
+	my $self    = shift;
  149
+	my $subdirs = $self->makemaker_args->{DIR} ||= [];
  150
+	for my $subdir (@_) {
  151
+		push @$subdirs, $subdir;
  152
+	}
  153
+}
  154
+
  155
+sub clean_files {
  156
+	my $self  = shift;
  157
+	my $clean = $self->makemaker_args->{clean} ||= {};
  158
+	  %$clean = (
  159
+		%$clean,
  160
+		FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_),
  161
+	);
  162
+}
  163
+
  164
+sub realclean_files {
  165
+	my $self      = shift;
  166
+	my $realclean = $self->makemaker_args->{realclean} ||= {};
  167
+	  %$realclean = (
  168
+		%$realclean,
  169
+		FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_),
  170
+	);
  171
+}
  172
+
  173
+sub libs {
  174
+	my $self = shift;
  175
+	my $libs = ref $_[0] ? shift : [ shift ];
  176
+	$self->makemaker_args( LIBS => $libs );
  177
+}
  178
+
  179
+sub inc {
  180
+	my $self = shift;
  181
+	$self->makemaker_args( INC => shift );
  182
+}
  183
+
  184
+sub _wanted_t {
  185
+}
  186
+
  187
+sub tests_recursive {
  188
+	my $self = shift;
  189
+	my $dir = shift || 't';
  190
+	unless ( -d $dir ) {
  191
+		die "tests_recursive dir '$dir' does not exist";
  192
+	}
  193
+	my %tests = map { $_ => 1 } split / /, ($self->tests || '');
  194
+	require File::Find;
  195
+	File::Find::find(
  196
+        sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 },
  197
+        $dir
  198
+    );
  199
+	$self->tests( join ' ', sort keys %tests );
  200
+}
  201
+
  202
+sub write {
  203
+	my $self = shift;
  204
+	die "&Makefile->write() takes no arguments\n" if @_;
  205
+
  206
+	# Check the current Perl version
  207
+	my $perl_version = $self->perl_version;
  208
+	if ( $perl_version ) {
  209
+		eval "use $perl_version; 1"
  210
+			or die "ERROR: perl: Version $] is installed, "
  211
+			. "but we need version >= $perl_version";
  212
+	}
  213
+
  214
+	# Make sure we have a new enough MakeMaker
  215
+	require ExtUtils::MakeMaker;
  216
+
  217
+	if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) {
  218
+		# This previous attempted to inherit the version of
  219
+		# ExtUtils::MakeMaker in use by the module author, but this
  220
+		# was found to be untenable as some authors build releases
  221
+		# using future dev versions of EU:MM that nobody else has.
  222
+		# Instead, #toolchain suggests we use 6.59 which is the most
  223
+		# stable version on CPAN at time of writing and is, to quote
  224
+		# ribasushi, "not terminally fucked, > and tested enough".
  225
+		# TODO: We will now need to maintain this over time to push
  226
+		# the version up as new versions are released.
  227
+		$self->build_requires(     'ExtUtils::MakeMaker' => 6.59 );
  228
+		$self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 );
  229
+	} else {
  230
+		# Allow legacy-compatibility with 5.005 by depending on the
  231
+		# most recent EU:MM that supported 5.005.
  232
+		$self->build_requires(     'ExtUtils::MakeMaker' => 6.36 );
  233
+		$self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 );
  234
+	}
  235
+
  236
+	# Generate the MakeMaker params
  237
+	my $args = $self->makemaker_args;
  238
+	$args->{DISTNAME} = $self->name;
  239
+	$args->{NAME}     = $self->module_name || $self->name;
  240
+	$args->{NAME}     =~ s/-/::/g;
  241
+	$args->{VERSION}  = $self->version or die <<'EOT';
  242
+ERROR: Can't determine distribution version. Please specify it
  243
+explicitly via 'version' in Makefile.PL, or set a valid $VERSION
  244
+in a module, and provide its file path via 'version_from' (or
  245
+'all_from' if you prefer) in Makefile.PL.
  246
+EOT
  247
+
  248
+	if ( $self->tests ) {
  249
+		my @tests = split ' ', $self->tests;
  250
+		my %seen;
  251
+		$args->{test} = {
  252
+			TESTS => (join ' ', grep {!$seen{$_}++} @tests),
  253
+		};
  254
+    } elsif ( $Module::Install::ExtraTests::use_extratests ) {
  255
+        # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness.
  256
+        # So, just ignore our xt tests here.
  257
+	} elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) {
  258
+		$args->{test} = {
  259
+			TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ),
  260
+		};
  261
+	}
  262
+	if ( $] >= 5.005 ) {
  263
+		$args->{ABSTRACT} = $self->abstract;
  264
+		$args->{AUTHOR}   = join ', ', @{$self->author || []};
  265
+	}
  266
+	if ( $self->makemaker(6.10) ) {
  267
+		$args->{NO_META}   = 1;
  268
+		#$args->{NO_MYMETA} = 1;
  269
+	}
  270
+	if ( $self->makemaker(6.17) and $self->sign ) {
  271
+		$args->{SIGN} = 1;
  272
+	}
  273
+	unless ( $self->is_admin ) {
  274
+		delete $args->{SIGN};
  275
+	}
  276
+	if ( $self->makemaker(6.31) and $self->license ) {
  277
+		$args->{LICENSE} = $self->license;
  278
+	}
  279
+
  280
+	my $prereq = ($args->{PREREQ_PM} ||= {});
  281
+	%$prereq = ( %$prereq,
  282
+		map { @$_ } # flatten [module => version]
  283
+		map { @$_ }
  284
+		grep $_,
  285
+		($self->requires)
  286
+	);
  287
+
  288
+	# Remove any reference to perl, PREREQ_PM doesn't support it
  289
+	delete $args->{PREREQ_PM}->{perl};
  290
+
  291
+	# Merge both kinds of requires into BUILD_REQUIRES
  292
+	my $build_prereq = ($args->{BUILD_REQUIRES} ||= {});
  293
+	%$build_prereq = ( %$build_prereq,
  294
+		map { @$_ } # flatten [module => version]
  295
+		map { @$_ }
  296
+		grep $_,
  297
+		($self->configure_requires, $self->build_requires)
  298
+	);
  299
+
  300
+	# Remove any reference to perl, BUILD_REQUIRES doesn't support it
  301
+	delete $args->{BUILD_REQUIRES}->{perl};
  302
+
  303
+	# Delete bundled dists from prereq_pm, add it to Makefile DIR
  304
+	my $subdirs = ($args->{DIR} || []);
  305