[Bps-public-commit] RT-Authen-PAUSE branch, master, updated. 719dd8128c8ca7db65909ef9d7a38357b7991a1f
Thomas Sibley
trs at bestpractical.com
Fri Feb 22 18:31:28 EST 2013
The branch, master has been updated
via 719dd8128c8ca7db65909ef9d7a38357b7991a1f (commit)
via 9f7da34e826c84f4d7f383346ffb3dd7d18504e3 (commit)
via cfcead2e2a9fd86c8eca4af29fdb72b548ec551f (commit)
via b5f659f7401424a17157d59dc2267fe41ff0dc25 (commit)
via 4646247290467685031daf2d3e13cfaa2efbdaa6 (commit)
from 0069b6a2854c09d1cce86ff835a02ff3e62bcf36 (commit)
Summary of changes:
.gitignore | 14 +++
MANIFEST | 3 +-
META.yml | 8 +-
Makefile.PL | 1 -
html/Callbacks/PAUSE/autohandler/Session | 62 +++++--------
inc/Module/AutoInstall.pm | 150 ++++++++++++++++++++++++++-----
inc/Module/Install.pm | 6 +-
inc/Module/Install/AutoInstall.pm | 13 ++-
inc/Module/Install/Base.pm | 2 +-
inc/Module/Install/Can.pm | 85 ++++++++++++++++--
inc/Module/Install/Fetch.pm | 2 +-
inc/Module/Install/Include.pm | 2 +-
inc/Module/Install/Makefile.pm | 27 +++---
inc/Module/Install/Metadata.pm | 22 +++--
inc/Module/Install/RTx.pm | 30 ++-----
inc/Module/Install/Win32.pm | 2 +-
inc/Module/Install/WriteAll.pm | 2 +-
17 files changed, 304 insertions(+), 127 deletions(-)
create mode 100644 .gitignore
- Log -----------------------------------------------------------------
commit 4646247290467685031daf2d3e13cfaa2efbdaa6
Author: Thomas Sibley <trs at bestpractical.com>
Date: Fri Feb 22 15:26:03 2013 -0800
Housekeeping
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..4195615
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,14 @@
+blib*
+Makefile
+Makefile.old
+pm_to_blib*
+*.tar.gz
+.lwpcookies
+cover_db
+pod2htm*.tmp
+/RT-Authen-PAUSE*
+*.bak
+*.swp
+/MYMETA.*
+/t/tmp
+/xt/tmp
diff --git a/MANIFEST b/MANIFEST
index 0b3ea1a..8a929f6 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1,5 +1,6 @@
-html/Callbacks/PAUSE/autohandler/Auth
+html/Callbacks/PAUSE/autohandler/Session
html/Callbacks/PAUSE/Elements/Login/BeforeForm
+html/Callbacks/PAUSE/Elements/Login/Default
inc/Module/AutoInstall.pm
inc/Module/Install.pm
inc/Module/Install/AutoInstall.pm
diff --git a/META.yml b/META.yml
index 9db8f12..4f37469 100644
--- a/META.yml
+++ b/META.yml
@@ -4,11 +4,12 @@ author:
- 'Best Practical Solutions, LLC.'
- 'Thomas Sibley <trs at bestpractical.com>'
build_requires:
- ExtUtils::MakeMaker: 6.42
+ ExtUtils::MakeMaker: 6.36
configure_requires:
- ExtUtils::MakeMaker: 6.42
+ ExtUtils::MakeMaker: 6.36
distribution_type: module
-generated_by: 'Module::Install version 1.01'
+dynamic_config: 1
+generated_by: 'Module::Install version 1.06'
license: gpl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
diff --git a/inc/Module/AutoInstall.pm b/inc/Module/AutoInstall.pm
index 60b90ea..aa7aa92 100644
--- a/inc/Module/AutoInstall.pm
+++ b/inc/Module/AutoInstall.pm
@@ -3,11 +3,12 @@ package Module::AutoInstall;
use strict;
use Cwd ();
+use File::Spec ();
use ExtUtils::MakeMaker ();
use vars qw{$VERSION};
BEGIN {
- $VERSION = '1.03';
+ $VERSION = '1.06';
}
# special map on pre-defined feature sets
@@ -17,11 +18,14 @@ my %FeatureMap = (
);
# various lexical flags
-my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $HasCPANPLUS );
+my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $InstallDepsTarget, $HasCPANPLUS );
my (
- $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly, $AllDeps
+ $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly, $AllDeps,
+ $UpgradeDeps
);
-my ( $PostambleActions, $PostambleUsed );
+my ( $PostambleActions, $PostambleActionsNoTest, $PostambleActionsUpgradeDeps,
+ $PostambleActionsUpgradeDepsNoTest, $PostambleActionsListDeps,
+ $PostambleActionsListAllDeps, $PostambleUsed, $NoTest);
# See if it's a testing or non-interactive session
_accept_default( $ENV{AUTOMATED_TESTING} or ! -t STDIN );
@@ -31,6 +35,10 @@ sub _accept_default {
$AcceptDefault = shift;
}
+sub _installdeps_target {
+ $InstallDepsTarget = shift;
+}
+
sub missing_modules {
return @Missing;
}
@@ -63,6 +71,11 @@ sub _init {
__PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) );
exit 0;
}
+ elsif ( $arg =~ /^--upgradedeps=(.*)$/ ) {
+ $UpgradeDeps = 1;
+ __PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) );
+ exit 0;
+ }
elsif ( $arg =~ /^--default(?:deps)?$/ ) {
$AcceptDefault = 1;
}
@@ -125,7 +138,7 @@ sub import {
# check entirely since we don't want to have to load (and configure)
# an old CPAN just for a cosmetic message
- $UnderCPAN = _check_lock(1) unless $SkipInstall;
+ $UnderCPAN = _check_lock(1) unless $SkipInstall || $InstallDepsTarget;
while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) {
my ( @required, @tests, @skiptests );
@@ -175,7 +188,7 @@ sub import {
}
# XXX: check for conflicts and uninstalls(!) them.
- my $cur = _load($mod);
+ my $cur = _version_of($mod);
if (_version_cmp ($cur, $arg) >= 0)
{
print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n";
@@ -207,6 +220,7 @@ sub import {
$CheckOnly
or ($mandatory and $UnderCPAN)
or $AllDeps
+ or $InstallDepsTarget
or _prompt(
qq{==> Auto-install the }
. ( @required / 2 )
@@ -237,10 +251,17 @@ sub import {
}
}
- if ( @Missing and not( $CheckOnly or $UnderCPAN ) ) {
+ if ( @Missing and not( $CheckOnly or $UnderCPAN) ) {
require Config;
- print
-"*** Dependencies will be installed the next time you type '$Config::Config{make}'.\n";
+ my $make = $Config::Config{make};
+ if ($InstallDepsTarget) {
+ print
+"*** To install dependencies type '$make installdeps' or '$make installdeps_notest'.\n";
+ }
+ else {
+ print
+"*** Dependencies will be installed the next time you type '$make'.\n";
+ }
# make an educated guess of whether we'll need root permission.
print " (You may need to do that as the 'root' user.)\n"
@@ -271,6 +292,10 @@ END_MESSAGE
sub _check_lock {
return unless @Missing or @_;
+ if ($ENV{PERL5_CPANM_IS_RUNNING}) {
+ return _running_under('cpanminus');
+ }
+
my $cpan_env = $ENV{PERL5_CPAN_IS_RUNNING};
if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) {
@@ -324,7 +349,7 @@ sub install {
while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) {
# grep out those already installed
- if ( _version_cmp( _load($pkg), $ver ) >= 0 ) {
+ if ( _version_cmp( _version_of($pkg), $ver ) >= 0 ) {
push @installed, $pkg;
}
else {
@@ -332,6 +357,11 @@ sub install {
}
}
+ if ($UpgradeDeps) {
+ push @modules, @installed;
+ @installed = ();
+ }
+
return @installed unless @modules; # nothing to do
return @installed if _check_lock(); # defer to the CPAN shell
@@ -363,7 +393,7 @@ sub install {
# see if we have successfully installed them
while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
- if ( _version_cmp( _load($pkg), $ver ) >= 0 ) {
+ if ( _version_cmp( _version_of($pkg), $ver ) >= 0 ) {
push @installed, $pkg;
}
elsif ( $args{do_once} and open( FAILED, '>> .#autoinstall.failed' ) ) {
@@ -463,6 +493,11 @@ sub _cpanplus_config {
} else {
die "*** Cannot convert option $key = '$value' to CPANPLUS version.\n";
}
+ push @config, 'prereqs', $value;
+ } elsif ( $key eq 'force' ) {
+ push @config, $key, $value;
+ } elsif ( $key eq 'notest' ) {
+ push @config, 'skiptest', $value;
} else {
die "*** Cannot convert option $key to CPANPLUS version.\n";
}
@@ -497,10 +532,14 @@ sub _install_cpan {
# set additional options
while ( my ( $opt, $arg ) = splice( @config, 0, 2 ) ) {
( $args{$opt} = $arg, next )
- if $opt =~ /^force$/; # pseudo-option
+ if $opt =~ /^(?:force|notest)$/; # pseudo-option
$CPAN::Config->{$opt} = $arg;
}
+ if ($args{notest} && (not CPAN::Shell->can('notest'))) {
+ die "Your version of CPAN is too old to support the 'notest' pragma";
+ }
+
local $CPAN::Config->{prerequisites_policy} = 'follow';
while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
@@ -519,8 +558,16 @@ sub _install_cpan {
delete $INC{$inc};
}
- my $rv = $args{force} ? CPAN::Shell->force( install => $pkg )
- : CPAN::Shell->install($pkg);
+ my $rv = do {
+ if ($args{force}) {
+ CPAN::Shell->force( install => $pkg )
+ } elsif ($args{notest}) {
+ CPAN::Shell->notest( install => $pkg )
+ } else {
+ CPAN::Shell->install($pkg)
+ }
+ };
+
$rv ||= eval {
$CPAN::META->instance( 'CPAN::Distribution', $obj->cpan_file, )
->{install}
@@ -575,7 +622,7 @@ sub _update_to {
my $ver = shift;
return
- if _version_cmp( _load($class), $ver ) >= 0; # no need to upgrade
+ if _version_cmp( _version_of($class), $ver ) >= 0; # no need to upgrade
if (
_prompt( "==> A newer version of $class ($ver) is required. Install?",
@@ -660,16 +707,30 @@ sub _can_write {
# load a module and return the version it reports
sub _load {
- my $mod = pop; # class/instance doesn't matter
+ my $mod = pop; # method/function doesn't matter
my $file = $mod;
-
$file =~ s|::|/|g;
$file .= '.pm';
-
local $@;
return eval { require $file; $mod->VERSION } || ( $@ ? undef: 0 );
}
+# report version without loading a module
+sub _version_of {
+ my $mod = pop; # method/function doesn't matter
+ my $file = $mod;
+ $file =~ s|::|/|g;
+ $file .= '.pm';
+ foreach my $dir ( @INC ) {
+ next if ref $dir;
+ my $path = File::Spec->catfile($dir, $file);
+ next unless -e $path;
+ require ExtUtils::MM_Unix;
+ return ExtUtils::MM_Unix->parse_version($path);
+ }
+ return undef;
+}
+
# Load CPAN.pm and it's configuration
sub _load_cpan {
return if $CPAN::VERSION and $CPAN::Config and not @_;
@@ -763,6 +824,35 @@ sub _make_args {
: "\$(NOECHO) \$(NOOP)"
);
+ my $deps_list = join( ',', @Missing, @Existing );
+
+ $PostambleActionsUpgradeDeps =
+ "\$(PERL) $0 --config=$config --upgradedeps=$deps_list";
+
+ my $config_notest =
+ join( ',', (UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config}),
+ 'notest', 1 )
+ if $Config;
+
+ $PostambleActionsNoTest = (
+ ($missing and not $UnderCPAN)
+ ? "\$(PERL) $0 --config=$config_notest --installdeps=$missing"
+ : "\$(NOECHO) \$(NOOP)"
+ );
+
+ $PostambleActionsUpgradeDepsNoTest =
+ "\$(PERL) $0 --config=$config_notest --upgradedeps=$deps_list";
+
+ $PostambleActionsListDeps =
+ '@$(PERL) -le "print for @ARGV" '
+ . join(' ', map $Missing[$_], grep $_ % 2 == 0, 0..$#Missing);
+
+ my @all = (@Missing, @Existing);
+
+ $PostambleActionsListAllDeps =
+ '@$(PERL) -le "print for @ARGV" '
+ . join(' ', map $all[$_], grep $_ % 2 == 0, 0..$#all);
+
return %args;
}
@@ -797,11 +887,15 @@ sub Write {
sub postamble {
$PostambleUsed = 1;
+ my $fragment;
- return <<"END_MAKE";
+ $fragment .= <<"AUTO_INSTALL" if !$InstallDepsTarget;
config :: installdeps
\t\$(NOECHO) \$(NOOP)
+AUTO_INSTALL
+
+ $fragment .= <<"END_MAKE";
checkdeps ::
\t\$(PERL) $0 --checkdeps
@@ -809,12 +903,28 @@ checkdeps ::
installdeps ::
\t$PostambleActions
+installdeps_notest ::
+\t$PostambleActionsNoTest
+
+upgradedeps ::
+\t$PostambleActionsUpgradeDeps
+
+upgradedeps_notest ::
+\t$PostambleActionsUpgradeDepsNoTest
+
+listdeps ::
+\t$PostambleActionsListDeps
+
+listalldeps ::
+\t$PostambleActionsListAllDeps
+
END_MAKE
+ return $fragment;
}
1;
__END__
-#line 1071
+#line 1193
diff --git a/inc/Module/Install.pm b/inc/Module/Install.pm
index 74caf9c..4ecf46b 100644
--- a/inc/Module/Install.pm
+++ b/inc/Module/Install.pm
@@ -31,7 +31,7 @@ BEGIN {
# This is not enforced yet, but will be some time in the next few
# releases once we can make sure it won't clash with custom
# Module::Install extensions.
- $VERSION = '1.01';
+ $VERSION = '1.06';
# Storage for the pseudo-singleton
$MAIN = undef;
@@ -451,7 +451,7 @@ sub _version ($) {
}
sub _cmp ($$) {
- _version($_[0]) <=> _version($_[1]);
+ _version($_[1]) <=> _version($_[2]);
}
# Cloned from Params::Util::_CLASS
@@ -467,4 +467,4 @@ sub _CLASS ($) {
1;
-# Copyright 2008 - 2011 Adam Kennedy.
+# Copyright 2008 - 2012 Adam Kennedy.
diff --git a/inc/Module/Install/AutoInstall.pm b/inc/Module/Install/AutoInstall.pm
index bc3d172..6efe4fe 100644
--- a/inc/Module/Install/AutoInstall.pm
+++ b/inc/Module/Install/AutoInstall.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.01';
+ $VERSION = '1.06';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -73,6 +73,17 @@ sub auto_install {
);
}
+sub installdeps_target {
+ my ($self, @args) = @_;
+
+ $self->include('Module::AutoInstall');
+ require Module::AutoInstall;
+
+ Module::AutoInstall::_installdeps_target(1);
+
+ $self->auto_install(@args);
+}
+
sub auto_install_now {
my $self = shift;
$self->auto_install(@_);
diff --git a/inc/Module/Install/Base.pm b/inc/Module/Install/Base.pm
index d3662c9..802844a 100644
--- a/inc/Module/Install/Base.pm
+++ b/inc/Module/Install/Base.pm
@@ -4,7 +4,7 @@ package Module::Install::Base;
use strict 'vars';
use vars qw{$VERSION};
BEGIN {
- $VERSION = '1.01';
+ $VERSION = '1.06';
}
# Suspend handler for "redefined" warnings
diff --git a/inc/Module/Install/Can.pm b/inc/Module/Install/Can.pm
index 276409a..22167b8 100644
--- a/inc/Module/Install/Can.pm
+++ b/inc/Module/Install/Can.pm
@@ -3,13 +3,12 @@ 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';
+ $VERSION = '1.06';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -29,7 +28,7 @@ sub can_use {
eval { require $mod; $pkg->VERSION($ver || 0); 1 };
}
-# check if we can run some command
+# Check if we can run some command
sub can_run {
my ($self, $cmd) = @_;
@@ -38,14 +37,88 @@ sub can_run {
for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
next if $dir eq '';
- my $abs = File::Spec->catfile($dir, $_[1]);
+ require File::Spec;
+ my $abs = File::Spec->catfile($dir, $cmd);
return $abs if (-x $abs or $abs = MM->maybe_command($abs));
}
return;
}
-# can we locate a (the) C compiler
+# Can our C compiler environment build XS files
+sub can_xs {
+ my $self = shift;
+
+ # Ensure we have the CBuilder module
+ $self->configure_requires( 'ExtUtils::CBuilder' => 0.27 );
+
+ # Do we have the configure_requires checker?
+ local $@;
+ eval "require ExtUtils::CBuilder;";
+ if ( $@ ) {
+ # They don't obey configure_requires, so it is
+ # someone old and delicate. Try to avoid hurting
+ # them by falling back to an older simpler test.
+ return $self->can_cc();
+ }
+
+ # Do we have a working C compiler
+ my $builder = ExtUtils::CBuilder->new(
+ quiet => 1,
+ );
+ unless ( $builder->have_compiler ) {
+ # No working C compiler
+ return 0;
+ }
+
+ # Write a C file representative of what XS becomes
+ require File::Temp;
+ my ( $FH, $tmpfile ) = File::Temp::tempfile(
+ "compilexs-XXXXX",
+ SUFFIX => '.c',
+ );
+ binmode $FH;
+ print $FH <<'END_C';
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+int main(int argc, char **argv) {
+ return 0;
+}
+
+int boot_sanexs() {
+ return 1;
+}
+
+END_C
+ close $FH;
+
+ # Can the C compiler access the same headers XS does
+ my @libs = ();
+ my $object = undef;
+ eval {
+ local $^W = 0;
+ $object = $builder->compile(
+ source => $tmpfile,
+ );
+ @libs = $builder->link(
+ objects => $object,
+ module_name => 'sanexs',
+ );
+ };
+ my $result = $@ ? 0 : 1;
+
+ # Clean up all the build files
+ foreach ( $tmpfile, $object, @libs ) {
+ next unless defined $_;
+ 1 while unlink;
+ }
+
+ return $result;
+}
+
+# Can we locate a (the) C compiler
sub can_cc {
my $self = shift;
my @chunks = split(/ /, $Config::Config{cc}) or return;
@@ -78,4 +151,4 @@ if ( $^O eq 'cygwin' ) {
__END__
-#line 156
+#line 236
diff --git a/inc/Module/Install/Fetch.pm b/inc/Module/Install/Fetch.pm
index 093cb7a..bee0c4f 100644
--- a/inc/Module/Install/Fetch.pm
+++ b/inc/Module/Install/Fetch.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.01';
+ $VERSION = '1.06';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
diff --git a/inc/Module/Install/Include.pm b/inc/Module/Install/Include.pm
index 90cc979..8310e4c 100644
--- a/inc/Module/Install/Include.pm
+++ b/inc/Module/Install/Include.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.01';
+ $VERSION = '1.06';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
diff --git a/inc/Module/Install/Makefile.pm b/inc/Module/Install/Makefile.pm
index 4c71003..7052f36 100644
--- a/inc/Module/Install/Makefile.pm
+++ b/inc/Module/Install/Makefile.pm
@@ -8,7 +8,7 @@ use Fcntl qw/:flock :seek/;
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.01';
+ $VERSION = '1.06';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -215,18 +215,22 @@ sub write {
require ExtUtils::MakeMaker;
if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) {
- # MakeMaker can complain about module versions that include
- # an underscore, even though its own version may contain one!
- # Hence the funny regexp to get rid of it. See RT #35800
- # for details.
- my $v = $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/;
- $self->build_requires( 'ExtUtils::MakeMaker' => $v );
- $self->configure_requires( 'ExtUtils::MakeMaker' => $v );
+ # This previous attempted to inherit the version of
+ # ExtUtils::MakeMaker in use by the module author, but this
+ # was found to be untenable as some authors build releases
+ # using future dev versions of EU:MM that nobody else has.
+ # Instead, #toolchain suggests we use 6.59 which is the most
+ # stable version on CPAN at time of writing and is, to quote
+ # ribasushi, "not terminally fucked, > and tested enough".
+ # TODO: We will now need to maintain this over time to push
+ # the version up as new versions are released.
+ $self->build_requires( 'ExtUtils::MakeMaker' => 6.59 );
+ $self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 );
} else {
# Allow legacy-compatibility with 5.005 by depending on the
# most recent EU:MM that supported 5.005.
- $self->build_requires( 'ExtUtils::MakeMaker' => 6.42 );
- $self->configure_requires( 'ExtUtils::MakeMaker' => 6.42 );
+ $self->build_requires( 'ExtUtils::MakeMaker' => 6.36 );
+ $self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 );
}
# Generate the MakeMaker params
@@ -241,7 +245,6 @@ in a module, and provide its file path via 'version_from' (or
'all_from' if you prefer) in Makefile.PL.
EOT
- $DB::single = 1;
if ( $self->tests ) {
my @tests = split ' ', $self->tests;
my %seen;
@@ -412,4 +415,4 @@ sub postamble {
__END__
-#line 541
+#line 544
diff --git a/inc/Module/Install/Metadata.pm b/inc/Module/Install/Metadata.pm
index 3b01e09..58430f3 100644
--- a/inc/Module/Install/Metadata.pm
+++ b/inc/Module/Install/Metadata.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.01';
+ $VERSION = '1.06';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -151,15 +151,21 @@ sub install_as_site { $_[0]->installdirs('site') }
sub install_as_vendor { $_[0]->installdirs('vendor') }
sub dynamic_config {
- my $self = shift;
- unless ( @_ ) {
- warn "You MUST provide an explicit true/false value to dynamic_config\n";
- return $self;
+ my $self = shift;
+ my $value = @_ ? shift : 1;
+ if ( $self->{values}->{dynamic_config} ) {
+ # Once dynamic we never change to static, for safety
+ return 0;
}
- $self->{values}->{dynamic_config} = $_[0] ? 1 : 0;
+ $self->{values}->{dynamic_config} = $value ? 1 : 0;
return 1;
}
+# Convenience command
+sub static_config {
+ shift->dynamic_config(0);
+}
+
sub perl_version {
my $self = shift;
return $self->{values}->{perl_version} unless @_;
@@ -170,7 +176,7 @@ sub perl_version {
# Normalize the version
$version = $self->_perl_version($version);
- # We don't support the reall old versions
+ # We don't support the really old versions
unless ( $version >= 5.005 ) {
die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n";
}
@@ -582,7 +588,7 @@ sub bugtracker_from {
sub requires_from {
my $self = shift;
my $content = Module::Install::_readperl($_[0]);
- my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg;
+ my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg;
while ( @requires ) {
my $module = shift @requires;
my $version = shift @requires;
diff --git a/inc/Module/Install/RTx.pm b/inc/Module/Install/RTx.pm
index 73b9cda..ce01018 100644
--- a/inc/Module/Install/RTx.pm
+++ b/inc/Module/Install/RTx.pm
@@ -8,7 +8,7 @@ no warnings 'once';
use Module::Install::Base;
use base 'Module::Install::Base';
-our $VERSION = '0.29';
+our $VERSION = '0.30';
use FindBin;
use File::Glob ();
@@ -129,18 +129,7 @@ install ::
my %has_etc;
if ( File::Glob::bsd_glob("$FindBin::Bin/etc/schema.*") ) {
-
- # got schema, load factory module
$has_etc{schema}++;
- $self->load('RTxFactory');
- $self->postamble(<< ".");
-factory ::
-\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxFactory(qw($RTx $name))"
-
-dropdb ::
-\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxFactory(qw($RTx $name drop))"
-
-.
}
if ( File::Glob::bsd_glob("$FindBin::Bin/etc/acl.*") ) {
$has_etc{acl}++;
@@ -164,28 +153,19 @@ dropdb ::
print "For first-time installation, type 'make initdb'.\n";
my $initdb = '';
$initdb .= <<"." if $has_etc{schema};
-\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(schema))"
+\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(schema \$(NAME) \$(VERSION)))"
.
$initdb .= <<"." if $has_etc{acl};
-\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(acl))"
+\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(acl \$(NAME) \$(VERSION)))"
.
$initdb .= <<"." if $has_etc{initialdata};
-\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(insert))"
+\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(insert \$(NAME) \$(VERSION)))"
.
$self->postamble("initdb ::\n$initdb\n");
$self->postamble("initialize-database ::\n$initdb\n");
}
}
-sub RTxInit {
- unshift @INC, substr( delete( $INC{'RT.pm'} ), 0, -5 ) if $INC{'RT.pm'};
- require RT;
- RT::LoadConfig();
- RT::ConnectToDatabase();
-
- die "Cannot load RT" unless $RT::Handle and $RT::DatabaseType;
-}
-
# stolen from RT::Handle so we work on 3.6 (cmp_versions came in with 3.8)
{ my %word = (
a => -4,
@@ -228,4 +208,4 @@ sub requires_rt {
__END__
-#line 348
+#line 328
diff --git a/inc/Module/Install/Win32.pm b/inc/Module/Install/Win32.pm
index 3139a63..eeaa3fe 100644
--- a/inc/Module/Install/Win32.pm
+++ b/inc/Module/Install/Win32.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.01';
+ $VERSION = '1.06';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
diff --git a/inc/Module/Install/WriteAll.pm b/inc/Module/Install/WriteAll.pm
index 1f724a7..85d8018 100644
--- a/inc/Module/Install/WriteAll.pm
+++ b/inc/Module/Install/WriteAll.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.01';
+ $VERSION = '1.06';
@ISA = qw{Module::Install::Base};
$ISCORE = 1;
}
commit b5f659f7401424a17157d59dc2267fe41ff0dc25
Author: Thomas Sibley <trs at bestpractical.com>
Date: Fri Feb 22 15:26:14 2013 -0800
Avoid trying to auth empty users
This can happen when the login form is submitted for other auth types
where user is blank, such as OpenID.
diff --git a/html/Callbacks/PAUSE/autohandler/Session b/html/Callbacks/PAUSE/autohandler/Session
index ee3c22e..8366490 100644
--- a/html/Callbacks/PAUSE/autohandler/Session
+++ b/html/Callbacks/PAUSE/autohandler/Session
@@ -9,7 +9,7 @@ use HTTP::Request;
# somebody is logged in
return if $session{'CurrentUser'} and $session{'CurrentUser'}->Id;
# no credentials
-return unless defined $user && defined $pass;
+return unless defined $user and length $user and defined $pass;
# we don't auth root at localhost, which should be the local RT root
return if lc $user eq 'root at localhost';
commit cfcead2e2a9fd86c8eca4af29fdb72b548ec551f
Author: Thomas Sibley <trs at bestpractical.com>
Date: Fri Feb 22 15:26:17 2013 -0800
Redirect to the desired next page on successful auth
diff --git a/html/Callbacks/PAUSE/autohandler/Session b/html/Callbacks/PAUSE/autohandler/Session
index 8366490..8a026ee 100644
--- a/html/Callbacks/PAUSE/autohandler/Session
+++ b/html/Callbacks/PAUSE/autohandler/Session
@@ -6,6 +6,19 @@ $pass => undef
use LWP::UserAgent;
use HTTP::Request;
+my $success = sub {
+ my $next = $session{'NextPage'}->{ $ARGS{'next'} || "" };
+ $next = $next->{'url'} if ref $next;
+
+ RT::Interface::Web::InstantiateNewSession();
+ $session{'CurrentUser'} = $_[0];
+
+ RT::Interface::Web::Redirect( $next )
+ if $next and $m->request_comp->path eq '/NoAuth/Login.html';
+
+ return;
+};
+
# somebody is logged in
return if $session{'CurrentUser'} and $session{'CurrentUser'}->Id;
# no credentials
@@ -26,8 +39,7 @@ unless ( $cu->id ) {
# try to auth against local DB
if ( $cu->IsPassword( $pass ) ) {
- $session{'CurrentUser'} = $cu;
- return;
+ return $success->($cu);
}
# no luck with local try PAUSE's auth
@@ -48,9 +60,6 @@ unless ( $res->code == 200 ) {
return;
}
-# Successful login
-$session{'CurrentUser'} = $cu;
-
# we'll cache the password, but we'll use system user as the current
# user may have no right to modify his own password
my $user_obj = RT::User->new( $RT::SystemUser );
@@ -70,4 +79,6 @@ unless ( $status ) {
$RT::Logger->debug("Updated ". $user ."'s password with one from PAUSE");
}
+# Successful login
+return $success->($cu);
</%INIT>
commit 9f7da34e826c84f4d7f383346ffb3dd7d18504e3
Author: Thomas Sibley <trs at bestpractical.com>
Date: Fri Feb 22 15:26:19 2013 -0800
No need to manually use HTTP::Request
diff --git a/META.yml b/META.yml
index 4f37469..4f0d272 100644
--- a/META.yml
+++ b/META.yml
@@ -20,7 +20,6 @@ no_index:
- html
- inc
requires:
- HTTP::Request: 0
LWP::UserAgent: 0
resources:
license: http://opensource.org/licenses/gpl-license.php
diff --git a/Makefile.PL b/Makefile.PL
index 1bddfd6..fd68d0f 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -9,7 +9,6 @@ version_from ('lib/RT/Authen/PAUSE.pm');
license ('GPL version 2');
requires ('LWP::UserAgent');
-requires ('HTTP::Request');
auto_install();
diff --git a/html/Callbacks/PAUSE/autohandler/Session b/html/Callbacks/PAUSE/autohandler/Session
index 8a026ee..a8aa430 100644
--- a/html/Callbacks/PAUSE/autohandler/Session
+++ b/html/Callbacks/PAUSE/autohandler/Session
@@ -4,7 +4,6 @@ $pass => undef
</%ARGS>
<%INIT>
use LWP::UserAgent;
-use HTTP::Request;
my $success = sub {
my $next = $session{'NextPage'}->{ $ARGS{'next'} || "" };
@@ -46,8 +45,7 @@ if ( $cu->IsPassword( $pass ) ) {
my $ua = LWP::UserAgent->new();
$ua->credentials('pause.perl.org:443', 'PAUSE', $user, $pass);
-my $req = HTTP::Request->new(GET => 'https://pause.perl.org/pause/authenquery');
-my $res = $ua->request($req);
+my $res = $ua->get('https://pause.perl.org/pause/authenquery');
unless ( $res->code == 200 ) {
# if 401 then no dice, login failed... do we want to do something
commit 719dd8128c8ca7db65909ef9d7a38357b7991a1f
Author: Thomas Sibley <trs at bestpractical.com>
Date: Fri Feb 22 15:26:22 2013 -0800
Rip out local caching of successful passwords
Hopefully pause.perl.org is much more reliable than 7 years ago. We can
re-add it if necessary, but this reduces complexity and means old
passwords won't continue to work between the time you change it on PAUSE
and the time you next login to rt.cpan.org with the new password.
diff --git a/html/Callbacks/PAUSE/autohandler/Session b/html/Callbacks/PAUSE/autohandler/Session
index a8aa430..d9b0886 100644
--- a/html/Callbacks/PAUSE/autohandler/Session
+++ b/html/Callbacks/PAUSE/autohandler/Session
@@ -5,19 +5,6 @@ $pass => undef
<%INIT>
use LWP::UserAgent;
-my $success = sub {
- my $next = $session{'NextPage'}->{ $ARGS{'next'} || "" };
- $next = $next->{'url'} if ref $next;
-
- RT::Interface::Web::InstantiateNewSession();
- $session{'CurrentUser'} = $_[0];
-
- RT::Interface::Web::Redirect( $next )
- if $next and $m->request_comp->path eq '/NoAuth/Login.html';
-
- return;
-};
-
# somebody is logged in
return if $session{'CurrentUser'} and $session{'CurrentUser'}->Id;
# no credentials
@@ -27,56 +14,40 @@ return if lc $user eq 'root at localhost';
$user = uc $user;
-# Try to load the user by PAUSE_ID at cpan.org
+# Try to load the user by PAUSE_ID
my $cu = RT::CurrentUser->new();
$cu->LoadByName( $user );
unless ( $cu->id ) {
$RT::Logger->warning("No user '$user' in DB, broken import of users from pause?");
return;
}
-# we get the user, great
-# try to auth against local DB
-if ( $cu->IsPassword( $pass ) ) {
- return $success->($cu);
-}
-
-# no luck with local try PAUSE's auth
-my $ua = LWP::UserAgent->new();
+# Proxy to PAUSE's auth
+my $ua = LWP::UserAgent->new( timeout => 5 );
$ua->credentials('pause.perl.org:443', 'PAUSE', $user, $pass);
my $res = $ua->get('https://pause.perl.org/pause/authenquery');
-unless ( $res->code == 200 ) {
- # if 401 then no dice, login failed... do we want to do something
- # different here or just let it fall through to the default
- # autohandler to error out?
-
- $RT::Logger->warning("PAUSE authentication failed with " . $res->code);
+# Successful login
+if ($res->code == 200) {
+ $RT::Logger->info("PAUSE login by $user from $ENV{REMOTE_ADDR}");
- # Other code => oops, PAUSE is down, or something
- return;
-}
+ my $next = $session{'NextPage'}->{ $ARGS{'next'} || "" };
+ $next = $next->{'url'} if ref $next;
-# we'll cache the password, but we'll use system user as the current
-# user may have no right to modify his own password
-my $user_obj = RT::User->new( $RT::SystemUser );
-$user_obj->Load( $cu->id );
-unless ( $user_obj->id ) {
- $RT::Logger->crit("Couldn't load user #". $cu->id);
- return;
-}
+ RT::Interface::Web::InstantiateNewSession();
+ $session{'CurrentUser'} = $cu;
-my ($status, $msg) = $user_obj->SetPassword( $pass );
-unless ( $status ) {
- $RT::Logger->error(
- "Couldn't set users password: $msg."
- ." Next time we'll have to ask PAUSE service again"
- );
+ RT::Interface::Web::Redirect( $next )
+ if $next and $m->request_comp->path eq '/NoAuth/Login.html';
} else {
- $RT::Logger->debug("Updated ". $user ."'s password with one from PAUSE");
+ $RT::Logger->warning("PAUSE authentication failed with " . $res->code);
+
+ # If 401 then no dice, login failed.
+ # Other code => oops, PAUSE is down, or something.
+ $session{"Actions"}{""} = [loc("Unable to contact PAUSE for authentication (status [_1])", $res->code)]
+ if $res->code != 401;
}
-# Successful login
-return $success->($cu);
+return;
</%INIT>
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list