Imported Upstream version 0.09 upstream
authorAndrew Ruthven <andrew@etc.gen.nz>
Wed, 10 Aug 2011 11:11:27 +0000 (23:11 +1200)
committerAndrew Ruthven <andrew@etc.gen.nz>
Wed, 10 Aug 2011 11:11:27 +0000 (23:11 +1200)
32 files changed:
ChangeLog [changed mode: 0755->0644]
LICENSE [changed mode: 0755->0644]
MANIFEST [changed mode: 0755->0644]
META.yml [changed mode: 0755->0644]
Makefile.PL
README [changed mode: 0755->0644]
etc/RT_SiteConfig.pm [changed mode: 0755->0644]
html/Callbacks/ExternalAuth/Elements/Header/Head [new file with mode: 0644]
html/Callbacks/ExternalAuth/autohandler/Auth [changed mode: 0755->0644]
html/Callbacks/ExternalAuth/autohandler/Session [new file with mode: 0644]
html/Elements/DoAuth [new file with mode: 0644]
inc/Module/AutoInstall.pm [new file with mode: 0644]
inc/Module/Install.pm [changed mode: 0755->0644]
inc/Module/Install/AuthorTests.pm [new file with mode: 0644]
inc/Module/Install/AutoInstall.pm [new file with mode: 0644]
inc/Module/Install/Base.pm [changed mode: 0755->0644]
inc/Module/Install/Can.pm [changed mode: 0755->0644]
inc/Module/Install/Fetch.pm [changed mode: 0755->0644]
inc/Module/Install/Include.pm [new file with mode: 0644]
inc/Module/Install/Makefile.pm [changed mode: 0755->0644]
inc/Module/Install/Metadata.pm [changed mode: 0755->0644]
inc/Module/Install/RTx.pm [changed mode: 0755->0644]
inc/Module/Install/Win32.pm [changed mode: 0755->0644]
inc/Module/Install/WriteAll.pm [changed mode: 0755->0644]
lib/RT/Authen/ExternalAuth.pm [changed mode: 0755->0644]
lib/RT/Authen/ExternalAuth/DBI.pm [changed mode: 0755->0644]
lib/RT/Authen/ExternalAuth/DBI/Cookie.pm [changed mode: 0755->0644]
lib/RT/Authen/ExternalAuth/LDAP.pm [changed mode: 0755->0644]
lib/RT/User_Vendor.pm [deleted file]
xt/ldap.t [new file with mode: 0644]
xt/ldap_privileged.t [new file with mode: 0644]
xt/sqlite.t [new file with mode: 0644]

old mode 100755 (executable)
new mode 100644 (file)
index 183d94b..700a971
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,32 @@
+0.09 2011-05-06 Kevin Falcone
+       * compatibility fixes for 3.8.10 and 4.0.0
+       * author testsuite
+       * updated README
+
+v0.08_01 2011-02-18 Kevin Falcone
+       * Testing prerelase for 0.09, since 0.09_01 never made it to CPAN
+       * Upgrade Module::Install
+       * Remove and then replace a requires('RT') since Module::Install::RTx now
+         handles that
+       * Fix the features/recommends to work with modern MI
+       * Use CSS to hide password box for ExternalAuth users so they don't think
+         they can change their password via RT
+       * Fix for 3.8.9/4.0.0 to work with new Login infrastructure
+
+
+NEVER RELEASED v0.09_01  2009-03-28    Mike Peachey <zordrak@cpan.org>
+
+    * Makefile.PL
+    
+        Removed RT requirement since most RT installs are not done
+        via CPAN and therefore CPAN installation fails dependency
+        checking.
+        
+    * ChangeLog
+    
+        Added entry for v0.09_01
+        
+        
 v0.08     2009-01-24    Mike Peachey <zordrak@cpan.org>
 
     * lib/RT/Authen/ExternalAuth.pm
diff --git a/LICENSE b/LICENSE
old mode 100755 (executable)
new mode 100644 (file)
old mode 100755 (executable)
new mode 100644 (file)
index 0673a83..470729e
--- a/MANIFEST
+++ b/MANIFEST
@@ -1,10 +1,17 @@
 ChangeLog
 etc/RT_SiteConfig.pm
 html/Callbacks/ExternalAuth/autohandler/Auth
+html/Callbacks/ExternalAuth/autohandler/Session
+html/Callbacks/ExternalAuth/Elements/Header/Head
+html/Elements/DoAuth
+inc/Module/AutoInstall.pm
 inc/Module/Install.pm
+inc/Module/Install/AuthorTests.pm
+inc/Module/Install/AutoInstall.pm
 inc/Module/Install/Base.pm
 inc/Module/Install/Can.pm
 inc/Module/Install/Fetch.pm
+inc/Module/Install/Include.pm
 inc/Module/Install/Makefile.pm
 inc/Module/Install/Metadata.pm
 inc/Module/Install/RTx.pm
@@ -12,11 +19,13 @@ inc/Module/Install/Win32.pm
 inc/Module/Install/WriteAll.pm
 lib/RT/Authen/ExternalAuth.pm
 lib/RT/Authen/ExternalAuth/DBI.pm
-lib/RT/Authen/ExternalAuth/LDAP.pm
 lib/RT/Authen/ExternalAuth/DBI/Cookie.pm
-lib/RT/User_Vendor.pm
+lib/RT/Authen/ExternalAuth/LDAP.pm
 LICENSE
 Makefile.PL
 MANIFEST                       This list of files
 META.yml
 README
+xt/ldap.t
+xt/ldap_privileged.t
+xt/sqlite.t
old mode 100755 (executable)
new mode 100644 (file)
index f5e16ed..21c2e4e
--- a/META.yml
+++ b/META.yml
@@ -1,21 +1,35 @@
---- 
-abstract: RT Authen-ExternalAuth Extension
-author: 
-  - Mike Peachey <zordrak@cpan.org>
+---
+abstract: 'RT Authen-ExternalAuth Extension'
+author:
+  - 'Mike Peachey <zordrak@cpan.org>'
+build_requires:
+  ExtUtils::MakeMaker: 6.42
+configure_requires:
+  ExtUtils::MakeMaker: 6.42
 distribution_type: module
-generated_by: Module::Install version 0.70
-license: GPL version 2
-meta-spec: 
-  url: http://module-build.sourceforge.net/META-spec-v1.3.html
-  version: 1.3
+generated_by: 'Module::Install version 1.00'
+license: gpl
+meta-spec:
+  url: http://module-build.sourceforge.net/META-spec-v1.4.html
+  version: 1.4
 name: RT-Authen-ExternalAuth
-no_index: 
-  directory: 
+no_index:
+  directory:
     - etc
     - html
-    - po
-    - var
     - inc
-requires: 
-  RT: 0
-version: 0.07_02
+    - t
+    - xt
+recommends:
+  CGI::Cookie: 0
+  DBI: 0
+  Net::LDAP: 0
+  Net::SSLeay: 0
+requires:
+  CGI::Cookie: 0
+  DBI: 0
+  Net::LDAP: 0
+  Net::SSLeay: 0
+resources:
+  license: http://opensource.org/licenses/gpl-license.php
+version: 0.09
index 2ad8ebf..4e55763 100755 (executable)
@@ -7,20 +7,30 @@ author('Mike Peachey <zordrak@cpan.org>');
 
 all_from('lib/RT/Authen/ExternalAuth.pm');
 
-requires('RT');
-
-features(
-  'SSL LDAP Connections' => [
+feature 'SSL LDAP Connections' =>
     -default => 0,
-    'Net::SSLeay' => 0],
-  'External LDAP Sources' => [
+    recommends('Net::SSLeay' => 0),
+    ;
+
+feature 'External LDAP Sources' => 
     -default => 1,
-    'Net::LDAP' => 0],
-  'External DBI Sources' => [
+    recommends('Net::LDAP' => 0),
+    ;
+
+feature 'External DBI Sources' =>
     -default => 1,
-    'DBI' => 0],
-  'SSO Cookie Sources' => [
+    recommends('DBI' => 0),
+    ;
+
+feature 'SSO Cookie Sources' => 
     -default => 1,
-    'CGI::Cookies' => 0]
-);
+    recommends('CGI::Cookie' => 0),
+    ;
+
+author_tests('xt');
+
+requires_rt('3.8.2');
+
+&auto_install();
+
 &WriteAll;
diff --git a/README b/README
old mode 100755 (executable)
new mode 100644 (file)
index 511e453..4696bcc
--- a/README
+++ b/README
@@ -1,5 +1,42 @@
 RT-Authen-ExternalAuth
 
+=========================
+Important Upgrading Notes:
+=========================
+
+If you are upgrading from an earlier version of this extension, you must
+remove the following files manually:
+
+    $RTHOME/local/plugins/RT-Authen-ExternalAuth/lib/RT/User_Vendor.pm
+    $RTHOME/local/lib/RT/User_Vendor.pm
+    $RTHOME/local/lib/RT/Authen/External_Auth.pm
+
+Otherwise you will most likely encounter an error about modifying a read
+only value and be unable to start RT.
+
+You may not have all of these files.  It depends what versions you are
+upgrading between.
+
+If you are using a vendor packaged RT, your local directories are likely
+to be somewhere under /usr/local instead of in $RTHOME so you will need
+to visit Configuration -> Tools -> System Configuration to find your
+plugin root.
+
+=========================
+Import Version Notes:
+=========================
+
+If you are using RT 3.6, you want to use the 0.05 version.
+
+If you are using RT 3.8.0 or 3.8.1, you may have trouble using this
+due to RT bugs related to plugins, but you may be able to use 0.08.
+
+0.08_02 or later will not work on 3.8.0 or 3.8.1
+
+=================
+About This Module
+=================
+
 This module provides the ability to authenticate RT users
 against one or more external data sources at once. It will
 also allow information about that user to be loaded from
@@ -56,35 +93,26 @@ module by adding RT::Authen::ExternalAuth to your
 
 Set( @Plugins, qw(RT::Authen::ExternalAuth) );
 
+If you already have a @Plugins line, add RT::Authen::ExternalAuth to the
+existing list.  Adding a second @Plugins line will cause interesting
+bugs.
+
 Once installed, you should view the file:
     
 3.4/3.6    $RTHOME/local/etc/ExternalAuth/RT_SiteConfig.pm
-3.8        $RTHOME/local/plugins/RT-Auth-ExternalAuth/etc/RT_SiteConfig.pm
+3.8        $RTHOME/local/plugins/RT-Authen-ExternalAuth/etc/RT_SiteConfig.pm
 
 Then use the examples provided to prepare your own custom 
 configuration which should be added to your site configuration in
 $RTHOME/etc/RT_SiteConfig.pm
 
-Alternatively, you may alter the provided examples directly
-and then include the extra directives by 'requiring' the
-example file's path at the end of your RT_SiteConfig.pm
-
-
-UPGRADING
-
-If you are upgrading from 0.05 you may have some leftover
-parts of the module in 
-
-$RTHOME/local/lib/RT/User_Vendor.pm 
-$RTHOME/local/lib/RT/Authen/External_Auth.pm
-
-that will conflict with the new install and these should be removed
-
 AUTHOR
         Mike Peachey
         Jennic Ltd.
         zordrak@cpan.org
 
+        Various Best Practical Developers
+
 COPYRIGHT AND LICENCE
 
 Copyright (C) 2008, Jennic Ltd.
old mode 100755 (executable)
new mode 100644 (file)
diff --git a/html/Callbacks/ExternalAuth/Elements/Header/Head b/html/Callbacks/ExternalAuth/Elements/Header/Head
new file mode 100644 (file)
index 0000000..7ba3b16
--- /dev/null
@@ -0,0 +1,11 @@
+% if ( $session{CurrentUser}->UserObj->__Value('Password') eq '*NO-PASSWORD*') {
+<style>
+#user-prefs-password {
+    display: none;
+}
+</style>
+% }
+<%INIT>
+return unless $m->request_comp->path eq '/User/Prefs.html';
+return unless $session{CurrentUser} && $session{CurrentUser}->id;
+</%INIT>
old mode 100755 (executable)
new mode 100644 (file)
index e188be4..3cae3fd
@@ -1,36 +1 @@
-<%once>
-my $loaded_user = 0;
-</%once>
-<%init>
-
-use RT::Authen::ExternalAuth;
-
-###################################################################################
-# Work around a bug in the RT 3.8.0 and 3.8.1 plugin system (fixed in 3.8.2)      #
-# Temporarily force RT to reload RT::User, since it isn't being loaded            #
-# correctly as a plugin.                                                          #
-###################################################################################
-unless ($loaded_user) {                                                           
-    $RT::Logger->debug("Reloading RT::User to work around a bug in RT-3.8.0 and RT-3.8.1");
-    $loaded_user++;
-    delete $INC{'RT/User.pm'};
-    delete $INC{'RT/User_Overlay.pm'};
-    delete $INC{'RT/User_Vendor.pm'};
-    require RT::User;
-}
-###################################################################################
-
-my ($val,$msg);
-unless($session{'CurrentUser'} && $session{'CurrentUser'}->Id) {
-    ($val,$msg) = RT::Authen::ExternalAuth::DoAuth(\%session,$user,$pass);
-    $RT::Logger->debug("Autohandler called ExternalAuth. Response: ($val, $msg)");
-}
-
-return;
-</%init>
-
-<%ARGS>
-$user => undef
-$pass => undef
-$menu => undef
-</%ARGS>
+%$m->comp('/Elements/DoAuth',%ARGS);
diff --git a/html/Callbacks/ExternalAuth/autohandler/Session b/html/Callbacks/ExternalAuth/autohandler/Session
new file mode 100644 (file)
index 0000000..e8ef014
--- /dev/null
@@ -0,0 +1,12 @@
+<%init>
+$m->comp('/Elements/DoAuth',%ARGS);
+
+# 3.8.9 doesn't redirect to the specified page if request has one.
+if (   $m->request_comp->path eq '/NoAuth/Login.html'
+    && RT::Interface::Web::_UserLoggedIn()
+    && $ARGS{next} )
+{
+    my $next = delete $session{'NextPage'}->{ $ARGS{'next'} };
+    RT::Interface::Web::Redirect( $next || RT->Config->Get('WebURL') );
+}
+</%init>
diff --git a/html/Elements/DoAuth b/html/Elements/DoAuth
new file mode 100644 (file)
index 0000000..0be9cc2
--- /dev/null
@@ -0,0 +1,22 @@
+<%once>
+my $loaded_user = 0;
+</%once>
+<%init>
+
+use RT::Authen::ExternalAuth;
+
+my ($val,$msg);
+unless($session{'CurrentUser'} && $session{'CurrentUser'}->Id) {
+    ($val,$msg) = RT::Authen::ExternalAuth::DoAuth(\%session,$user,$pass);
+    $RT::Logger->debug("Autohandler called ExternalAuth. Response: ($val, $msg)");
+}
+
+return;
+</%init>
+
+<%ARGS>
+$user => undef
+$pass => undef
+$menu => undef
+</%ARGS>
+
diff --git a/inc/Module/AutoInstall.pm b/inc/Module/AutoInstall.pm
new file mode 100644 (file)
index 0000000..60b90ea
--- /dev/null
@@ -0,0 +1,820 @@
+#line 1
+package Module::AutoInstall;
+
+use strict;
+use Cwd                 ();
+use ExtUtils::MakeMaker ();
+
+use vars qw{$VERSION};
+BEGIN {
+       $VERSION = '1.03';
+}
+
+# special map on pre-defined feature sets
+my %FeatureMap = (
+    ''      => 'Core Features',    # XXX: deprecated
+    '-core' => 'Core Features',
+);
+
+# various lexical flags
+my ( @Missing, @Existing,  %DisabledTests, $UnderCPAN,     $HasCPANPLUS );
+my (
+    $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly, $AllDeps
+);
+my ( $PostambleActions, $PostambleUsed );
+
+# See if it's a testing or non-interactive session
+_accept_default( $ENV{AUTOMATED_TESTING} or ! -t STDIN ); 
+_init();
+
+sub _accept_default {
+    $AcceptDefault = shift;
+}
+
+sub missing_modules {
+    return @Missing;
+}
+
+sub do_install {
+    __PACKAGE__->install(
+        [
+            $Config
+            ? ( UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
+            : ()
+        ],
+        @Missing,
+    );
+}
+
+# initialize various flags, and/or perform install
+sub _init {
+    foreach my $arg (
+        @ARGV,
+        split(
+            /[\s\t]+/,
+            $ENV{PERL_AUTOINSTALL} || $ENV{PERL_EXTUTILS_AUTOINSTALL} || ''
+        )
+      )
+    {
+        if ( $arg =~ /^--config=(.*)$/ ) {
+            $Config = [ split( ',', $1 ) ];
+        }
+        elsif ( $arg =~ /^--installdeps=(.*)$/ ) {
+            __PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) );
+            exit 0;
+        }
+        elsif ( $arg =~ /^--default(?:deps)?$/ ) {
+            $AcceptDefault = 1;
+        }
+        elsif ( $arg =~ /^--check(?:deps)?$/ ) {
+            $CheckOnly = 1;
+        }
+        elsif ( $arg =~ /^--skip(?:deps)?$/ ) {
+            $SkipInstall = 1;
+        }
+        elsif ( $arg =~ /^--test(?:only)?$/ ) {
+            $TestOnly = 1;
+        }
+        elsif ( $arg =~ /^--all(?:deps)?$/ ) {
+            $AllDeps = 1;
+        }
+    }
+}
+
+# overrides MakeMaker's prompt() to automatically accept the default choice
+sub _prompt {
+    goto &ExtUtils::MakeMaker::prompt unless $AcceptDefault;
+
+    my ( $prompt, $default ) = @_;
+    my $y = ( $default =~ /^[Yy]/ );
+
+    print $prompt, ' [', ( $y ? 'Y' : 'y' ), '/', ( $y ? 'n' : 'N' ), '] ';
+    print "$default\n";
+    return $default;
+}
+
+# the workhorse
+sub import {
+    my $class = shift;
+    my @args  = @_ or return;
+    my $core_all;
+
+    print "*** $class version " . $class->VERSION . "\n";
+    print "*** Checking for Perl dependencies...\n";
+
+    my $cwd = Cwd::cwd();
+
+    $Config = [];
+
+    my $maxlen = length(
+        (
+            sort   { length($b) <=> length($a) }
+              grep { /^[^\-]/ }
+              map  {
+                ref($_)
+                  ? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} )
+                  : ''
+              }
+              map { +{@args}->{$_} }
+              grep { /^[^\-]/ or /^-core$/i } keys %{ +{@args} }
+        )[0]
+    );
+
+    # We want to know if we're under CPAN early to avoid prompting, but
+    # if we aren't going to try and install anything anyway then skip the
+    # 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;
+
+    while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) {
+        my ( @required, @tests, @skiptests );
+        my $default  = 1;
+        my $conflict = 0;
+
+        if ( $feature =~ m/^-(\w+)$/ ) {
+            my $option = lc($1);
+
+            # check for a newer version of myself
+            _update_to( $modules, @_ ) and return if $option eq 'version';
+
+            # sets CPAN configuration options
+            $Config = $modules if $option eq 'config';
+
+            # promote every features to core status
+            $core_all = ( $modules =~ /^all$/i ) and next
+              if $option eq 'core';
+
+            next unless $option eq 'core';
+        }
+
+        print "[" . ( $FeatureMap{ lc($feature) } || $feature ) . "]\n";
+
+        $modules = [ %{$modules} ] if UNIVERSAL::isa( $modules, 'HASH' );
+
+        unshift @$modules, -default => &{ shift(@$modules) }
+          if ( ref( $modules->[0] ) eq 'CODE' );    # XXX: bugward combatability
+
+        while ( my ( $mod, $arg ) = splice( @$modules, 0, 2 ) ) {
+            if ( $mod =~ m/^-(\w+)$/ ) {
+                my $option = lc($1);
+
+                $default   = $arg    if ( $option eq 'default' );
+                $conflict  = $arg    if ( $option eq 'conflict' );
+                @tests     = @{$arg} if ( $option eq 'tests' );
+                @skiptests = @{$arg} if ( $option eq 'skiptests' );
+
+                next;
+            }
+
+            printf( "- %-${maxlen}s ...", $mod );
+
+            if ( $arg and $arg =~ /^\D/ ) {
+                unshift @$modules, $arg;
+                $arg = 0;
+            }
+
+            # XXX: check for conflicts and uninstalls(!) them.
+            my $cur = _load($mod);
+            if (_version_cmp ($cur, $arg) >= 0)
+            {
+                print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n";
+                push @Existing, $mod => $arg;
+                $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
+            }
+            else {
+                if (not defined $cur)   # indeed missing
+                {
+                    print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n";
+                }
+                else
+                {
+                    # no need to check $arg as _version_cmp ($cur, undef) would satisfy >= above
+                    print "too old. ($cur < $arg)\n";
+                }
+
+                push @required, $mod => $arg;
+            }
+        }
+
+        next unless @required;
+
+        my $mandatory = ( $feature eq '-core' or $core_all );
+
+        if (
+            !$SkipInstall
+            and (
+                $CheckOnly
+                or ($mandatory and $UnderCPAN)
+                or $AllDeps
+                or _prompt(
+                    qq{==> Auto-install the }
+                      . ( @required / 2 )
+                      . ( $mandatory ? ' mandatory' : ' optional' )
+                      . qq{ module(s) from CPAN?},
+                    $default ? 'y' : 'n',
+                ) =~ /^[Yy]/
+            )
+          )
+        {
+            push( @Missing, @required );
+            $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
+        }
+
+        elsif ( !$SkipInstall
+            and $default
+            and $mandatory
+            and
+            _prompt( qq{==> The module(s) are mandatory! Really skip?}, 'n', )
+            =~ /^[Nn]/ )
+        {
+            push( @Missing, @required );
+            $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
+        }
+
+        else {
+            $DisabledTests{$_} = 1 for map { glob($_) } @tests;
+        }
+    }
+
+    if ( @Missing and not( $CheckOnly or $UnderCPAN ) ) {
+        require Config;
+        print
+"*** Dependencies will be installed the next time you type '$Config::Config{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"
+          if eval '$>';
+    }
+    print "*** $class configuration finished.\n";
+
+    chdir $cwd;
+
+    # import to main::
+    no strict 'refs';
+    *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';
+
+    return (@Existing, @Missing);
+}
+
+sub _running_under {
+    my $thing = shift;
+    print <<"END_MESSAGE";
+*** Since we're running under ${thing}, I'll just let it take care
+    of the dependency's installation later.
+END_MESSAGE
+    return 1;
+}
+
+# Check to see if we are currently running under CPAN.pm and/or CPANPLUS;
+# if we are, then we simply let it taking care of our dependencies
+sub _check_lock {
+    return unless @Missing or @_;
+
+    my $cpan_env = $ENV{PERL5_CPAN_IS_RUNNING};
+
+    if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) {
+        return _running_under($cpan_env ? 'CPAN' : 'CPANPLUS');
+    }
+
+    require CPAN;
+
+    if ($CPAN::VERSION > '1.89') {
+        if ($cpan_env) {
+            return _running_under('CPAN');
+        }
+        return; # CPAN.pm new enough, don't need to check further
+    }
+
+    # last ditch attempt, this -will- configure CPAN, very sorry
+
+    _load_cpan(1); # force initialize even though it's already loaded
+
+    # Find the CPAN lock-file
+    my $lock = MM->catfile( $CPAN::Config->{cpan_home}, ".lock" );
+    return unless -f $lock;
+
+    # Check the lock
+    local *LOCK;
+    return unless open(LOCK, $lock);
+
+    if (
+            ( $^O eq 'MSWin32' ? _under_cpan() : <LOCK> == getppid() )
+        and ( $CPAN::Config->{prerequisites_policy} || '' ) ne 'ignore'
+    ) {
+        print <<'END_MESSAGE';
+
+*** Since we're running under CPAN, I'll just let it take care
+    of the dependency's installation later.
+END_MESSAGE
+        return 1;
+    }
+
+    close LOCK;
+    return;
+}
+
+sub install {
+    my $class = shift;
+
+    my $i;    # used below to strip leading '-' from config keys
+    my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } );
+
+    my ( @modules, @installed );
+    while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) {
+
+        # grep out those already installed
+        if ( _version_cmp( _load($pkg), $ver ) >= 0 ) {
+            push @installed, $pkg;
+        }
+        else {
+            push @modules, $pkg, $ver;
+        }
+    }
+
+    return @installed unless @modules;  # nothing to do
+    return @installed if _check_lock(); # defer to the CPAN shell
+
+    print "*** Installing dependencies...\n";
+
+    return unless _connected_to('cpan.org');
+
+    my %args = @config;
+    my %failed;
+    local *FAILED;
+    if ( $args{do_once} and open( FAILED, '.#autoinstall.failed' ) ) {
+        while (<FAILED>) { chomp; $failed{$_}++ }
+        close FAILED;
+
+        my @newmod;
+        while ( my ( $k, $v ) = splice( @modules, 0, 2 ) ) {
+            push @newmod, ( $k => $v ) unless $failed{$k};
+        }
+        @modules = @newmod;
+    }
+
+    if ( _has_cpanplus() and not $ENV{PERL_AUTOINSTALL_PREFER_CPAN} ) {
+        _install_cpanplus( \@modules, \@config );
+    } else {
+        _install_cpan( \@modules, \@config );
+    }
+
+    print "*** $class installation finished.\n";
+
+    # see if we have successfully installed them
+    while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
+        if ( _version_cmp( _load($pkg), $ver ) >= 0 ) {
+            push @installed, $pkg;
+        }
+        elsif ( $args{do_once} and open( FAILED, '>> .#autoinstall.failed' ) ) {
+            print FAILED "$pkg\n";
+        }
+    }
+
+    close FAILED if $args{do_once};
+
+    return @installed;
+}
+
+sub _install_cpanplus {
+    my @modules   = @{ +shift };
+    my @config    = _cpanplus_config( @{ +shift } );
+    my $installed = 0;
+
+    require CPANPLUS::Backend;
+    my $cp   = CPANPLUS::Backend->new;
+    my $conf = $cp->configure_object;
+
+    return unless $conf->can('conf') # 0.05x+ with "sudo" support
+               or _can_write($conf->_get_build('base'));  # 0.04x
+
+    # if we're root, set UNINST=1 to avoid trouble unless user asked for it.
+    my $makeflags = $conf->get_conf('makeflags') || '';
+    if ( UNIVERSAL::isa( $makeflags, 'HASH' ) ) {
+        # 0.03+ uses a hashref here
+        $makeflags->{UNINST} = 1 unless exists $makeflags->{UNINST};
+
+    } else {
+        # 0.02 and below uses a scalar
+        $makeflags = join( ' ', split( ' ', $makeflags ), 'UNINST=1' )
+          if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } );
+
+    }
+    $conf->set_conf( makeflags => $makeflags );
+    $conf->set_conf( prereqs   => 1 );
+
+    
+
+    while ( my ( $key, $val ) = splice( @config, 0, 2 ) ) {
+        $conf->set_conf( $key, $val );
+    }
+
+    my $modtree = $cp->module_tree;
+    while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
+        print "*** Installing $pkg...\n";
+
+        MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall;
+
+        my $success;
+        my $obj = $modtree->{$pkg};
+
+        if ( $obj and _version_cmp( $obj->{version}, $ver ) >= 0 ) {
+            my $pathname = $pkg;
+            $pathname =~ s/::/\\W/;
+
+            foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) {
+                delete $INC{$inc};
+            }
+
+            my $rv = $cp->install( modules => [ $obj->{module} ] );
+
+            if ( $rv and ( $rv->{ $obj->{module} } or $rv->{ok} ) ) {
+                print "*** $pkg successfully installed.\n";
+                $success = 1;
+            } else {
+                print "*** $pkg installation cancelled.\n";
+                $success = 0;
+            }
+
+            $installed += $success;
+        } else {
+            print << ".";
+*** Could not find a version $ver or above for $pkg; skipping.
+.
+        }
+
+        MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall;
+    }
+
+    return $installed;
+}
+
+sub _cpanplus_config {
+       my @config = ();
+       while ( @_ ) {
+               my ($key, $value) = (shift(), shift());
+               if ( $key eq 'prerequisites_policy' ) {
+                       if ( $value eq 'follow' ) {
+                               $value = CPANPLUS::Internals::Constants::PREREQ_INSTALL();
+                       } elsif ( $value eq 'ask' ) {
+                               $value = CPANPLUS::Internals::Constants::PREREQ_ASK();
+                       } elsif ( $value eq 'ignore' ) {
+                               $value = CPANPLUS::Internals::Constants::PREREQ_IGNORE();
+                       } else {
+                               die "*** Cannot convert option $key = '$value' to CPANPLUS version.\n";
+                       }
+               } else {
+                       die "*** Cannot convert option $key to CPANPLUS version.\n";
+               }
+       }
+       return @config;
+}
+
+sub _install_cpan {
+    my @modules   = @{ +shift };
+    my @config    = @{ +shift };
+    my $installed = 0;
+    my %args;
+
+    _load_cpan();
+    require Config;
+
+    if (CPAN->VERSION < 1.80) {
+        # no "sudo" support, probe for writableness
+        return unless _can_write( MM->catfile( $CPAN::Config->{cpan_home}, 'sources' ) )
+                  and _can_write( $Config::Config{sitelib} );
+    }
+
+    # if we're root, set UNINST=1 to avoid trouble unless user asked for it.
+    my $makeflags = $CPAN::Config->{make_install_arg} || '';
+    $CPAN::Config->{make_install_arg} =
+      join( ' ', split( ' ', $makeflags ), 'UNINST=1' )
+      if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } );
+
+    # don't show start-up info
+    $CPAN::Config->{inhibit_startup_message} = 1;
+
+    # set additional options
+    while ( my ( $opt, $arg ) = splice( @config, 0, 2 ) ) {
+        ( $args{$opt} = $arg, next )
+          if $opt =~ /^force$/;    # pseudo-option
+        $CPAN::Config->{$opt} = $arg;
+    }
+
+    local $CPAN::Config->{prerequisites_policy} = 'follow';
+
+    while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
+        MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall;
+
+        print "*** Installing $pkg...\n";
+
+        my $obj     = CPAN::Shell->expand( Module => $pkg );
+        my $success = 0;
+
+        if ( $obj and _version_cmp( $obj->cpan_version, $ver ) >= 0 ) {
+            my $pathname = $pkg;
+            $pathname =~ s/::/\\W/;
+
+            foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) {
+                delete $INC{$inc};
+            }
+
+            my $rv = $args{force} ? CPAN::Shell->force( install => $pkg )
+                                  : CPAN::Shell->install($pkg);
+            $rv ||= eval {
+                $CPAN::META->instance( 'CPAN::Distribution', $obj->cpan_file, )
+                  ->{install}
+                  if $CPAN::META;
+            };
+
+            if ( $rv eq 'YES' ) {
+                print "*** $pkg successfully installed.\n";
+                $success = 1;
+            }
+            else {
+                print "*** $pkg installation failed.\n";
+                $success = 0;
+            }
+
+            $installed += $success;
+        }
+        else {
+            print << ".";
+*** Could not find a version $ver or above for $pkg; skipping.
+.
+        }
+
+        MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall;
+    }
+
+    return $installed;
+}
+
+sub _has_cpanplus {
+    return (
+        $HasCPANPLUS = (
+            $INC{'CPANPLUS/Config.pm'}
+              or _load('CPANPLUS::Shell::Default')
+        )
+    );
+}
+
+# make guesses on whether we're under the CPAN installation directory
+sub _under_cpan {
+    require Cwd;
+    require File::Spec;
+
+    my $cwd  = File::Spec->canonpath( Cwd::cwd() );
+    my $cpan = File::Spec->canonpath( $CPAN::Config->{cpan_home} );
+
+    return ( index( $cwd, $cpan ) > -1 );
+}
+
+sub _update_to {
+    my $class = __PACKAGE__;
+    my $ver   = shift;
+
+    return
+      if _version_cmp( _load($class), $ver ) >= 0;  # no need to upgrade
+
+    if (
+        _prompt( "==> A newer version of $class ($ver) is required. Install?",
+            'y' ) =~ /^[Nn]/
+      )
+    {
+        die "*** Please install $class $ver manually.\n";
+    }
+
+    print << ".";
+*** Trying to fetch it from CPAN...
+.
+
+    # install ourselves
+    _load($class) and return $class->import(@_)
+      if $class->install( [], $class, $ver );
+
+    print << '.'; exit 1;
+
+*** Cannot bootstrap myself. :-( Installation terminated.
+.
+}
+
+# check if we're connected to some host, using inet_aton
+sub _connected_to {
+    my $site = shift;
+
+    return (
+        ( _load('Socket') and Socket::inet_aton($site) ) or _prompt(
+            qq(
+*** Your host cannot resolve the domain name '$site', which
+    probably means the Internet connections are unavailable.
+==> Should we try to install the required module(s) anyway?), 'n'
+          ) =~ /^[Yy]/
+    );
+}
+
+# check if a directory is writable; may create it on demand
+sub _can_write {
+    my $path = shift;
+    mkdir( $path, 0755 ) unless -e $path;
+
+    return 1 if -w $path;
+
+    print << ".";
+*** You are not allowed to write to the directory '$path';
+    the installation may fail due to insufficient permissions.
+.
+
+    if (
+        eval '$>' and lc(`sudo -V`) =~ /version/ and _prompt(
+            qq(
+==> Should we try to re-execute the autoinstall process with 'sudo'?),
+            ((-t STDIN) ? 'y' : 'n')
+        ) =~ /^[Yy]/
+      )
+    {
+
+        # try to bootstrap ourselves from sudo
+        print << ".";
+*** Trying to re-execute the autoinstall process with 'sudo'...
+.
+        my $missing = join( ',', @Missing );
+        my $config = join( ',',
+            UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
+          if $Config;
+
+        return
+          unless system( 'sudo', $^X, $0, "--config=$config",
+            "--installdeps=$missing" );
+
+        print << ".";
+*** The 'sudo' command exited with error!  Resuming...
+.
+    }
+
+    return _prompt(
+        qq(
+==> Should we try to install the required module(s) anyway?), 'n'
+    ) =~ /^[Yy]/;
+}
+
+# load a module and return the version it reports
+sub _load {
+    my $mod  = pop;    # class/instance doesn't matter
+    my $file = $mod;
+
+    $file =~ s|::|/|g;
+    $file .= '.pm';
+
+    local $@;
+    return eval { require $file; $mod->VERSION } || ( $@ ? undef: 0 );
+}
+
+# Load CPAN.pm and it's configuration
+sub _load_cpan {
+    return if $CPAN::VERSION and $CPAN::Config and not @_;
+    require CPAN;
+
+    # CPAN-1.82+ adds CPAN::Config::AUTOLOAD to redirect to
+    #    CPAN::HandleConfig->load. CPAN reports that the redirection
+    #    is deprecated in a warning printed at the user.
+
+    # CPAN-1.81 expects CPAN::HandleConfig->load, does not have
+    #   $CPAN::HandleConfig::VERSION but cannot handle
+    #   CPAN::Config->load
+
+    # Which "versions expect CPAN::Config->load?
+
+    if ( $CPAN::HandleConfig::VERSION
+        || CPAN::HandleConfig->can('load')
+    ) {
+        # Newer versions of CPAN have a HandleConfig module
+        CPAN::HandleConfig->load;
+    } else {
+       # Older versions had the load method in Config directly
+        CPAN::Config->load;
+    }
+}
+
+# compare two versions, either use Sort::Versions or plain comparison
+# return values same as <=>
+sub _version_cmp {
+    my ( $cur, $min ) = @_;
+    return -1 unless defined $cur;  # if 0 keep comparing
+    return 1 unless $min;
+
+    $cur =~ s/\s+$//;
+
+    # check for version numbers that are not in decimal format
+    if ( ref($cur) or ref($min) or $cur =~ /v|\..*\./ or $min =~ /v|\..*\./ ) {
+        if ( ( $version::VERSION or defined( _load('version') )) and
+             version->can('new') 
+            ) {
+
+            # use version.pm if it is installed.
+            return version->new($cur) <=> version->new($min);
+        }
+        elsif ( $Sort::Versions::VERSION or defined( _load('Sort::Versions') ) )
+        {
+
+            # use Sort::Versions as the sorting algorithm for a.b.c versions
+            return Sort::Versions::versioncmp( $cur, $min );
+        }
+
+        warn "Cannot reliably compare non-decimal formatted versions.\n"
+          . "Please install version.pm or Sort::Versions.\n";
+    }
+
+    # plain comparison
+    local $^W = 0;    # shuts off 'not numeric' bugs
+    return $cur <=> $min;
+}
+
+# nothing; this usage is deprecated.
+sub main::PREREQ_PM { return {}; }
+
+sub _make_args {
+    my %args = @_;
+
+    $args{PREREQ_PM} = { %{ $args{PREREQ_PM} || {} }, @Existing, @Missing }
+      if $UnderCPAN or $TestOnly;
+
+    if ( $args{EXE_FILES} and -e 'MANIFEST' ) {
+        require ExtUtils::Manifest;
+        my $manifest = ExtUtils::Manifest::maniread('MANIFEST');
+
+        $args{EXE_FILES} =
+          [ grep { exists $manifest->{$_} } @{ $args{EXE_FILES} } ];
+    }
+
+    $args{test}{TESTS} ||= 't/*.t';
+    $args{test}{TESTS} = join( ' ',
+        grep { !exists( $DisabledTests{$_} ) }
+          map { glob($_) } split( /\s+/, $args{test}{TESTS} ) );
+
+    my $missing = join( ',', @Missing );
+    my $config =
+      join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
+      if $Config;
+
+    $PostambleActions = (
+        ($missing and not $UnderCPAN)
+        ? "\$(PERL) $0 --config=$config --installdeps=$missing"
+        : "\$(NOECHO) \$(NOOP)"
+    );
+
+    return %args;
+}
+
+# a wrapper to ExtUtils::MakeMaker::WriteMakefile
+sub Write {
+    require Carp;
+    Carp::croak "WriteMakefile: Need even number of args" if @_ % 2;
+
+    if ($CheckOnly) {
+        print << ".";
+*** Makefile not written in check-only mode.
+.
+        return;
+    }
+
+    my %args = _make_args(@_);
+
+    no strict 'refs';
+
+    $PostambleUsed = 0;
+    local *MY::postamble = \&postamble unless defined &MY::postamble;
+    ExtUtils::MakeMaker::WriteMakefile(%args);
+
+    print << "." unless $PostambleUsed;
+*** WARNING: Makefile written with customized MY::postamble() without
+    including contents from Module::AutoInstall::postamble() --
+    auto installation features disabled.  Please contact the author.
+.
+
+    return 1;
+}
+
+sub postamble {
+    $PostambleUsed = 1;
+
+    return <<"END_MAKE";
+
+config :: installdeps
+\t\$(NOECHO) \$(NOOP)
+
+checkdeps ::
+\t\$(PERL) $0 --checkdeps
+
+installdeps ::
+\t$PostambleActions
+
+END_MAKE
+
+}
+
+1;
+
+__END__
+
+#line 1071
old mode 100755 (executable)
new mode 100644 (file)
index e6758c9..8ee839d
@@ -17,12 +17,13 @@ package Module::Install;
 #     3. The ./inc/ version of Module::Install loads
 # }
 
-BEGIN {
-       require 5.004;
-}
+use 5.005;
 use strict 'vars';
+use Cwd        ();
+use File::Find ();
+use File::Path ();
 
-use vars qw{$VERSION};
+use vars qw{$VERSION $MAIN};
 BEGIN {
        # All Module::Install core packages now require synchronised versions.
        # This will be used to ensure we don't accidentally load old or
@@ -30,21 +31,35 @@ 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 = '0.70';
-}
+       $VERSION = '1.00';
 
+       # Storage for the pseudo-singleton
+       $MAIN    = undef;
 
+       *inc::Module::Install::VERSION = *VERSION;
+       @inc::Module::Install::ISA     = __PACKAGE__;
 
+}
 
+sub import {
+       my $class = shift;
+       my $self  = $class->new(@_);
+       my $who   = $self->_caller;
 
-# Whether or not inc::Module::Install is actually loaded, the
-# $INC{inc/Module/Install.pm} is what will still get set as long as
-# the caller loaded module this in the documented manner.
-# If not set, the caller may NOT have loaded the bundled version, and thus
-# they may not have a MI version that works with the Makefile.PL. This would
-# result in false errors or unexpected behaviour. And we don't want that.
-my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
-unless ( $INC{$file} ) { die <<"END_DIE" }
+       #-------------------------------------------------------------
+       # all of the following checks should be included in import(),
+       # to allow "eval 'require Module::Install; 1' to test
+       # installation of Module::Install. (RT #51267)
+       #-------------------------------------------------------------
+
+       # Whether or not inc::Module::Install is actually loaded, the
+       # $INC{inc/Module/Install.pm} is what will still get set as long as
+       # the caller loaded module this in the documented manner.
+       # If not set, the caller may NOT have loaded the bundled version, and thus
+       # they may not have a MI version that works with the Makefile.PL. This would
+       # result in false errors or unexpected behaviour. And we don't want that.
+       my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
+       unless ( $INC{$file} ) { die <<"END_DIE" }
 
 Please invoke ${\__PACKAGE__} with:
 
@@ -56,32 +71,42 @@ not:
 
 END_DIE
 
+       # This reportedly fixes a rare Win32 UTC file time issue, but
+       # as this is a non-cross-platform XS module not in the core,
+       # we shouldn't really depend on it. See RT #24194 for detail.
+       # (Also, this module only supports Perl 5.6 and above).
+       eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006;
 
+       # If the script that is loading Module::Install is from the future,
+       # then make will detect this and cause it to re-run over and over
+       # again. This is bad. Rather than taking action to touch it (which
+       # is unreliable on some platforms and requires write permissions)
+       # for now we should catch this and refuse to run.
+       if ( -f $0 ) {
+               my $s = (stat($0))[9];
 
+               # If the modification time is only slightly in the future,
+               # sleep briefly to remove the problem.
+               my $a = $s - time;
+               if ( $a > 0 and $a < 5 ) { sleep 5 }
 
+               # Too far in the future, throw an error.
+               my $t = time;
+               if ( $s > $t ) { die <<"END_DIE" }
 
-# If the script that is loading Module::Install is from the future,
-# then make will detect this and cause it to re-run over and over
-# again. This is bad. Rather than taking action to touch it (which
-# is unreliable on some platforms and requires write permissions)
-# for now we should catch this and refuse to run.
-if ( -f $0 and (stat($0))[9] > time ) { die <<"END_DIE" }
-
-Your installer $0 has a modification time in the future.
+Your installer $0 has a modification time in the future ($s > $t).
 
 This is known to create infinite loops in make.
 
 Please correct this, then run $0 again.
 
 END_DIE
+       }
 
 
-
-
-
-# Build.PL was formerly supported, but no longer is due to excessive
-# difficulty in implementing every single feature twice.
-if ( $0 =~ /Build.PL$/i or -f 'Build.PL' ) { die <<"END_DIE" }
+       # Build.PL was formerly supported, but no longer is due to excessive
+       # difficulty in implementing every single feature twice.
+       if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" }
 
 Module::Install no longer supports Build.PL.
 
@@ -91,41 +116,21 @@ Please remove all Build.PL files and only use the Makefile.PL installer.
 
 END_DIE
 
+       #-------------------------------------------------------------
 
+       # To save some more typing in Module::Install installers, every...
+       # use inc::Module::Install
+       # ...also acts as an implicit use strict.
+       $^H |= strict::bits(qw(refs subs vars));
 
+       #-------------------------------------------------------------
 
-
-use Cwd        ();
-use File::Find ();
-use File::Path ();
-use FindBin;
-
-*inc::Module::Install::VERSION = *VERSION;
-@inc::Module::Install::ISA     = __PACKAGE__;
-
-sub autoload {
-       my $self = shift;
-       my $who  = $self->_caller;
-       my $cwd  = Cwd::cwd();
-       my $sym  = "${who}::AUTOLOAD";
-       $sym->{$cwd} = sub {
-               my $pwd = Cwd::cwd();
-               if ( my $code = $sym->{$pwd} ) {
-                       # delegate back to parent dirs
-                       goto &$code unless $cwd eq $pwd;
+       unless ( -f $self->{file} ) {
+               foreach my $key (keys %INC) {
+                       delete $INC{$key} if $key =~ /Module\/Install/;
                }
-               $$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym";
-               unshift @_, ( $self, $1 );
-               goto &{$self->can('call')} unless uc($1) eq $1;
-       };
-}
-
-sub import {
-       my $class = shift;
-       my $self  = $class->new(@_);
-       my $who   = $self->_caller;
 
-       unless ( -f $self->{file} ) {
+               local $^W;
                require "$self->{path}/$self->{dispatch}.pm";
                File::Path::mkpath("$self->{prefix}/$self->{author}");
                $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
@@ -134,19 +139,63 @@ sub import {
                goto &{"$self->{name}::import"};
        }
 
+       local $^W;
        *{"${who}::AUTOLOAD"} = $self->autoload;
        $self->preload;
 
        # Unregister loader and worker packages so subdirs can use them again
-       delete $INC{"$self->{file}"};
-       delete $INC{"$self->{path}.pm"};
+       delete $INC{'inc/Module/Install.pm'};
+       delete $INC{'Module/Install.pm'};
+
+       # Save to the singleton
+       $MAIN = $self;
 
        return 1;
 }
 
-sub preload {
-       my ($self) = @_;
+sub autoload {
+       my $self = shift;
+       my $who  = $self->_caller;
+       my $cwd  = Cwd::cwd();
+       my $sym  = "${who}::AUTOLOAD";
+       $sym->{$cwd} = sub {
+               my $pwd = Cwd::cwd();
+               if ( my $code = $sym->{$pwd} ) {
+                       # Delegate back to parent dirs
+                       goto &$code unless $cwd eq $pwd;
+               }
+               unless ($$sym =~ s/([^:]+)$//) {
+                       # XXX: it looks like we can't retrieve the missing function
+                       # via $$sym (usually $main::AUTOLOAD) in this case.
+                       # I'm still wondering if we should slurp Makefile.PL to
+                       # get some context or not ...
+                       my ($package, $file, $line) = caller;
+                       die <<"EOT";
+Unknown function is found at $file line $line.
+Execution of $file aborted due to runtime errors.
+
+If you're a contributor to a project, you may need to install
+some Module::Install extensions from CPAN (or other repository).
+If you're a user of a module, please contact the author.
+EOT
+               }
+               my $method = $1;
+               if ( uc($method) eq $method ) {
+                       # Do nothing
+                       return;
+               } elsif ( $method =~ /^_/ and $self->can($method) ) {
+                       # Dispatch to the root M:I class
+                       return $self->$method(@_);
+               }
+
+               # Dispatch to the appropriate plugin
+               unshift @_, ( $self, $1 );
+               goto &{$self->can('call')};
+       };
+}
 
+sub preload {
+       my $self = shift;
        unless ( $self->{extensions} ) {
                $self->load_extensions(
                        "$self->{prefix}/$self->{path}", $self
@@ -155,8 +204,7 @@ sub preload {
 
        my @exts = @{$self->{extensions}};
        unless ( @exts ) {
-               my $admin = $self->{admin};
-               @exts = $admin->load_all_extensions;
+               @exts = $self->{admin}->load_all_extensions;
        }
 
        my %seen;
@@ -171,6 +219,7 @@ sub preload {
 
        my $who = $self->_caller;
        foreach my $name ( sort keys %seen ) {
+               local $^W;
                *{"${who}::$name"} = sub {
                        ${"${who}::AUTOLOAD"} = "${who}::$name";
                        goto &{"${who}::AUTOLOAD"};
@@ -181,12 +230,18 @@ sub preload {
 sub new {
        my ($class, %args) = @_;
 
+       delete $INC{'FindBin.pm'};
+       {
+               # to suppress the redefine warning
+               local $SIG{__WARN__} = sub {};
+               require FindBin;
+       }
+
        # ignore the prefix on extension modules built from top level.
        my $base_path = Cwd::abs_path($FindBin::Bin);
        unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) {
                delete $args{prefix};
        }
-
        return $args{_self} if $args{_self};
 
        $args{dispatch} ||= 'Admin';
@@ -202,6 +257,7 @@ sub new {
                $args{path}  =~ s!::!/!g;
        }
        $args{file}     ||= "$args{base}/$args{prefix}/$args{path}.pm";
+       $args{wrote}      = 0;
 
        bless( \%args, $class );
 }
@@ -238,8 +294,10 @@ END_DIE
 sub load_extensions {
        my ($self, $path, $top) = @_;
 
-       unless ( grep { lc $_ eq lc $self->{prefix} } @INC ) {
+       my $should_reload = 0;
+       unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
                unshift @INC, $self->{prefix};
+               $should_reload = 1;
        }
 
        foreach my $rv ( $self->find_extensions($path) ) {
@@ -247,12 +305,13 @@ sub load_extensions {
                next if $self->{pathnames}{$pkg};
 
                local $@;
-               my $new = eval { require $file; $pkg->can('new') };
+               my $new = eval { local $^W; require $file; $pkg->can('new') };
                unless ( $new ) {
                        warn $@ if $@;
                        next;
                }
-               $self->{pathnames}{$pkg} = delete $INC{$file};
+               $self->{pathnames}{$pkg} =
+                       $should_reload ? delete $INC{$file} : $INC{$file};
                push @{$self->{extensions}}, &{$new}($pkg, _top => $top );
        }
 
@@ -277,9 +336,9 @@ sub find_extensions {
                # correctly.  Otherwise, root through the file to locate the case-preserved
                # version of the package name.
                if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) {
-                       open PKGFILE, "<$subpath.pm" or die "find_extensions: Can't open $subpath.pm: $!";
-                       my $in_pod = 0;
-                       while ( <PKGFILE> ) {
+                       my $content = Module::Install::_read($subpath . '.pm');
+                       my $in_pod  = 0;
+                       foreach ( split //, $content ) {
                                $in_pod = 1 if /^=\w/;
                                $in_pod = 0 if /^=cut/;
                                next if ($in_pod || /^=cut/);  # skip pod text
@@ -289,7 +348,6 @@ sub find_extensions {
                                        last;
                                }
                        }
-                       close PKGFILE;
                }
 
                push @found, [ $file, $pkg ];
@@ -298,6 +356,13 @@ sub find_extensions {
        @found;
 }
 
+
+
+
+
+#####################################################################
+# Common Utility Functions
+
 sub _caller {
        my $depth = 0;
        my $call  = caller($depth);
@@ -308,6 +373,98 @@ sub _caller {
        return $call;
 }
 
+# Done in evals to avoid confusing Perl::MinimumVersion
+eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
+sub _read {
+       local *FH;
+       open( FH, '<', $_[0] ) or die "open($_[0]): $!";
+       my $string = do { local $/; <FH> };
+       close FH or die "close($_[0]): $!";
+       return $string;
+}
+END_NEW
+sub _read {
+       local *FH;
+       open( FH, "< $_[0]"  ) or die "open($_[0]): $!";
+       my $string = do { local $/; <FH> };
+       close FH or die "close($_[0]): $!";
+       return $string;
+}
+END_OLD
+
+sub _readperl {
+       my $string = Module::Install::_read($_[0]);
+       $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
+       $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s;
+       $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg;
+       return $string;
+}
+
+sub _readpod {
+       my $string = Module::Install::_read($_[0]);
+       $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
+       return $string if $_[0] =~ /\.pod\z/;
+       $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg;
+       $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg;
+       $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg;
+       $string =~ s/^\n+//s;
+       return $string;
+}
+
+# Done in evals to avoid confusing Perl::MinimumVersion
+eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
+sub _write {
+       local *FH;
+       open( FH, '>', $_[0] ) or die "open($_[0]): $!";
+       foreach ( 1 .. $#_ ) {
+               print FH $_[$_] or die "print($_[0]): $!";
+       }
+       close FH or die "close($_[0]): $!";
+}
+END_NEW
+sub _write {
+       local *FH;
+       open( FH, "> $_[0]"  ) or die "open($_[0]): $!";
+       foreach ( 1 .. $#_ ) {
+               print FH $_[$_] or die "print($_[0]): $!";
+       }
+       close FH or die "close($_[0]): $!";
+}
+END_OLD
+
+# _version is for processing module versions (eg, 1.03_05) not
+# Perl versions (eg, 5.8.1).
+sub _version ($) {
+       my $s = shift || 0;
+       my $d =()= $s =~ /(\.)/g;
+       if ( $d >= 2 ) {
+               # Normalise multipart versions
+               $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
+       }
+       $s =~ s/^(\d+)\.?//;
+       my $l = $1 || 0;
+       my @v = map {
+               $_ . '0' x (3 - length $_)
+       } $s =~ /(\d{1,3})\D?/g;
+       $l = $l . '.' . join '', @v if @v;
+       return $l + 0;
+}
+
+sub _cmp ($$) {
+       _version($_[0]) <=> _version($_[1]);
+}
+
+# Cloned from Params::Util::_CLASS
+sub _CLASS ($) {
+       (
+               defined $_[0]
+               and
+               ! ref $_[0]
+               and
+               $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s
+       ) ? $_[0] : undef;
+}
+
 1;
 
-# Copyright 2008 Adam Kennedy.
+# Copyright 2008 - 2010 Adam Kennedy.
diff --git a/inc/Module/Install/AuthorTests.pm b/inc/Module/Install/AuthorTests.pm
new file mode 100644 (file)
index 0000000..c44931b
--- /dev/null
@@ -0,0 +1,59 @@
+#line 1
+package Module::Install::AuthorTests;
+
+use 5.005;
+use strict;
+use Module::Install::Base;
+use Carp ();
+
+#line 16
+
+use vars qw{$VERSION $ISCORE @ISA};
+BEGIN {
+  $VERSION = '0.002';
+  $ISCORE  = 1;
+  @ISA     = qw{Module::Install::Base};
+}
+
+#line 42
+
+sub author_tests {
+  my ($self, @dirs) = @_;
+  _add_author_tests($self, \@dirs, 0);
+}
+
+#line 56
+
+sub recursive_author_tests {
+  my ($self, @dirs) = @_;
+  _add_author_tests($self, \@dirs, 1);
+}
+
+sub _wanted {
+  my $href = shift;
+  sub { /\.t$/ and -f $_ and $href->{$File::Find::dir} = 1 }
+}
+
+sub _add_author_tests {
+  my ($self, $dirs, $recurse) = @_;
+  return unless $Module::Install::AUTHOR;
+
+  my @tests = $self->tests ? (split / /, $self->tests) : 't/*.t';
+
+  # XXX: pick a default, later -- rjbs, 2008-02-24
+  my @dirs = @$dirs ? @$dirs : Carp::confess "no dirs given to author_tests";
+     @dirs = grep { -d } @dirs;
+
+  if ($recurse) {
+    require File::Find;
+    my %test_dir;
+    File::Find::find(_wanted(\%test_dir), @dirs);
+    $self->tests( join ' ', @tests, map { "$_/*.t" } sort keys %test_dir );
+  } else {
+    $self->tests( join ' ', @tests, map { "$_/*.t" } sort @dirs );
+  }
+}
+
+#line 107
+
+1;
diff --git a/inc/Module/Install/AutoInstall.pm b/inc/Module/Install/AutoInstall.pm
new file mode 100644 (file)
index 0000000..f1f5356
--- /dev/null
@@ -0,0 +1,82 @@
+#line 1
+package Module::Install::AutoInstall;
+
+use strict;
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+       $VERSION = '1.00';
+       @ISA     = 'Module::Install::Base';
+       $ISCORE  = 1;
+}
+
+sub AutoInstall { $_[0] }
+
+sub run {
+    my $self = shift;
+    $self->auto_install_now(@_);
+}
+
+sub write {
+    my $self = shift;
+    $self->auto_install(@_);
+}
+
+sub auto_install {
+    my $self = shift;
+    return if $self->{done}++;
+
+    # Flatten array of arrays into a single array
+    my @core = map @$_, map @$_, grep ref,
+               $self->build_requires, $self->requires;
+
+    my @config = @_;
+
+    # We'll need Module::AutoInstall
+    $self->include('Module::AutoInstall');
+    require Module::AutoInstall;
+
+    my @features_require = Module::AutoInstall->import(
+        (@config ? (-config => \@config) : ()),
+        (@core   ? (-core   => \@core)   : ()),
+        $self->features,
+    );
+
+    my %seen;
+    my @requires = map @$_, map @$_, grep ref, $self->requires;
+    while (my ($mod, $ver) = splice(@requires, 0, 2)) {
+        $seen{$mod}{$ver}++;
+    }
+    my @build_requires = map @$_, map @$_, grep ref, $self->build_requires;
+    while (my ($mod, $ver) = splice(@build_requires, 0, 2)) {
+        $seen{$mod}{$ver}++;
+    }
+    my @configure_requires = map @$_, map @$_, grep ref, $self->configure_requires;
+    while (my ($mod, $ver) = splice(@configure_requires, 0, 2)) {
+        $seen{$mod}{$ver}++;
+    }
+
+    my @deduped;
+    while (my ($mod, $ver) = splice(@features_require, 0, 2)) {
+        push @deduped, $mod => $ver unless $seen{$mod}{$ver}++;
+    }
+
+    $self->requires(@deduped);
+
+    $self->makemaker_args( Module::AutoInstall::_make_args() );
+
+    my $class = ref($self);
+    $self->postamble(
+        "# --- $class section:\n" .
+        Module::AutoInstall::postamble()
+    );
+}
+
+sub auto_install_now {
+    my $self = shift;
+    $self->auto_install(@_);
+    Module::AutoInstall::do_install();
+}
+
+1;
old mode 100755 (executable)
new mode 100644 (file)
index 5e24ae1..b55bda3
@@ -1,7 +1,11 @@
 #line 1
 package Module::Install::Base;
 
-$VERSION = '0.70';
+use strict 'vars';
+use vars qw{$VERSION};
+BEGIN {
+       $VERSION = '1.00';
+}
 
 # Suspend handler for "redefined" warnings
 BEGIN {
@@ -9,52 +13,61 @@ BEGIN {
        $SIG{__WARN__} = sub { $w };
 }
 
-### This is the ONLY module that shouldn't have strict on
-# use strict;
-
-#line 41
+#line 42
 
 sub new {
-    my ($class, %args) = @_;
-
-    foreach my $method ( qw(call load) ) {
-        *{"$class\::$method"} = sub {
-            shift()->_top->$method(@_);
-        } unless defined &{"$class\::$method"};
-    }
-
-    bless( \%args, $class );
+       my $class = shift;
+       unless ( defined &{"${class}::call"} ) {
+               *{"${class}::call"} = sub { shift->_top->call(@_) };
+       }
+       unless ( defined &{"${class}::load"} ) {
+               *{"${class}::load"} = sub { shift->_top->load(@_) };
+       }
+       bless { @_ }, $class;
 }
 
 #line 61
 
 sub AUTOLOAD {
-    my $self = shift;
-    local $@;
-    my $autoload = eval { $self->_top->autoload } or return;
-    goto &$autoload;
+       local $@;
+       my $func = eval { shift->_top->autoload } or return;
+       goto &$func;
 }
 
-#line 76
+#line 75
 
-sub _top { $_[0]->{_top} }
+sub _top {
+       $_[0]->{_top};
+}
 
-#line 89
+#line 90
 
 sub admin {
-    $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new;
+       $_[0]->_top->{admin}
+       or
+       Module::Install::Base::FakeAdmin->new;
 }
 
+#line 106
+
 sub is_admin {
-    $_[0]->admin->VERSION;
+       ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin');
 }
 
 sub DESTROY {}
 
 package Module::Install::Base::FakeAdmin;
 
-my $Fake;
-sub new { $Fake ||= bless(\@_, $_[0]) }
+use vars qw{$VERSION};
+BEGIN {
+       $VERSION = $Module::Install::Base::VERSION;
+}
+
+my $fake;
+
+sub new {
+       $fake ||= bless(\@_, $_[0]);
+}
 
 sub AUTOLOAD {}
 
@@ -67,4 +80,4 @@ BEGIN {
 
 1;
 
-#line 138
+#line 159
old mode 100755 (executable)
new mode 100644 (file)
index 9ce21a4..71ccc27
@@ -2,18 +2,16 @@
 package Module::Install::Can;
 
 use strict;
-use Module::Install::Base;
-use Config ();
-### This adds a 5.005 Perl version dependency.
-### This is a bug and will be fixed.
-use File::Spec ();
-use ExtUtils::MakeMaker ();
-
-use vars qw{$VERSION $ISCORE @ISA};
+use Config                ();
+use File::Spec            ();
+use ExtUtils::MakeMaker   ();
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-       $VERSION = '0.70';
+       $VERSION = '1.00';
+       @ISA     = 'Module::Install::Base';
        $ISCORE  = 1;
-       @ISA     = qw{Module::Install::Base};
 }
 
 # check if we can load some module
@@ -39,6 +37,7 @@ sub can_run {
        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));
        }
@@ -79,4 +78,4 @@ if ( $^O eq 'cygwin' ) {
 
 __END__
 
-#line 157
+#line 156
old mode 100755 (executable)
new mode 100644 (file)
index 2b8f6e8..ec1f106
@@ -2,24 +2,24 @@
 package Module::Install::Fetch;
 
 use strict;
-use Module::Install::Base;
+use Module::Install::Base ();
 
-use vars qw{$VERSION $ISCORE @ISA};
+use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-       $VERSION = '0.70';
+       $VERSION = '1.00';
+       @ISA     = 'Module::Install::Base';
        $ISCORE  = 1;
-       @ISA     = qw{Module::Install::Base};
 }
 
 sub get_file {
     my ($self, %args) = @_;
-    my ($scheme, $host, $path, $file) = 
+    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) = 
+        ($scheme, $host, $path, $file) =
             $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
     }
 
diff --git a/inc/Module/Install/Include.pm b/inc/Module/Install/Include.pm
new file mode 100644 (file)
index 0000000..a28cd4c
--- /dev/null
@@ -0,0 +1,34 @@
+#line 1
+package Module::Install::Include;
+
+use strict;
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+       $VERSION = '1.00';
+       @ISA     = 'Module::Install::Base';
+       $ISCORE  = 1;
+}
+
+sub include {
+       shift()->admin->include(@_);
+}
+
+sub include_deps {
+       shift()->admin->include_deps(@_);
+}
+
+sub auto_include {
+       shift()->admin->auto_include(@_);
+}
+
+sub auto_include_deps {
+       shift()->admin->auto_include_deps(@_);
+}
+
+sub auto_include_dependent_dists {
+       shift()->admin->auto_include_dependent_dists(@_);
+}
+
+1;
old mode 100755 (executable)
new mode 100644 (file)
index 27bbace..5dfd0e9
@@ -2,14 +2,15 @@
 package Module::Install::Makefile;
 
 use strict 'vars';
-use Module::Install::Base;
-use ExtUtils::MakeMaker ();
+use ExtUtils::MakeMaker   ();
+use Module::Install::Base ();
+use Fcntl qw/:flock :seek/;
 
-use vars qw{$VERSION $ISCORE @ISA};
+use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-       $VERSION = '0.70';
+       $VERSION = '1.00';
+       @ISA     = 'Module::Install::Base';
        $ISCORE  = 1;
-       @ISA     = qw{Module::Install::Base};
 }
 
 sub Makefile { $_[0] }
@@ -25,8 +26,8 @@ sub prompt {
                die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])";
        }
 
-       # In automated testing, always use defaults
-       if ( $ENV{AUTOMATED_TESTING} and ! $ENV{PERL_MM_USE_DEFAULT} ) {
+       # In automated testing or non-interactive session, always use defaults
+       if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) {
                local $ENV{PERL_MM_USE_DEFAULT} = 1;
                goto &ExtUtils::MakeMaker::prompt;
        } else {
@@ -34,21 +35,112 @@ sub prompt {
        }
 }
 
+# Store a cleaned up version of the MakeMaker version,
+# since we need to behave differently in a variety of
+# ways based on the MM version.
+my $makemaker = eval $ExtUtils::MakeMaker::VERSION;
+
+# If we are passed a param, do a "newer than" comparison.
+# Otherwise, just return the MakeMaker version.
+sub makemaker {
+       ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0
+}
+
+# Ripped from ExtUtils::MakeMaker 6.56, and slightly modified
+# as we only need to know here whether the attribute is an array
+# or a hash or something else (which may or may not be appendable).
+my %makemaker_argtype = (
+ C                  => 'ARRAY',
+ CONFIG             => 'ARRAY',
+# CONFIGURE          => 'CODE', # ignore
+ DIR                => 'ARRAY',
+ DL_FUNCS           => 'HASH',
+ DL_VARS            => 'ARRAY',
+ EXCLUDE_EXT        => 'ARRAY',
+ EXE_FILES          => 'ARRAY',
+ FUNCLIST           => 'ARRAY',
+ H                  => 'ARRAY',
+ IMPORTS            => 'HASH',
+ INCLUDE_EXT        => 'ARRAY',
+ LIBS               => 'ARRAY', # ignore ''
+ MAN1PODS           => 'HASH',
+ MAN3PODS           => 'HASH',
+ META_ADD           => 'HASH',
+ META_MERGE         => 'HASH',
+ PL_FILES           => 'HASH',
+ PM                 => 'HASH',
+ PMLIBDIRS          => 'ARRAY',
+ PMLIBPARENTDIRS    => 'ARRAY',
+ PREREQ_PM          => 'HASH',
+ CONFIGURE_REQUIRES => 'HASH',
+ SKIP               => 'ARRAY',
+ TYPEMAPS           => 'ARRAY',
+ XS                 => 'HASH',
+# VERSION            => ['version',''],  # ignore
+# _KEEP_AFTER_FLUSH  => '',
+
+ clean      => 'HASH',
+ depend     => 'HASH',
+ dist       => 'HASH',
+ dynamic_lib=> 'HASH',
+ linkext    => 'HASH',
+ macro      => 'HASH',
+ postamble  => 'HASH',
+ realclean  => 'HASH',
+ test       => 'HASH',
+ tool_autosplit => 'HASH',
+
+ # special cases where you can use makemaker_append
+ CCFLAGS   => 'APPENDABLE',
+ DEFINE    => 'APPENDABLE',
+ INC       => 'APPENDABLE',
+ LDDLFLAGS => 'APPENDABLE',
+ LDFROM    => 'APPENDABLE',
+);
+
 sub makemaker_args {
-       my $self = shift;
-       my $args = ($self->{makemaker_args} ||= {});
-         %$args = ( %$args, @_ ) if @_;
-       $args;
+       my ($self, %new_args) = @_;
+       my $args = ( $self->{makemaker_args} ||= {} );
+       foreach my $key (keys %new_args) {
+               if ($makemaker_argtype{$key}) {
+                       if ($makemaker_argtype{$key} eq 'ARRAY') {
+                               $args->{$key} = [] unless defined $args->{$key};
+                               unless (ref $args->{$key} eq 'ARRAY') {
+                                       $args->{$key} = [$args->{$key}]
+                               }
+                               push @{$args->{$key}},
+                                       ref $new_args{$key} eq 'ARRAY'
+                                               ? @{$new_args{$key}}
+                                               : $new_args{$key};
+                       }
+                       elsif ($makemaker_argtype{$key} eq 'HASH') {
+                               $args->{$key} = {} unless defined $args->{$key};
+                               foreach my $skey (keys %{ $new_args{$key} }) {
+                                       $args->{$key}{$skey} = $new_args{$key}{$skey};
+                               }
+                       }
+                       elsif ($makemaker_argtype{$key} eq 'APPENDABLE') {
+                               $self->makemaker_append($key => $new_args{$key});
+                       }
+               }
+               else {
+                       if (defined $args->{$key}) {
+                               warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n};
+                       }
+                       $args->{$key} = $new_args{$key};
+               }
+       }
+       return $args;
 }
 
 # For mm args that take multiple space-seperated args,
 # append an argument to the current list.
 sub makemaker_append {
-       my $self = sShift;
+       my $self = shift;
        my $name = shift;
        my $args = $self->makemaker_args;
-       $args->{name} = defined $args->{$name}
-               ? join( ' ', $args->{name}, @_ )
+       $args->{$name} = defined $args->{$name}
+               ? join( ' ', $args->{$name}, @_ )
                : join( ' ', @_ );
 }
 
@@ -63,18 +155,18 @@ sub build_subdirs {
 sub clean_files {
        my $self  = shift;
        my $clean = $self->makemaker_args->{clean} ||= {};
-       %$clean = (
-               %$clean, 
-               FILES => join(' ', grep length, $clean->{FILES}, @_),
+         %$clean = (
+               %$clean,
+               FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_),
        );
 }
 
 sub realclean_files {
-       my $self  = shift;
+       my $self      = shift;
        my $realclean = $self->makemaker_args->{realclean} ||= {};
-       %$realclean = (
-               %$realclean, 
-               FILES => join(' ', grep length, $realclean->{FILES}, @_),
+         %$realclean = (
+               %$realclean,
+               FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_),
        );
 }
 
@@ -89,93 +181,170 @@ sub inc {
        $self->makemaker_args( INC => shift );
 }
 
-my %test_dir = ();
-
 sub _wanted_t {
-       /\.t$/ and -f $_ and $test_dir{$File::Find::dir} = 1;
 }
 
 sub tests_recursive {
        my $self = shift;
-       if ( $self->tests ) {
-               die "tests_recursive will not work if tests are already defined";
-       }
        my $dir = shift || 't';
        unless ( -d $dir ) {
                die "tests_recursive dir '$dir' does not exist";
        }
-       %test_dir = ();
+       my %tests = map { $_ => 1 } split / /, ($self->tests || '');
        require File::Find;
-       File::Find::find( \&_wanted_t, $dir );
-       $self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir );
+       File::Find::find(
+        sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 },
+        $dir
+    );
+       $self->tests( join ' ', sort keys %tests );
 }
 
 sub write {
        my $self = shift;
        die "&Makefile->write() takes no arguments\n" if @_;
 
-       # Make sure we have a new enough
+       # Check the current Perl version
+       my $perl_version = $self->perl_version;
+       if ( $perl_version ) {
+               eval "use $perl_version; 1"
+                       or die "ERROR: perl: Version $] is installed, "
+                       . "but we need version >= $perl_version";
+       }
+
+       # Make sure we have a new enough MakeMaker
        require ExtUtils::MakeMaker;
-       $self->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION );
 
-       # Generate the 
+       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 );
+       } 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 );
+       }
+
+       # Generate the MakeMaker params
        my $args = $self->makemaker_args;
        $args->{DISTNAME} = $self->name;
-       $args->{NAME}     = $self->module_name || $self->name || $self->determine_NAME($args);
-       $args->{VERSION}  = $self->version || $self->determine_VERSION($args);
+       $args->{NAME}     = $self->module_name || $self->name;
        $args->{NAME}     =~ s/-/::/g;
+       $args->{VERSION}  = $self->version or die <<'EOT';
+ERROR: Can't determine distribution version. Please specify it
+explicitly via 'version' in Makefile.PL, or set a valid $VERSION
+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 ) {
-               $args->{test} = { TESTS => $self->tests };
+               my @tests = split ' ', $self->tests;
+               my %seen;
+               $args->{test} = {
+                       TESTS => (join ' ', grep {!$seen{$_}++} @tests),
+               };
+    } elsif ( $Module::Install::ExtraTests::use_extratests ) {
+        # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness.
+        # So, just ignore our xt tests here.
+       } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) {
+               $args->{test} = {
+                       TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ),
+               };
        }
-       if ($] >= 5.005) {
+       if ( $] >= 5.005 ) {
                $args->{ABSTRACT} = $self->abstract;
-               $args->{AUTHOR}   = $self->author;
+               $args->{AUTHOR}   = join ', ', @{$self->author || []};
        }
-       if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) {
-               $args->{NO_META} = 1;
+       if ( $self->makemaker(6.10) ) {
+               $args->{NO_META}   = 1;
+               #$args->{NO_MYMETA} = 1;
        }
-       if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) {
+       if ( $self->makemaker(6.17) and $self->sign ) {
                $args->{SIGN} = 1;
        }
        unless ( $self->is_admin ) {
                delete $args->{SIGN};
        }
+       if ( $self->makemaker(6.31) and $self->license ) {
+               $args->{LICENSE} = $self->license;
+       }
 
-       # merge both kinds of requires into prereq_pm
        my $prereq = ($args->{PREREQ_PM} ||= {});
        %$prereq = ( %$prereq,
-               map { @$_ }
+               map { @$_ } # flatten [module => version]
                map { @$_ }
                grep $_,
-               ($self->configure_requires, $self->build_requires, $self->requires)
+               ($self->requires)
        );
 
        # Remove any reference to perl, PREREQ_PM doesn't support it
        delete $args->{PREREQ_PM}->{perl};
 
-       # merge both kinds of requires into prereq_pm
-       my $subdirs = ($args->{DIR} ||= []);
+       # Merge both kinds of requires into BUILD_REQUIRES
+       my $build_prereq = ($args->{BUILD_REQUIRES} ||= {});
+       %$build_prereq = ( %$build_prereq,
+               map { @$_ } # flatten [module => version]
+               map { @$_ }
+               grep $_,
+               ($self->configure_requires, $self->build_requires)
+       );
+
+       # Remove any reference to perl, BUILD_REQUIRES doesn't support it
+       delete $args->{BUILD_REQUIRES}->{perl};
+
+       # Delete bundled dists from prereq_pm, add it to Makefile DIR
+       my $subdirs = ($args->{DIR} || []);
        if ($self->bundles) {
+               my %processed;
                foreach my $bundle (@{ $self->bundles }) {
-                       my ($file, $dir) = @$bundle;
-                       push @$subdirs, $dir if -d $dir;
-                       delete $prereq->{$file};
+                       my ($mod_name, $dist_dir) = @$bundle;
+                       delete $prereq->{$mod_name};
+                       $dist_dir = File::Basename::basename($dist_dir); # dir for building this module
+                       if (not exists $processed{$dist_dir}) {
+                               if (-d $dist_dir) {
+                                       # List as sub-directory to be processed by make
+                                       push @$subdirs, $dist_dir;
+                               }
+                               # Else do nothing: the module is already present on the system
+                               $processed{$dist_dir} = undef;
+                       }
                }
        }
 
+       unless ( $self->makemaker('6.55_03') ) {
+               %$prereq = (%$prereq,%$build_prereq);
+               delete $args->{BUILD_REQUIRES};
+       }
+
        if ( my $perl_version = $self->perl_version ) {
                eval "use $perl_version; 1"
                        or die "ERROR: perl: Version $] is installed, "
                        . "but we need version >= $perl_version";
+
+               if ( $self->makemaker(6.48) ) {
+                       $args->{MIN_PERL_VERSION} = $perl_version;
+               }
        }
 
-       $args->{INSTALLDIRS} = $self->installdirs;
+       if ($self->installdirs) {
+               warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS};
+               $args->{INSTALLDIRS} = $self->installdirs;
+       }
 
-       my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args;
+       my %args = map {
+               ( $_ => $args->{$_} ) } grep {defined($args->{$_} )
+       } keys %$args;
 
        my $user_preop = delete $args{dist}->{PREOP};
-       if (my $preop = $self->admin->preop($user_preop)) {
-               $args{dist} = $preop;
+       if ( my $preop = $self->admin->preop($user_preop) ) {
+               foreach my $key ( keys %$preop ) {
+                       $args{dist}->{$key} = $preop->{$key};
+               }
        }
 
        my $mm = ExtUtils::MakeMaker::WriteMakefile(%args);
@@ -188,7 +357,7 @@ sub fix_up_makefile {
        my $top_class     = ref($self->_top) || '';
        my $top_version   = $self->_top->VERSION || '';
 
-       my $preamble = $self->preamble 
+       my $preamble = $self->preamble
                ? "# Preamble by $top_class $top_version\n"
                        . $self->preamble
                : '';
@@ -196,9 +365,9 @@ sub fix_up_makefile {
                . ($self->postamble || '');
 
        local *MAKEFILE;
-       open MAKEFILE, "< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
+       open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
+       eval { flock MAKEFILE, LOCK_EX };
        my $makefile = do { local $/; <MAKEFILE> };
-       close MAKEFILE or die $!;
 
        $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /;
        $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g;
@@ -218,7 +387,8 @@ sub fix_up_makefile {
        # XXX - This is currently unused; not sure if it breaks other MM-users
        # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg;
 
-       open  MAKEFILE, "> $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
+       seek MAKEFILE, 0, SEEK_SET;
+       truncate MAKEFILE, 0;
        print MAKEFILE  "$preamble$makefile$postamble" or die $!;
        close MAKEFILE  or die $!;
 
@@ -242,4 +412,4 @@ sub postamble {
 
 __END__
 
-#line 371
+#line 541
old mode 100755 (executable)
new mode 100644 (file)
index a39ffde..cfe45b3
 package Module::Install::Metadata;
 
 use strict 'vars';
-use Module::Install::Base;
+use Module::Install::Base ();
 
-use vars qw{$VERSION $ISCORE @ISA};
+use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-       $VERSION = '0.70';
+       $VERSION = '1.00';
+       @ISA     = 'Module::Install::Base';
        $ISCORE  = 1;
-       @ISA     = qw{Module::Install::Base};
 }
 
+my @boolean_keys = qw{
+       sign
+};
+
 my @scalar_keys = qw{
-       name module_name abstract author version license
-       distribution_type perl_version tests installdirs
+       name
+       module_name
+       abstract
+       version
+       distribution_type
+       tests
+       installdirs
 };
 
 my @tuple_keys = qw{
-       configure_requires build_requires requires recommends bundles
+       configure_requires
+       build_requires
+       requires
+       recommends
+       bundles
+       resources
+};
+
+my @resource_keys = qw{
+       homepage
+       bugtracker
+       repository
+};
+
+my @array_keys = qw{
+       keywords
+       author
 };
 
-sub Meta            { shift        }
-sub Meta_ScalarKeys { @scalar_keys }
-sub Meta_TupleKeys  { @tuple_keys  }
+*authors = \&author;
+
+sub Meta              { shift          }
+sub Meta_BooleanKeys  { @boolean_keys  }
+sub Meta_ScalarKeys   { @scalar_keys   }
+sub Meta_TupleKeys    { @tuple_keys    }
+sub Meta_ResourceKeys { @resource_keys }
+sub Meta_ArrayKeys    { @array_keys    }
+
+foreach my $key ( @boolean_keys ) {
+       *$key = sub {
+               my $self = shift;
+               if ( defined wantarray and not @_ ) {
+                       return $self->{values}->{$key};
+               }
+               $self->{values}->{$key} = ( @_ ? $_[0] : 1 );
+               return $self;
+       };
+}
+
+foreach my $key ( @scalar_keys ) {
+       *$key = sub {
+               my $self = shift;
+               return $self->{values}->{$key} if defined wantarray and !@_;
+               $self->{values}->{$key} = shift;
+               return $self;
+       };
+}
 
-foreach my $key (@scalar_keys) {
+foreach my $key ( @array_keys ) {
        *$key = sub {
                my $self = shift;
-               return $self->{values}{$key} if defined wantarray and !@_;
-               $self->{values}{$key} = shift;
+               return $self->{values}->{$key} if defined wantarray and !@_;
+               $self->{values}->{$key} ||= [];
+               push @{$self->{values}->{$key}}, @_;
                return $self;
        };
 }
 
-foreach my $key (@tuple_keys) {
+foreach my $key ( @resource_keys ) {
        *$key = sub {
                my $self = shift;
-               return $self->{values}{$key} unless @_;
+               unless ( @_ ) {
+                       return () unless $self->{values}->{resources};
+                       return map  { $_->[1] }
+                              grep { $_->[0] eq $key }
+                              @{ $self->{values}->{resources} };
+               }
+               return $self->{values}->{resources}->{$key} unless @_;
+               my $uri = shift or die(
+                       "Did not provide a value to $key()"
+               );
+               $self->resources( $key => $uri );
+               return 1;
+       };
+}
 
-               my @rv;
-               while (@_) {
-                       my $module = shift or last;
+foreach my $key ( grep { $_ ne "resources" } @tuple_keys) {
+       *$key = sub {
+               my $self = shift;
+               return $self->{values}->{$key} unless @_;
+               my @added;
+               while ( @_ ) {
+                       my $module  = shift or last;
                        my $version = shift || 0;
-                       if ( $module eq 'perl' ) {
-                               $version =~ s{^(\d+)\.(\d+)\.(\d+)}
-                                            {$1 + $2/1_000 + $3/1_000_000}e;
-                               $self->perl_version($version);
-                               next;
-                       }
-                       my $rv = [ $module, $version ];
-                       push @rv, $rv;
+                       push @added, [ $module, $version ];
                }
-               push @{ $self->{values}{$key} }, @rv;
-               @rv;
+               push @{ $self->{values}->{$key} }, @added;
+               return map {@$_} @added;
        };
 }
 
+# Resource handling
+my %lc_resource = map { $_ => 1 } qw{
+       homepage
+       license
+       bugtracker
+       repository
+};
+
+sub resources {
+       my $self = shift;
+       while ( @_ ) {
+               my $name  = shift or last;
+               my $value = shift or next;
+               if ( $name eq lc $name and ! $lc_resource{$name} ) {
+                       die("Unsupported reserved lowercase resource '$name'");
+               }
+               $self->{values}->{resources} ||= [];
+               push @{ $self->{values}->{resources} }, [ $name, $value ];
+       }
+       $self->{values}->{resources};
+}
+
 # Aliases for build_requires that will have alternative
 # meanings in some future version of META.yml.
-sub test_requires      { shift->build_requires(@_)  }
-sub install_requires   { shift->build_requires(@_)  }
+sub test_requires     { shift->build_requires(@_) }
+sub install_requires  { shift->build_requires(@_) }
 
 # Aliases for installdirs options
-sub install_as_core    { $_[0]->installdirs('perl')   }
-sub install_as_cpan    { $_[0]->installdirs('site')   }
-sub install_as_site    { $_[0]->installdirs('site')   }
-sub install_as_vendor  { $_[0]->installdirs('vendor') }
-
-sub sign {
-       my $self = shift;
-       return $self->{'values'}{'sign'} if defined wantarray and ! @_;
-       $self->{'values'}{'sign'} = ( @_ ? $_[0] : 1 );
-       return $self;
-}
+sub install_as_core   { $_[0]->installdirs('perl')   }
+sub install_as_cpan   { $_[0]->installdirs('site')   }
+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, skipping\n";
+               warn "You MUST provide an explicit true/false value to dynamic_config\n";
                return $self;
        }
-       $self->{'values'}{'dynamic_config'} = $_[0] ? 1 : 0;
-       return $self;
+       $self->{values}->{dynamic_config} = $_[0] ? 1 : 0;
+       return 1;
+}
+
+sub perl_version {
+       my $self = shift;
+       return $self->{values}->{perl_version} unless @_;
+       my $version = shift or die(
+               "Did not provide a value to perl_version()"
+       );
+
+       # Normalize the version
+       $version = $self->_perl_version($version);
+
+       # We don't support the reall old versions
+       unless ( $version >= 5.005 ) {
+               die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n";
+       }
+
+       $self->{values}->{perl_version} = $version;
 }
 
 sub all_from {
        my ( $self, $file ) = @_;
 
        unless ( defined($file) ) {
-               my $name = $self->name
-                       or die "all_from called with no args without setting name() first";
+               my $name = $self->name or die(
+                       "all_from called with no args without setting name() first"
+               );
                $file = join('/', 'lib', split(/-/, $name)) . '.pm';
                $file =~ s{.*/}{} unless -e $file;
-               die "all_from: cannot find $file from $name" unless -e $file;
+               unless ( -e $file ) {
+                       die("all_from cannot find $file from $name");
+               }
+       }
+       unless ( -f $file ) {
+               die("The path '$file' does not exist, or is not a file");
        }
 
-       $self->version_from($file)      unless $self->version;
-       $self->perl_version_from($file) unless $self->perl_version;
+       $self->{values}{all_from} = $file;
 
-       # The remaining probes read from POD sections; if the file
-       # has an accompanying .pod, use that instead
+       # Some methods pull from POD instead of code.
+       # If there is a matching .pod, use that instead
        my $pod = $file;
-       if ( $pod =~ s/\.pm$/.pod/i and -e $pod ) {
-               $file = $pod;
-       }
+       $pod =~ s/\.pm$/.pod/i;
+       $pod = $file unless -e $pod;
 
-       $self->author_from($file)   unless $self->author;
-       $self->license_from($file)  unless $self->license;
-       $self->abstract_from($file) unless $self->abstract;
+       # Pull the different values
+       $self->name_from($file)         unless $self->name;
+       $self->version_from($file)      unless $self->version;
+       $self->perl_version_from($file) unless $self->perl_version;
+       $self->author_from($pod)        unless @{$self->author || []};
+       $self->license_from($pod)       unless $self->license;
+       $self->abstract_from($pod)      unless $self->abstract;
+
+       return 1;
 }
 
 sub provides {
        my $self     = shift;
-       my $provides = ( $self->{values}{provides} ||= {} );
+       my $provides = ( $self->{values}->{provides} ||= {} );
        %$provides = (%$provides, @_) if @_;
        return $provides;
 }
@@ -141,7 +245,7 @@ sub auto_provides {
 sub feature {
        my $self     = shift;
        my $name     = shift;
-       my $features = ( $self->{values}{features} ||= [] );
+       my $features = ( $self->{values}->{features} ||= [] );
        my $mods;
 
        if ( @_ == 1 and ref( $_[0] ) ) {
@@ -177,16 +281,16 @@ sub features {
 sub no_index {
        my $self = shift;
        my $type = shift;
-       push @{ $self->{values}{no_index}{$type} }, @_ if $type;
-       return $self->{values}{no_index};
+       push @{ $self->{values}->{no_index}->{$type} }, @_ if $type;
+       return $self->{values}->{no_index};
 }
 
 sub read {
        my $self = shift;
-       $self->include_deps( 'YAML', 0 );
+       $self->include_deps( 'YAML::Tiny', 0 );
 
-       require YAML;
-       my $data = YAML::LoadFile('META.yml');
+       require YAML::Tiny;
+       my $data = YAML::Tiny::LoadFile('META.yml');
 
        # Call methods explicitly in case user has already set some values.
        while ( my ( $key, $value ) = each %$data ) {
@@ -213,6 +317,9 @@ sub version_from {
        require ExtUtils::MM_Unix;
        my ( $self, $file ) = @_;
        $self->version( ExtUtils::MM_Unix->parse_version($file) );
+
+       # for version integrity check
+       $self->makemaker_args( VERSION_FROM => $file );
 }
 
 sub abstract_from {
@@ -223,38 +330,63 @@ sub abstract_from {
                        { DISTNAME => $self->name },
                        'ExtUtils::MM_Unix'
                )->parse_abstract($file)
-        );
+       );
 }
 
-sub _slurp {
-       local *FH;
-       open FH, "< $_[1]" or die "Cannot open $_[1].pod: $!";
-       do { local $/; <FH> };
+# Add both distribution and module name
+sub name_from {
+       my ($self, $file) = @_;
+       if (
+               Module::Install::_read($file) =~ m/
+               ^ \s*
+               package \s*
+               ([\w:]+)
+               \s* ;
+               /ixms
+       ) {
+               my ($name, $module_name) = ($1, $1);
+               $name =~ s{::}{-}g;
+               $self->name($name);
+               unless ( $self->module_name ) {
+                       $self->module_name($module_name);
+               }
+       } else {
+               die("Cannot determine name from $file\n");
+       }
 }
 
-sub perl_version_from {
-       my ( $self, $file ) = @_;
+sub _extract_perl_version {
        if (
-               $self->_slurp($file) =~ m/
-               ^
-               use \s*
+               $_[0] =~ m/
+               ^\s*
+               (?:use|require) \s*
                v?
                ([\d_\.]+)
                \s* ;
                /ixms
        ) {
-               my $v = $1;
-               $v =~ s{_}{}g;
-               $self->perl_version($1);
+               my $perl_version = $1;
+               $perl_version =~ s{_}{}g;
+               return $perl_version;
        } else {
-               warn "Cannot determine perl version info from $file\n";
+               return;
+       }
+}
+
+sub perl_version_from {
+       my $self = shift;
+       my $perl_version=_extract_perl_version(Module::Install::_read($_[0]));
+       if ($perl_version) {
+               $self->perl_version($perl_version);
+       } else {
+               warn "Cannot determine perl version info from $_[0]\n";
                return;
        }
 }
 
 sub author_from {
-       my ( $self, $file ) = @_;
-       my $content = $self->_slurp($file);
+       my $self    = shift;
+       my $content = Module::Install::_read($_[0]);
        if ($content =~ m/
                =head \d \s+ (?:authors?)\b \s*
                ([^\n]*)
@@ -264,55 +396,320 @@ sub author_from {
                ([^\n]*)
        /ixms) {
                my $author = $1 || $2;
-               $author =~ s{E<lt>}{<}g;
-               $author =~ s{E<gt>}{>}g;
+
+               # XXX: ugly but should work anyway...
+               if (eval "require Pod::Escapes; 1") {
+                       # Pod::Escapes has a mapping table.
+                       # It's in core of perl >= 5.9.3, and should be installed
+                       # as one of the Pod::Simple's prereqs, which is a prereq
+                       # of Pod::Text 3.x (see also below).
+                       $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
+                       {
+                               defined $2
+                               ? chr($2)
+                               : defined $Pod::Escapes::Name2character_number{$1}
+                               ? chr($Pod::Escapes::Name2character_number{$1})
+                               : do {
+                                       warn "Unknown escape: E<$1>";
+                                       "E<$1>";
+                               };
+                       }gex;
+               }
+               elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) {
+                       # Pod::Text < 3.0 has yet another mapping table,
+                       # though the table name of 2.x and 1.x are different.
+                       # (1.x is in core of Perl < 5.6, 2.x is in core of
+                       # Perl < 5.9.3)
+                       my $mapping = ($Pod::Text::VERSION < 2)
+                               ? \%Pod::Text::HTML_Escapes
+                               : \%Pod::Text::ESCAPES;
+                       $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
+                       {
+                               defined $2
+                               ? chr($2)
+                               : defined $mapping->{$1}
+                               ? $mapping->{$1}
+                               : do {
+                                       warn "Unknown escape: E<$1>";
+                                       "E<$1>";
+                               };
+                       }gex;
+               }
+               else {
+                       $author =~ s{E<lt>}{<}g;
+                       $author =~ s{E<gt>}{>}g;
+               }
                $self->author($author);
        } else {
-               warn "Cannot determine author info from $file\n";
+               warn "Cannot determine author info from $_[0]\n";
+       }
+}
+
+#Stolen from M::B
+my %license_urls = (
+    perl         => 'http://dev.perl.org/licenses/',
+    apache       => 'http://apache.org/licenses/LICENSE-2.0',
+    apache_1_1   => 'http://apache.org/licenses/LICENSE-1.1',
+    artistic     => 'http://opensource.org/licenses/artistic-license.php',
+    artistic_2   => 'http://opensource.org/licenses/artistic-license-2.0.php',
+    lgpl         => 'http://opensource.org/licenses/lgpl-license.php',
+    lgpl2        => 'http://opensource.org/licenses/lgpl-2.1.php',
+    lgpl3        => 'http://opensource.org/licenses/lgpl-3.0.html',
+    bsd          => 'http://opensource.org/licenses/bsd-license.php',
+    gpl          => 'http://opensource.org/licenses/gpl-license.php',
+    gpl2         => 'http://opensource.org/licenses/gpl-2.0.php',
+    gpl3         => 'http://opensource.org/licenses/gpl-3.0.html',
+    mit          => 'http://opensource.org/licenses/mit-license.php',
+    mozilla      => 'http://opensource.org/licenses/mozilla1.1.php',
+    open_source  => undef,
+    unrestricted => undef,
+    restrictive  => undef,
+    unknown      => undef,
+);
+
+sub license {
+       my $self = shift;
+       return $self->{values}->{license} unless @_;
+       my $license = shift or die(
+               'Did not provide a value to license()'
+       );
+       $license = __extract_license($license) || lc $license;
+       $self->{values}->{license} = $license;
+
+       # Automatically fill in license URLs
+       if ( $license_urls{$license} ) {
+               $self->resources( license => $license_urls{$license} );
        }
+
+       return 1;
+}
+
+sub _extract_license {
+       my $pod = shift;
+       my $matched;
+       return __extract_license(
+               ($matched) = $pod =~ m/
+                       (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?)
+                       (=head \d.*|=cut.*|)\z
+               /xms
+       ) || __extract_license(
+               ($matched) = $pod =~ m/
+                       (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?)
+                       (=head \d.*|=cut.*|)\z
+               /xms
+       );
+}
+
+sub __extract_license {
+       my $license_text = shift or return;
+       my @phrases      = (
+               '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1,
+               '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1,
+               'Artistic and GPL'                   => 'perl',         1,
+               'GNU general public license'         => 'gpl',          1,
+               'GNU public license'                 => 'gpl',          1,
+               'GNU lesser general public license'  => 'lgpl',         1,
+               'GNU lesser public license'          => 'lgpl',         1,
+               'GNU library general public license' => 'lgpl',         1,
+               'GNU library public license'         => 'lgpl',         1,
+               'GNU Free Documentation license'     => 'unrestricted', 1,
+               'GNU Affero General Public License'  => 'open_source',  1,
+               '(?:Free)?BSD license'               => 'bsd',          1,
+               'Artistic license'                   => 'artistic',     1,
+               'Apache (?:Software )?license'       => 'apache',       1,
+               'GPL'                                => 'gpl',          1,
+               'LGPL'                               => 'lgpl',         1,
+               'BSD'                                => 'bsd',          1,
+               'Artistic'                           => 'artistic',     1,
+               'MIT'                                => 'mit',          1,
+               'Mozilla Public License'             => 'mozilla',      1,
+               'Q Public License'                   => 'open_source',  1,
+               'OpenSSL License'                    => 'unrestricted', 1,
+               'SSLeay License'                     => 'unrestricted', 1,
+               'zlib License'                       => 'open_source',  1,
+               'proprietary'                        => 'proprietary',  0,
+       );
+       while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
+               $pattern =~ s#\s+#\\s+#gs;
+               if ( $license_text =~ /\b$pattern\b/i ) {
+                       return $license;
+               }
+       }
+       return '';
 }
 
 sub license_from {
-       my ( $self, $file ) = @_;
+       my $self = shift;
+       if (my $license=_extract_license(Module::Install::_read($_[0]))) {
+               $self->license($license);
+       } else {
+               warn "Cannot determine license info from $_[0]\n";
+               return 'unknown';
+       }
+}
 
-       if (
-               $self->_slurp($file) =~ m/
-               (
-                       =head \d \s+
-                       (?:licen[cs]e|licensing|copyright|legal)\b
-                       .*?
-               )
-               (=head\\d.*|=cut.*|)
-               \z
-       /ixms ) {
-               my $license_text = $1;
-               my @phrases      = (
-                       'under the same (?:terms|license) as perl itself' => 'perl',        1,
-                       'GNU public license'                              => 'gpl',         1,
-                       'GNU lesser public license'                       => 'lgpl',        1,
-                       'BSD license'                                     => 'bsd',         1,
-                       'Artistic license'                                => 'artistic',    1,
-                       'GPL'                                             => 'gpl',         1,
-                       'LGPL'                                            => 'lgpl',        1,
-                       'BSD'                                             => 'bsd',         1,
-                       'Artistic'                                        => 'artistic',    1,
-                       'MIT'                                             => 'mit',         1,
-                       'proprietary'                                     => 'proprietary', 0,
-               );
-               while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
-                       $pattern =~ s{\s+}{\\s+}g;
-                       if ( $license_text =~ /\b$pattern\b/i ) {
-                               if ( $osi and $license_text =~ /All rights reserved/i ) {
-                                       warn "LEGAL WARNING: 'All rights reserved' may invalidate Open Source licenses. Consider removing it.";
-                               }
-                               $self->license($license);
-                               return 1;
-                       }
+sub _extract_bugtracker {
+       my @links   = $_[0] =~ m#L<(
+        \Qhttp://rt.cpan.org/\E[^>]+|
+        \Qhttp://github.com/\E[\w_]+/[\w_]+/issues|
+        \Qhttp://code.google.com/p/\E[\w_\-]+/issues/list
+        )>#gx;
+       my %links;
+       @links{@links}=();
+       @links=keys %links;
+       return @links;
+}
+
+sub bugtracker_from {
+       my $self    = shift;
+       my $content = Module::Install::_read($_[0]);
+       my @links   = _extract_bugtracker($content);
+       unless ( @links ) {
+               warn "Cannot determine bugtracker info from $_[0]\n";
+               return 0;
+       }
+       if ( @links > 1 ) {
+               warn "Found more than one bugtracker link in $_[0]\n";
+               return 0;
+       }
+
+       # Set the bugtracker
+       bugtracker( $links[0] );
+       return 1;
+}
+
+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;
+       while ( @requires ) {
+               my $module  = shift @requires;
+               my $version = shift @requires;
+               $self->requires( $module => $version );
+       }
+}
+
+sub test_requires_from {
+       my $self     = shift;
+       my $content  = Module::Install::_readperl($_[0]);
+       my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg;
+       while ( @requires ) {
+               my $module  = shift @requires;
+               my $version = shift @requires;
+               $self->test_requires( $module => $version );
+       }
+}
+
+# Convert triple-part versions (eg, 5.6.1 or 5.8.9) to
+# numbers (eg, 5.006001 or 5.008009).
+# Also, convert double-part versions (eg, 5.8)
+sub _perl_version {
+       my $v = $_[-1];
+       $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e;
+       $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e;
+       $v =~ s/(\.\d\d\d)000$/$1/;
+       $v =~ s/_.+$//;
+       if ( ref($v) ) {
+               # Numify
+               $v = $v + 0;
+       }
+       return $v;
+}
+
+sub add_metadata {
+    my $self = shift;
+    my %hash = @_;
+    for my $key (keys %hash) {
+        warn "add_metadata: $key is not prefixed with 'x_'.\n" .
+             "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/;
+        $self->{values}->{$key} = $hash{$key};
+    }
+}
+
+
+######################################################################
+# MYMETA Support
+
+sub WriteMyMeta {
+       die "WriteMyMeta has been deprecated";
+}
+
+sub write_mymeta_yaml {
+       my $self = shift;
+
+       # We need YAML::Tiny to write the MYMETA.yml file
+       unless ( eval { require YAML::Tiny; 1; } ) {
+               return 1;
+       }
+
+       # Generate the data
+       my $meta = $self->_write_mymeta_data or return 1;
+
+       # Save as the MYMETA.yml file
+       print "Writing MYMETA.yml\n";
+       YAML::Tiny::DumpFile('MYMETA.yml', $meta);
+}
+
+sub write_mymeta_json {
+       my $self = shift;
+
+       # We need JSON to write the MYMETA.json file
+       unless ( eval { require JSON; 1; } ) {
+               return 1;
+       }
+
+       # Generate the data
+       my $meta = $self->_write_mymeta_data or return 1;
+
+       # Save as the MYMETA.yml file
+       print "Writing MYMETA.json\n";
+       Module::Install::_write(
+               'MYMETA.json',
+               JSON->new->pretty(1)->canonical->encode($meta),
+       );
+}
+
+sub _write_mymeta_data {
+       my $self = shift;
+
+       # If there's no existing META.yml there is nothing we can do
+       return undef unless -f 'META.yml';
+
+       # We need Parse::CPAN::Meta to load the file
+       unless ( eval { require Parse::CPAN::Meta; 1; } ) {
+               return undef;
+       }
+
+       # Merge the perl version into the dependencies
+       my $val  = $self->Meta->{values};
+       my $perl = delete $val->{perl_version};
+       if ( $perl ) {
+               $val->{requires} ||= [];
+               my $requires = $val->{requires};
+
+               # Canonize to three-dot version after Perl 5.6
+               if ( $perl >= 5.006 ) {
+                       $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e
                }
+               unshift @$requires, [ perl => $perl ];
+       }
+
+       # Load the advisory META.yml file
+       my @yaml = Parse::CPAN::Meta::LoadFile('META.yml');
+       my $meta = $yaml[0];
+
+       # Overwrite the non-configure dependency hashs
+       delete $meta->{requires};
+       delete $meta->{build_requires};
+       delete $meta->{recommends};
+       if ( exists $val->{requires} ) {
+               $meta->{requires} = { map { @$_ } @{ $val->{requires} } };
+       }
+       if ( exists $val->{build_requires} ) {
+               $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } };
        }
 
-       warn "Cannot determine license info from $file\n";
-       return 'unknown';
+       return $meta;
 }
 
 1;
old mode 100755 (executable)
new mode 100644 (file)
index 20a354b..b83e279
@@ -8,7 +8,7 @@ no warnings 'once';
 
 use Module::Install::Base;
 use base 'Module::Install::Base';
-our $VERSION = '0.24';
+our $VERSION = '0.28';
 
 use FindBin;
 use File::Glob     ();
@@ -42,15 +42,16 @@ sub RTx {
         $INC{'RT.pm'} = "$RT::LocalPath/lib/RT.pm";
     } else {
         local @INC = (
-            @INC,
             $ENV{RTHOME} ? ( $ENV{RTHOME}, "$ENV{RTHOME}/lib" ) : (),
-            map { ( "$_/rt3/lib", "$_/lib/rt3", "$_/lib" ) } grep $_,
-            @prefixes
+            @INC,
+            map { ( "$_/rt4/lib", "$_/lib/rt4", "$_/rt3/lib", "$_/lib/rt3", "$_/lib" )
+                } grep $_, @prefixes
         );
         until ( eval { require RT; $RT::LocalPath } ) {
             warn
                 "Cannot find the location of RT.pm that defines \$RT::LocalPath in: @INC\n";
-            $_ = $self->prompt("Path to your RT.pm:") or exit;
+            $_ = $self->prompt("Path to directory containing your RT.pm:") or exit;
+            $_ =~ s/\/RT\.pm$//;
             push @INC, $_, "$_/rt3/lib", "$_/lib/rt3", "$_/lib";
         }
     }
@@ -59,6 +60,7 @@ sub RTx {
     my $local_lib_path = "$RT::LocalPath/lib";
     print "Using RT configuration from $INC{'RT.pm'}:\n";
     unshift @INC, "$RT::LocalPath/lib" if $RT::LocalPath;
+    unshift @INC, $lib_path;
 
     $RT::LocalVarPath  ||= $RT::VarPath;
     $RT::LocalPoPath   ||= $RT::LocalLexiconPath;
@@ -184,8 +186,46 @@ sub RTxInit {
     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,
+    alpha => -4,
+    b     => -3,
+    beta  => -3,
+    pre   => -2,
+    rc    => -1,
+    head  => 9999,
+);
+sub cmp_version($$) {
+    my ($a, $b) = (@_);
+    my @a = grep defined, map { /^[0-9]+$/? $_ : /^[a-zA-Z]+$/? $word{$_}|| -10 : undef }
+        split /([^0-9]+)/, $a;
+    my @b = grep defined, map { /^[0-9]+$/? $_ : /^[a-zA-Z]+$/? $word{$_}|| -10 : undef }
+        split /([^0-9]+)/, $b;
+    @a > @b
+        ? push @b, (0) x (@a-@b)
+        : push @a, (0) x (@b-@a);
+    for ( my $i = 0; $i < @a; $i++ ) {
+        return $a[$i] <=> $b[$i] if $a[$i] <=> $b[$i];
+    }
+    return 0;
+}}
+sub requires_rt {
+    my ($self,$version) = @_;
+
+    # if we're exactly the same version as what we want, silently return
+    return if ($version eq $RT::VERSION);
+
+    my @sorted = sort cmp_version $version,$RT::VERSION;
+
+    if ($sorted[-1] eq $version) {
+        # should we die?
+        warn "\nWarning: prerequisite RT $version not found. Your installed version of RT ($RT::VERSION) is too old.\n\n";
+    }
+}
+
 1;
 
 __END__
 
-#line 302
+#line 348
old mode 100755 (executable)
new mode 100644 (file)
index 21a81ab..edc18b4
@@ -2,12 +2,12 @@
 package Module::Install::Win32;
 
 use strict;
-use Module::Install::Base;
+use Module::Install::Base ();
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-       $VERSION = '0.70';
-       @ISA     = qw{Module::Install::Base};
+       $VERSION = '1.00';
+       @ISA     = 'Module::Install::Base';
        $ISCORE  = 1;
 }
 
old mode 100755 (executable)
new mode 100644 (file)
index a05592d..d0f6599
@@ -2,11 +2,11 @@
 package Module::Install::WriteAll;
 
 use strict;
-use Module::Install::Base;
+use Module::Install::Base ();
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-       $VERSION = '0.70';
+       $VERSION = '1.00';
        @ISA     = qw{Module::Install::Base};
        $ISCORE  = 1;
 }
@@ -22,19 +22,42 @@ sub WriteAll {
        );
 
        $self->sign(1)                if $args{sign};
-       $self->Meta->write            if $args{meta};
        $self->admin->WriteAll(%args) if $self->is_admin;
 
        $self->check_nmake if $args{check_nmake};
        unless ( $self->makemaker_args->{PL_FILES} ) {
-               $self->makemaker_args( PL_FILES => {} );
+               # XXX: This still may be a bit over-defensive...
+               unless ($self->makemaker(6.25)) {
+                       $self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL';
+               }
        }
 
+       # Until ExtUtils::MakeMaker support MYMETA.yml, make sure
+       # we clean it up properly ourself.
+       $self->realclean_files('MYMETA.yml');
+
        if ( $args{inline} ) {
                $self->Inline->write;
        } else {
                $self->Makefile->write;
        }
+
+       # The Makefile write process adds a couple of dependencies,
+       # so write the META.yml files after the Makefile.
+       if ( $args{meta} ) {
+               $self->Meta->write;
+       }
+
+       # Experimental support for MYMETA
+       if ( $ENV{X_MYMETA} ) {
+               if ( $ENV{X_MYMETA} eq 'JSON' ) {
+                       $self->Meta->write_mymeta_json;
+               } else {
+                       $self->Meta->write_mymeta_yaml;
+               }
+       }
+
+       return 1;
 }
 
 1;
old mode 100755 (executable)
new mode 100644 (file)
index 55dc8ad..f07e17f
@@ -1,6 +1,6 @@
 package RT::Authen::ExternalAuth;
 
-our $VERSION = '0.08';
+our $VERSION = '0.09';
 
 =head1 NAME
 
@@ -545,4 +545,13 @@ sub CanonicalizeUserInfo {
    
 }
 
+{
+    no warnings 'redefine';
+    *RT::User::CanonicalizeUserInfo = sub {
+        my $self = shift;
+        my $args = shift;
+        return ( CanonicalizeUserInfo( $self, $args ) );
+    };
+}
+
 1;
old mode 100755 (executable)
new mode 100644 (file)
index a707d5e..7099632
@@ -434,7 +434,13 @@ sub _GetBoundDBIObj {
     my $dbi_driver    = $config->{'dbi_driver'};\r
 \r
     # Use config to create a DSN line for the DBI connection\r
-    my $dsn = "dbi:$dbi_driver:database=$db_database;host=$db_server;port=$db_port";\r
+    my $dsn;\r
+    if ( $dbi_driver eq 'SQLite' ) {\r
+        $dsn = "dbi:$dbi_driver:$db_database";\r
+    }\r
+    else {\r
+        $dsn = "dbi:$dbi_driver:database=$db_database;host=$db_server;port=$db_port";\r
+    }\r
 \r
     # Now let's get connected\r
     my $dbh = DBI->connect($dsn, $db_user, $db_pass,{RaiseError => 1, AutoCommit => 0 })\r
old mode 100755 (executable)
new mode 100644 (file)
old mode 100755 (executable)
new mode 100644 (file)
diff --git a/lib/RT/User_Vendor.pm b/lib/RT/User_Vendor.pm
deleted file mode 100755 (executable)
index bc7110c..0000000
+++ /dev/null
@@ -1,27 +0,0 @@
-no warnings qw(redefine);
-use strict;
-use RT::Authen::ExternalAuth;
-
-# {{{ sub CanonicalizeUserInfo
-
-=head2 CanonicalizeUserInfo HASHREF
-
-Get all ExternalDB attrs listed in $RT::ExternalDBAttrMap and put them into
-the hash referred to by HASHREF.
-
-returns true (1) if ExternalDB lookup was successful, false (undef)
-in all other cases.
-
-=cut
-
-sub CanonicalizeUserInfo {
-    my $self = shift;
-    my $args = shift;
-    return(RT::Authen::ExternalAuth::CanonicalizeUserInfo($self,$args));
-}
-# }}}
-
-
-
-
-1;
diff --git a/xt/ldap.t b/xt/ldap.t
new file mode 100644 (file)
index 0000000..89b9203
--- /dev/null
+++ b/xt/ldap.t
@@ -0,0 +1,98 @@
+use strict;
+use warnings;
+
+use RT::Test;
+use Net::LDAP;
+use RT::Authen::ExternalAuth;
+
+eval { require Net::LDAP::Server::Test; 1; } or do {
+    plan skip_all => 'Unable to test without Net::Server::LDAP::Test';
+};
+
+
+my $ldap_port = 1024 + int rand(10000) + $$ % 1024;
+ok( my $server = Net::LDAP::Server::Test->new( $ldap_port, auto_schema => 1 ),
+    "spawned test LDAP server on port $ldap_port" );
+
+my $ldap = Net::LDAP->new("localhost:$ldap_port");
+$ldap->bind();
+my $username = "testuser";
+my $dn       = "uid=$username,dc=bestpractical,dc=com";
+my $entry    = {
+    cn           => $username,
+    mail         => "$username\@invalid.tld",
+    uid          => $username,
+    objectClass  => 'User',
+    userPassword => 'password',
+};
+$ldap->add( $dn, attr => [%$entry] );
+
+RT->Config->Set( Plugins                     => 'RT::Authen::ExternalAuth' );
+RT->Config->Set( ExternalAuthPriority        => ['My_LDAP'] );
+RT->Config->Set( ExternalInfoPriority        => ['My_LDAP'] );
+RT->Config->Set( ExternalServiceUsesSSLorTLS => 0 );
+RT->Config->Set( AutoCreateNonExternalUsers  => 0 );
+RT->Config->Set( AutoCreate  => undef );
+RT->Config->Set(
+    ExternalSettings => {    # AN EXAMPLE DB SERVICE
+        'My_LDAP' => {
+            'type'            => 'ldap',
+            'server'          => "127.0.0.1:$ldap_port",
+            'base'            => 'dc=bestpractical,dc=com',
+            'filter'          => '(objectClass=*)',
+            'd_filter'        => '()',
+            'tls'             => 0,
+            'net_ldap_args'   => [ version => 3 ],
+            'attr_match_list' => [ 'Name', 'EmailAddress' ],
+            'attr_map'        => {
+                'Name'         => 'uid',
+                'EmailAddress' => 'mail',
+            }
+        },
+    }
+);
+
+my ( $baseurl, $m ) = RT::Test->started_ok();
+
+diag "test uri login";
+{
+    ok( !$m->login( 'fakeuser', 'password' ), 'not logged in with fake user' );
+    ok( $m->login( 'testuser', 'password' ), 'logged in' );
+}
+diag "test user creation";
+{
+my $testuser = RT::User->new($RT::SystemUser);
+my ($ok,$msg) = $testuser->Load( 'testuser' );
+ok($ok,$msg);
+is($testuser->EmailAddress,'testuser@invalid.tld');
+}
+
+
+diag "test form login";
+{
+    $m->logout;
+    $m->get_ok( $baseurl, 'base url' );
+    $m->submit_form(
+        form_number => 1,
+        fields      => { user => 'testuser', pass => 'password', },
+    );
+    $m->text_contains( 'Logout', 'logged in via form' );
+}
+
+is( $m->uri, $baseurl . '/SelfService/' , 'selfservice page' );
+
+diag "test redirect after login";
+{
+    $m->logout;
+    $m->get_ok( $baseurl . '/SelfService/Closed.html', 'closed tickets page' );
+    $m->submit_form(
+        form_number => 1,
+        fields      => { user => 'testuser', pass => 'password', },
+    );
+    $m->text_contains( 'Logout', 'logged in' );
+    is( $m->uri, $baseurl . '/SelfService/Closed.html' );
+}
+
+$ldap->unbind();
+
+$m->get_warnings;
diff --git a/xt/ldap_privileged.t b/xt/ldap_privileged.t
new file mode 100644 (file)
index 0000000..770cea8
--- /dev/null
@@ -0,0 +1,85 @@
+use strict;
+use warnings;
+
+use RT::Test;
+use Net::LDAP;
+use RT::Authen::ExternalAuth;
+
+eval { require Net::LDAP::Server::Test; 1; } or do {
+    plan skip_all => 'Unable to test without Net::Server::LDAP::Test';
+};
+
+my $ldap_port = 1024 + int rand(10000) + $$ % 1024;
+ok( my $server = Net::LDAP::Server::Test->new( $ldap_port, auto_schema => 1 ),
+    "spawned test LDAP server on port $ldap_port" );
+
+my $ldap = Net::LDAP->new("localhost:$ldap_port");
+$ldap->bind();
+my $username = "testuser";
+my $dn       = "uid=$username,dc=bestpractical,dc=com";
+my $entry    = {
+    cn           => $username,
+    mail         => "$username\@invalid.tld",
+    uid          => $username,
+    objectClass  => 'User',
+    userPassword => 'password',
+};
+$ldap->add( $dn, attr => [%$entry] );
+
+RT->Config->Set( Plugins                     => 'RT::Authen::ExternalAuth' );
+RT->Config->Set( ExternalAuthPriority        => ['My_LDAP'] );
+RT->Config->Set( ExternalInfoPriority        => ['My_LDAP'] );
+RT->Config->Set( ExternalServiceUsesSSLorTLS => 0 );
+RT->Config->Set( AutoCreateNonExternalUsers  => 0 );
+RT->Config->Set( AutoCreate                  => { Privileged => 1 } );
+RT->Config->Set(
+    ExternalSettings => {    # AN EXAMPLE DB SERVICE
+        'My_LDAP' => {
+            'type'            => 'ldap',
+            'server'          => "127.0.0.1:$ldap_port",
+            'base'            => 'dc=bestpractical,dc=com',
+            'filter'          => '(objectClass=*)',
+            'tls'             => 0,
+            'net_ldap_args'   => [ version => 3 ],
+            'attr_match_list' => [ 'Name', 'EmailAddress' ],
+            'attr_map'        => {
+                'Name'         => 'uid',
+                'EmailAddress' => 'mail',
+            }
+        },
+    }
+);
+
+my ( $baseurl, $m ) = RT::Test->started_ok();
+
+diag "test uri login";
+{
+    ok( !$m->login( 'fakeuser', 'password' ), 'not logged in with fake user' );
+    ok( $m->login( 'testuser', 'password' ), 'logged in' );
+}
+
+diag "test user creation";
+{
+my $testuser = RT::User->new($RT::SystemUser);
+my ($ok,$msg) = $testuser->Load( 'testuser' );
+ok($ok,$msg);
+is($testuser->EmailAddress,'testuser@invalid.tld');
+}
+
+
+diag "test form login";
+{
+    $m->logout;
+    $m->get_ok( $baseurl, 'base url' );
+    $m->submit_form(
+        form_number => 1,
+        fields      => { user => 'testuser', pass => 'password', },
+    );
+    $m->text_contains( 'Logout', 'logged in via form' );
+}
+
+like( $m->uri, qr!$baseurl/(index\.html)?!, 'privileged home page' );
+
+$ldap->unbind();
+
+$m->get_warnings;
diff --git a/xt/sqlite.t b/xt/sqlite.t
new file mode 100644 (file)
index 0000000..09791de
--- /dev/null
@@ -0,0 +1,108 @@
+use strict;
+use warnings;
+
+use RT::Test;
+use DBI;
+use File::Temp;
+use Digest::MD5;
+use File::Spec;
+
+eval { require DBD::SQLite; } or do {
+    plan skip_all => 'Unable to test without DBD::SQLite';
+};
+
+my $dir    = File::Temp::tempdir( CLEANUP => 1 );
+my $dbname = File::Spec->catfile( $dir, 'rtauthtest' );
+my $table  = 'users';
+my $dbh = DBI->connect("dbi:SQLite:$dbname");
+my $password = Digest::MD5::md5_hex('password');
+my $schema = <<"EOF";
+CREATE TABLE users (
+  username varchar(200) NOT NULL,
+  password varchar(40) NULL,
+  email varchar(16) NULL
+);
+EOF
+$dbh->do( $schema );
+$dbh->do(
+"INSERT INTO $table VALUES ( 'testuser', '$password', 'testuser\@invalid.tld')"
+);
+
+RT->Config->Set( Plugins                     => 'RT::Authen::ExternalAuth' );
+RT->Config->Set( ExternalAuthPriority        => ['My_SQLite'] );
+RT->Config->Set( ExternalInfoPriority        => ['My_SQLite'] );
+RT->Config->Set( ExternalServiceUsesSSLorTLS => 0 );
+RT->Config->Set( AutoCreateNonExternalUsers  => 0 );
+RT->Config->Set( AutoCreate                  => undef );
+RT->Config->Set(
+    ExternalSettings => {
+        'My_SQLite' => {
+            'type'   => 'db',
+            'database'        => $dbname,
+            'table'           => $table,
+            'dbi_driver'      => 'SQLite',
+            'u_field'         => 'username',
+            'p_field'         => 'password',
+            'p_enc_pkg'       => 'Digest::MD5',
+            'p_enc_sub'       => 'md5_hex',
+            'attr_match_list' => ['Name'],
+            'attr_map'        => {
+                'Name'           => 'username',
+                'EmailAddress'   => 'email',
+                'ExternalAuthId' => 'username',
+            }
+        },
+    }
+);
+
+my ( $baseurl, $m ) = RT::Test->started_ok();
+
+diag "test uri login";
+{
+    ok( !$m->login( 'fakeuser', 'password' ), 'not logged in with fake user' );
+    ok( !$m->login( 'testuser', 'wrongpassword' ), 'not logged in with wrong password' );
+    ok( $m->login( 'testuser', 'password' ), 'logged in' );
+}
+
+diag "test user creation";
+{
+my $testuser = RT::User->new($RT::SystemUser);
+my ($ok,$msg) = $testuser->Load( 'testuser' );
+ok($ok,$msg);
+is($testuser->EmailAddress,'testuser@invalid.tld');
+}
+
+diag "test form login";
+{
+    $m->logout;
+    $m->get_ok( $baseurl, 'base url' );
+    $m->submit_form(
+        form_number => 1,
+        fields      => { user => 'testuser', pass => 'password', },
+    );
+    $m->text_contains( 'Logout', 'logged in via form' );
+}
+
+is( $m->uri, $baseurl . '/SelfService/', 'selfservice page' );
+
+diag "test redirect after login";
+{
+    $m->logout;
+    $m->get_ok( $baseurl . '/SelfService/Closed.html', 'closed tickets page' );
+    $m->submit_form(
+        form_number => 1,
+        fields      => { user => 'testuser', pass => 'password', },
+    );
+    $m->text_contains( 'Logout', 'logged in' );
+    is( $m->uri, $baseurl . '/SelfService/Closed.html' );
+}
+
+diag "test with user and pass in URL";
+{
+    $m->logout;
+    $m->get_ok( $baseurl . '/SelfService/Closed.html?user=testuser;pass=password', 'closed tickets page' );
+    $m->text_contains( 'Logout', 'logged in' );
+    is( $m->uri, $baseurl . '/SelfService/Closed.html?user=testuser;pass=password' );
+}
+
+$m->get_warnings;