[Bps-public-commit] RT-Extension-LDAPImport branch, master, updated. 0.07-13-gce9afc8
Kevin Falcone
falcone at bestpractical.com
Tue Jul 13 16:32:43 EDT 2010
The branch, master has been updated
via ce9afc8ebce993d0718ceebe03192351e2285973 (commit)
via 4366979f4517df068c96f20ece9c6773a1d41c2b (commit)
via 32edc7060ecc1445995ac3132c2c2b12c7f044dc (commit)
via b0f13d08961c4ede554238567e9c7095300bd640 (commit)
via f7156841f7e36166163cffed5d3c4f8033e9772b (commit)
via 24e2f67fa4ab4db6c52d2ab0314d809ce2911a36 (commit)
via eab8af697c174f736d04dd5dc11508cfd74d1529 (commit)
via 194d87cbc4c44c7c1e559fe792506d345c1a11ad (commit)
via 171fee35e134986ff6c496f8e55c6529922717b2 (commit)
via d545deed9e59fcd9acd6dfb49f082fee744d9f27 (commit)
via 837bc9f4c5bfa4cf26fbcb3a5ee90b70107d68bc (commit)
via 5341d9664ddab8bc0c7f24a2e15dba9e2ed69338 (commit)
via 27bd0dd3a92e8feac57d2b94bd1ba4c9c0ce1bf2 (commit)
from 720acd6b2edc83c7648bd53775b7a67474155259 (commit)
Summary of changes:
.gitignore | 16 ++-
INSTALL.SKIP | 1 +
MANIFEST | 3 +-
MANIFEST.SKIP | 37 ++++++
META.yml | 5 +-
Makefile.PL | 3 +
README | 19 +++-
bin/rtldapimport | 23 ----
bin/rtldapimport.in | 44 +++++++
inc/Module/Install.pm | 218 +++++++++++++++++++-------------
inc/Module/Install/Base.pm | 11 ++-
inc/Module/Install/Can.pm | 2 +-
inc/Module/Install/Fetch.pm | 2 +-
inc/Module/Install/Makefile.pm | 229 ++++++++++++++++++++++++++++------
inc/Module/Install/Metadata.pm | 267 +++++++++++++++++++++++++++-------------
inc/Module/Install/RTx.pm | 9 +-
inc/Module/Install/Win32.pm | 2 +-
inc/Module/Install/WriteAll.pm | 7 +-
lib/RT/Extension/LDAPImport.pm | 142 ++++++++++++++++++---
19 files changed, 759 insertions(+), 281 deletions(-)
create mode 100644 INSTALL.SKIP
create mode 100644 MANIFEST.SKIP
delete mode 100644 bin/rtldapimport
create mode 100755 bin/rtldapimport.in
- Log -----------------------------------------------------------------
commit 27bd0dd3a92e8feac57d2b94bd1ba4c9c0ce1bf2
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Mon Jul 12 17:27:18 2010 -0400
bump up MI
diff --git a/META.yml b/META.yml
index 80136bb..8c8f13b 100644
--- a/META.yml
+++ b/META.yml
@@ -1,13 +1,14 @@
---
abstract: 'Import RT Users from an LDAP store'
author:
+ - 'Kevin Falcone C<< <falcone at bestpractical.com> >>'
- 'Kevin Falcone <falcone at bestpractical.com>'
build_requires:
ExtUtils::MakeMaker: 6.42
configure_requires:
ExtUtils::MakeMaker: 6.42
distribution_type: module
-generated_by: 'Module::Install version 0.91'
+generated_by: 'Module::Install version 1.00'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
diff --git a/inc/Module/Install.pm b/inc/Module/Install.pm
index 51eda5d..8ee839d 100644
--- a/inc/Module/Install.pm
+++ b/inc/Module/Install.pm
@@ -19,6 +19,9 @@ package Module::Install;
use 5.005;
use strict 'vars';
+use Cwd ();
+use File::Find ();
+use File::Path ();
use vars qw{$VERSION $MAIN};
BEGIN {
@@ -28,7 +31,7 @@ BEGIN {
# This is not enforced yet, but will be some time in the next few
# releases once we can make sure it won't clash with custom
# Module::Install extensions.
- $VERSION = '0.91';
+ $VERSION = '1.00';
# Storage for the pseudo-singleton
$MAIN = undef;
@@ -38,18 +41,25 @@ BEGIN {
}
+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:
@@ -61,26 +71,28 @@ not:
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 ) {
- 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" }
+ # 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" }
Your installer $0 has a modification time in the future ($s > $t).
@@ -89,15 +101,12 @@ 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 ) { 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.
@@ -107,23 +116,42 @@ 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));
+ #-------------------------------------------------------------
+ unless ( -f $self->{file} ) {
+ foreach my $key (keys %INC) {
+ delete $INC{$key} if $key =~ /Module\/Install/;
+ }
-# 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));
-
+ local $^W;
+ require "$self->{path}/$self->{dispatch}.pm";
+ File::Path::mkpath("$self->{prefix}/$self->{author}");
+ $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
+ $self->{admin}->init;
+ @_ = ($class, _self => $self);
+ 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{'inc/Module/Install.pm'};
+ delete $INC{'Module/Install.pm'};
+ # Save to the singleton
+ $MAIN = $self;
-use Cwd ();
-use File::Find ();
-use File::Path ();
-use FindBin;
+ return 1;
+}
sub autoload {
my $self = shift;
@@ -136,7 +164,21 @@ sub autoload {
# Delegate back to parent dirs
goto &$code unless $cwd eq $pwd;
}
- $$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym";
+ 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
@@ -152,33 +194,6 @@ sub autoload {
};
}
-sub import {
- my $class = shift;
- my $self = $class->new(@_);
- my $who = $self->_caller;
-
- unless ( -f $self->{file} ) {
- require "$self->{path}/$self->{dispatch}.pm";
- File::Path::mkpath("$self->{prefix}/$self->{author}");
- $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
- $self->{admin}->init;
- @_ = ($class, _self => $self);
- goto &{"$self->{name}::import"};
- }
-
- *{"${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"};
-
- # Save to the singleton
- $MAIN = $self;
-
- return 1;
-}
-
sub preload {
my $self = shift;
unless ( $self->{extensions} ) {
@@ -204,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"};
@@ -214,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';
@@ -272,8 +294,10 @@ END_DIE
sub load_extensions {
my ($self, $path, $top) = @_;
+ 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) ) {
@@ -281,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 );
}
@@ -348,17 +373,24 @@ 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;
- if ( $] >= 5.006 ) {
- open( FH, '<', $_[0] ) or die "open($_[0]): $!";
- } else {
- open( FH, "< $_[0]" ) or die "open($_[0]): $!";
- }
+ 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]);
@@ -379,18 +411,26 @@ sub _readpod {
return $string;
}
+# Done in evals to avoid confusing Perl::MinimumVersion
+eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
sub _write {
local *FH;
- if ( $] >= 5.006 ) {
- open( FH, '>', $_[0] ) or die "open($_[0]): $!";
- } else {
- open( FH, "> $_[0]" ) or die "open($_[0]): $!";
+ 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).
@@ -427,4 +467,4 @@ sub _CLASS ($) {
1;
-# Copyright 2008 - 2009 Adam Kennedy.
+# Copyright 2008 - 2010 Adam Kennedy.
diff --git a/inc/Module/Install/Base.pm b/inc/Module/Install/Base.pm
index 60a74d2..b55bda3 100644
--- a/inc/Module/Install/Base.pm
+++ b/inc/Module/Install/Base.pm
@@ -4,7 +4,7 @@ package Module::Install::Base;
use strict 'vars';
use vars qw{$VERSION};
BEGIN {
- $VERSION = '0.91';
+ $VERSION = '1.00';
}
# Suspend handler for "redefined" warnings
@@ -51,13 +51,18 @@ sub admin {
#line 106
sub is_admin {
- $_[0]->admin->VERSION;
+ ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin');
}
sub DESTROY {}
package Module::Install::Base::FakeAdmin;
+use vars qw{$VERSION};
+BEGIN {
+ $VERSION = $Module::Install::Base::VERSION;
+}
+
my $fake;
sub new {
@@ -75,4 +80,4 @@ BEGIN {
1;
-#line 154
+#line 159
diff --git a/inc/Module/Install/Can.pm b/inc/Module/Install/Can.pm
index e65e4f6..71ccc27 100644
--- a/inc/Module/Install/Can.pm
+++ b/inc/Module/Install/Can.pm
@@ -9,7 +9,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.91';
+ $VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
diff --git a/inc/Module/Install/Fetch.pm b/inc/Module/Install/Fetch.pm
index 05f2079..ec1f106 100644
--- a/inc/Module/Install/Fetch.pm
+++ b/inc/Module/Install/Fetch.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.91';
+ $VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
diff --git a/inc/Module/Install/Makefile.pm b/inc/Module/Install/Makefile.pm
index 98779db..5dfd0e9 100644
--- a/inc/Module/Install/Makefile.pm
+++ b/inc/Module/Install/Makefile.pm
@@ -4,10 +4,11 @@ package Module::Install::Makefile;
use strict 'vars';
use ExtUtils::MakeMaker ();
use Module::Install::Base ();
+use Fcntl qw/:flock :seek/;
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.91';
+ $VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -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 ($self, %new_args) = @_;
my $args = ( $self->{makemaker_args} ||= {} );
- %$args = ( %$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( ' ', @_ );
}
@@ -89,25 +181,22 @@ 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 {
@@ -130,12 +219,13 @@ sub write {
# an underscore, even though its own version may contain one!
# Hence the funny regexp to get rid of it. See RT #35800
# for details.
- $self->build_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ );
- $self->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ );
+ 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->build_requires( 'ExtUtils::MakeMaker' => 6.42 );
$self->configure_requires( 'ExtUtils::MakeMaker' => 6.42 );
}
@@ -143,59 +233,115 @@ sub write {
my $args = $self->makemaker_args;
$args->{DISTNAME} = $self->name;
$args->{NAME} = $self->module_name || $self->name;
- $args->{VERSION} = $self->version;
$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 ) {
$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)) {
+ if ( my $preop = $self->admin->preop($user_preop) ) {
foreach my $key ( keys %$preop ) {
$args{dist}->{$key} = $preop->{$key};
}
@@ -219,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;
@@ -241,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 $!;
@@ -265,4 +412,4 @@ sub postamble {
__END__
-#line 394
+#line 541
diff --git a/inc/Module/Install/Metadata.pm b/inc/Module/Install/Metadata.pm
index 653193d..cfe45b3 100644
--- a/inc/Module/Install/Metadata.pm
+++ b/inc/Module/Install/Metadata.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.91';
+ $VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -19,7 +19,6 @@ my @scalar_keys = qw{
name
module_name
abstract
- author
version
distribution_type
tests
@@ -43,8 +42,11 @@ my @resource_keys = qw{
my @array_keys = qw{
keywords
+ author
};
+*authors = \&author;
+
sub Meta { shift }
sub Meta_BooleanKeys { @boolean_keys }
sub Meta_ScalarKeys { @scalar_keys }
@@ -176,43 +178,6 @@ sub perl_version {
$self->{values}->{perl_version} = $version;
}
-#Stolen from M::B
-my %license_urls = (
- perl => 'http://dev.perl.org/licenses/',
- apache => 'http://apache.org/licenses/LICENSE-2.0',
- 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()'
- );
- $self->{values}->{license} = $license;
-
- # Automatically fill in license URLs
- if ( $license_urls{$license} ) {
- $self->resources( license => $license_urls{$license} );
- }
-
- return 1;
-}
-
sub all_from {
my ( $self, $file ) = @_;
@@ -230,6 +195,8 @@ sub all_from {
die("The path '$file' does not exist, or is not a file");
}
+ $self->{values}{all_from} = $file;
+
# Some methods pull from POD instead of code.
# If there is a matching .pod, use that instead
my $pod = $file;
@@ -240,7 +207,7 @@ sub all_from {
$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->author_from($pod) unless @{$self->author || []};
$self->license_from($pod) unless $self->license;
$self->abstract_from($pod) unless $self->abstract;
@@ -350,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 {
@@ -360,7 +330,7 @@ sub abstract_from {
{ DISTNAME => $self->name },
'ExtUtils::MM_Unix'
)->parse_abstract($file)
- );
+ );
}
# Add both distribution and module name
@@ -385,11 +355,10 @@ sub name_from {
}
}
-sub perl_version_from {
- my $self = shift;
+sub _extract_perl_version {
if (
- Module::Install::_read($_[0]) =~ m/
- ^
+ $_[0] =~ m/
+ ^\s*
(?:use|require) \s*
v?
([\d_\.]+)
@@ -398,6 +367,16 @@ sub perl_version_from {
) {
my $perl_version = $1;
$perl_version =~ s{_}{}g;
+ return $perl_version;
+ } else {
+ 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";
@@ -417,59 +396,164 @@ 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 $_[0]\n";
}
}
-sub license_from {
+#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;
- if (
- Module::Install::_read($_[0]) =~ 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|the perl programming language) itself' => '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,
- '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 ) {
- $self->license($license);
- return 1;
- }
+ 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 '';
+}
- warn "Cannot determine license info from $_[0]\n";
- return 'unknown';
+sub license_from {
+ 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';
+ }
}
sub _extract_bugtracker {
- my @links = $_[0] =~ m#L<(\Qhttp://rt.cpan.org/\E[^>]+)>#g;
+ 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;
@@ -485,7 +569,7 @@ sub bugtracker_from {
return 0;
}
if ( @links > 1 ) {
- warn "Found more than on rt.cpan.org link in $_[0]\n";
+ warn "Found more than one bugtracker link in $_[0]\n";
return 0;
}
@@ -532,8 +616,15 @@ sub _perl_version {
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};
+ }
+}
######################################################################
diff --git a/inc/Module/Install/RTx.pm b/inc/Module/Install/RTx.pm
index 20a354b..b780a6c 100644
--- a/inc/Module/Install/RTx.pm
+++ b/inc/Module/Install/RTx.pm
@@ -8,7 +8,7 @@ no warnings 'once';
use Module::Install::Base;
use base 'Module::Install::Base';
-our $VERSION = '0.24';
+our $VERSION = '0.25';
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" ) : (),
+ @INC,
map { ( "$_/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";
}
}
@@ -188,4 +189,4 @@ sub RTxInit {
__END__
-#line 302
+#line 303
diff --git a/inc/Module/Install/Win32.pm b/inc/Module/Install/Win32.pm
index f2f99df..edc18b4 100644
--- a/inc/Module/Install/Win32.pm
+++ b/inc/Module/Install/Win32.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.91';
+ $VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
diff --git a/inc/Module/Install/WriteAll.pm b/inc/Module/Install/WriteAll.pm
index 12471e5..d0f6599 100644
--- a/inc/Module/Install/WriteAll.pm
+++ b/inc/Module/Install/WriteAll.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.91';;
+ $VERSION = '1.00';
@ISA = qw{Module::Install::Base};
$ISCORE = 1;
}
@@ -26,7 +26,10 @@ sub WriteAll {
$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
commit 5341d9664ddab8bc0c7f24a2e15dba9e2ed69338
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Mon Jul 12 17:31:09 2010 -0400
Add a usage statement
Based on a patch from Robert Nesius
diff --git a/bin/rtldapimport b/bin/rtldapimport
index 651110e..4e90ece 100644
--- a/bin/rtldapimport
+++ b/bin/rtldapimport
@@ -11,9 +11,16 @@ RT::Init;
use RT::Extension::LDAPImport;
-my $debug;
+my ($debug, $help);
use Getopt::Long;
-GetOptions ( "debug" => \$debug );
+GetOptions ( "debug" => \$debug, "help" => \$help );
+if ($help) {
+ print "$0: [--debug] [--help]\n";
+ print " --help This usage statement.\n";
+ print " --debug Enable debugging.\n";
+ exit 0;
+}
+
my $importer = RT::Extension::LDAPImport->new;
$importer->screendebug(1) if $debug;
commit 837bc9f4c5bfa4cf26fbcb3a5ee90b70107d68bc
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Mon Jul 12 17:33:51 2010 -0400
Require that you pass a flag to run the import
By default, it will only show debugging messages
Based on a patch by Robert Nesius
diff --git a/bin/rtldapimport b/bin/rtldapimport
old mode 100644
new mode 100755
index 4e90ece..b167835
--- a/bin/rtldapimport
+++ b/bin/rtldapimport
@@ -3,28 +3,40 @@
use strict;
use warnings;
+BEGIN {
### after: use lib qw(@RT_LIB_PATH@);
use lib '/opt/rt3/local/lib /opt/rt3/lib';
use RT;
RT::LoadConfig;
RT::Init;
+}
use RT::Extension::LDAPImport;
-my ($debug, $help);
+my ($debug,$import,$help);
use Getopt::Long;
-GetOptions ( "debug" => \$debug, "help" => \$help );
+GetOptions ( "debug" => \$debug, "help" => \$help, "import" => \$import );
if ($help) {
- print "$0: [--debug] [--help]\n";
+ print "$0: [--debug] [--import] [--help]\n";
print " --help This usage statement.\n";
print " --debug Enable debugging.\n";
+ print " --import Do the import.\n";
exit 0;
}
-
my $importer = RT::Extension::LDAPImport->new;
$importer->screendebug(1) if $debug;
-print "Starting import\n";
-$importer->import_users;
-print "Finished import\n";
+if ($import) {
+ print "Starting import\n";
+ $importer->import_users(import => 1);
+ print "Finished import\n";
+} else {
+ print <<TESTING;
+Running test import, no data will be changed
+Rerun command with --import to perform the import
+Rerun command with --debug for more information
+TESTING
+ $importer->import_users;
+ print "Finished test\n";
+}
diff --git a/lib/RT/Extension/LDAPImport.pm b/lib/RT/Extension/LDAPImport.pm
index 70045fc..57648ef 100644
--- a/lib/RT/Extension/LDAPImport.pm
+++ b/lib/RT/Extension/LDAPImport.pm
@@ -103,13 +103,16 @@ sub run_search {
}
-=head2 import_users
+=head2 import_users import => 1|0
Takes the results of the search from run_search
and maps attributes from LDAP into RT::User attributes
using $RT::LDAPMapping.
Creates RT users if they don't already exist.
+With no arguments, only prints debugging information.
+Pass import => 1 to actually change data.
+
RT::LDAPMapping should be set in your RT_SiteConfig
file and looks like this.
@@ -134,6 +137,7 @@ together with a single space.
sub import_users {
my $self = shift;
+ my %args = @_;
my $results = $self->run_search;
unless ( $results && $results->count ) {
@@ -151,11 +155,15 @@ sub import_users {
$self->_warn("No Name or Emailaddress for user, skipping ".Dumper $user);
next;
}
- $self->_debug("Creating user $user->{Name}");
- #$self->_debug(Dumper $user);
- my $user_obj = $self->create_rt_user( user => $user );
- $self->add_user_to_group( user => $user_obj );
- $self->add_custom_field_value( user => $user_obj, ldap_entry => $entry );
+ if ($args{import}) {
+ $self->_debug("Processing user $user->{Name}");
+ my $user_obj = $self->create_rt_user( user => $user );
+ $self->add_user_to_group( user => $user_obj );
+ $self->add_custom_field_value( user => $user_obj, ldap_entry => $entry );
+ } else {
+ print "Found user $user->{Name}\n";
+ $self->_debug(Dumper($user));
+ }
}
}
commit d545deed9e59fcd9acd6dfb49f082fee744d9f27
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Mon Jul 12 17:34:29 2010 -0400
Quiet a warning when there is no attribute from LDAP
Based on a patch by Robert Nesius
diff --git a/lib/RT/Extension/LDAPImport.pm b/lib/RT/Extension/LDAPImport.pm
index 57648ef..f8ecba2 100644
--- a/lib/RT/Extension/LDAPImport.pm
+++ b/lib/RT/Extension/LDAPImport.pm
@@ -216,7 +216,7 @@ sub _build_user {
# this may want to be configurable
push @values, scalar $args{ldap_entry}->get_value($attribute);
}
- $user->{$rtfield} = join(' ', at values);
+ $user->{$rtfield} = join(' ',grep {defined} @values);
}
return $user;
commit 171fee35e134986ff6c496f8e55c6529922717b2
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Tue Jul 13 12:09:11 2010 -0400
hide more things
diff --git a/.gitignore b/.gitignore
index 12be28e..c224ce3 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,4 +1,14 @@
+blib*
Makefile
-*.bak
-blib
-pm_to_blib
+Makefile.old
+Build
+Build.bat
+_build*
+pm_to_blib*
+*.tar.gz
+.lwpcookies
+cover_db
+pod2htm*.tmp
+RT-Extension-LDAPImport-*
+META.yml
+*.swp
commit 194d87cbc4c44c7c1e559fe792506d345c1a11ad
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Tue Jul 13 12:54:20 2010 -0400
Remove a zillion print statements
diff --git a/bin/rtldapimport b/bin/rtldapimport
index b167835..ef62dd6 100755
--- a/bin/rtldapimport
+++ b/bin/rtldapimport
@@ -17,10 +17,12 @@ my ($debug,$import,$help);
use Getopt::Long;
GetOptions ( "debug" => \$debug, "help" => \$help, "import" => \$import );
if ($help) {
- print "$0: [--debug] [--import] [--help]\n";
- print " --help This usage statement.\n";
- print " --debug Enable debugging.\n";
- print " --import Do the import.\n";
+ print <<USAGE;
+$0: [--debug] [--import] [--help]\n";
+ --help This usage statement.\n";
+ --debug Enable debugging.\n";
+ --import Do the import.\n";
+USAGE
exit 0;
}
commit eab8af697c174f736d04dd5dc11508cfd74d1529
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Tue Jul 13 13:21:23 2010 -0400
Refactoring away loading of an RT user object
diff --git a/lib/RT/Extension/LDAPImport.pm b/lib/RT/Extension/LDAPImport.pm
index f8ecba2..c17c5ad 100644
--- a/lib/RT/Extension/LDAPImport.pm
+++ b/lib/RT/Extension/LDAPImport.pm
@@ -274,12 +274,7 @@ sub create_rt_user {
my %args = @_;
my $user = $args{user};
- my $user_obj = RT::User->new($RT::SystemUser);
-
- $user_obj->Load( $user->{Name} );
- unless ($user_obj->Id) {
- $user_obj->LoadByEmail( $user->{EmailAddress} );
- }
+ my $user_obj = $self->_load_rt_user(%args);
if ($user_obj->Id) {
my $message = "User $user->{Name} already exists as ".$user_obj->Id;
@@ -307,6 +302,21 @@ sub create_rt_user {
}
+sub _load_rt_user {
+ my $self = shift;
+ my %args = @_;
+ my $user = $args{user};
+
+ my $user_obj = RT::User->new($RT::SystemUser);
+
+ $user_obj->Load( $user->{Name} );
+ unless ($user_obj->Id) {
+ $user_obj->LoadByEmail( $user->{EmailAddress} );
+ }
+
+ return $user_obj;
+}
+
=head2 add_user_to_group
Adds new users to the group specified in the $LDAPGroupName
commit 24e2f67fa4ab4db6c52d2ab0314d809ce2911a36
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Tue Jul 13 13:33:48 2010 -0400
Refactor this, show is going to get more complex
diff --git a/lib/RT/Extension/LDAPImport.pm b/lib/RT/Extension/LDAPImport.pm
index c17c5ad..29d852b 100644
--- a/lib/RT/Extension/LDAPImport.pm
+++ b/lib/RT/Extension/LDAPImport.pm
@@ -156,17 +156,48 @@ sub import_users {
next;
}
if ($args{import}) {
- $self->_debug("Processing user $user->{Name}");
- my $user_obj = $self->create_rt_user( user => $user );
- $self->add_user_to_group( user => $user_obj );
- $self->add_custom_field_value( user => $user_obj, ldap_entry => $entry );
+ $self->_import_user( user => $user, ldap_entry => $entry );
} else {
- print "Found user $user->{Name}\n";
- $self->_debug(Dumper($user));
+ $self->_show_user( user => $user );
}
}
}
+=head2 _import_user
+
+The user has run us with --import, so bring data in
+
+=cut
+
+sub _import_user {
+ my $self = shift;
+ my %args = @_;
+ my $user = $args{user};
+ my $ldap_entry = $args{ldap_entry};
+
+ $self->_debug("Processing user $user->{Name}");
+ my $user_obj = $self->create_rt_user( user => $user );
+ $self->add_user_to_group( user => $user_obj );
+ $self->add_custom_field_value( user => $user_obj, ldap_entry => $ldap_entry );
+ return;
+}
+
+=head2 _show_user
+
+Show debugging information about the user record we're going to import
+when the users reruns us with --import
+
+=cut
+
+sub _show_user {
+ my $self = shift;
+ my %args = @_;
+ my $user = $args{user};
+
+ print "Found user $user->{Name}\n";
+ $self->_debug(Dumper($user));
+}
+
=head2 _check_ldap_mapping
Returns true is there is an LDAPMapping configured,
commit f7156841f7e36166163cffed5d3c4f8033e9772b
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Tue Jul 13 16:08:37 2010 -0400
document --import
diff --git a/README b/README
index 3425e28..2d741a5 100644
--- a/README
+++ b/README
@@ -76,8 +76,13 @@ If RT is not installed in /opt/rt3, you will need to change the
use lib '/opt/rt3/lib';
line in rtldapimport to point to the directory where RT.pm can be found
-executing rtldapimport will run the import
-It is recommended that you make a database backup before doing so
+executing rtldapimport will run a test that connects to your LDAP server
+and prints out a list of the users found. To see more about these users,
+include the --debug flag.
+
+executing rtldapimport with the --import flag will cause it to import
+users into your RT database. It is recommended that you make a database
+backup before doing this.
rtldapimport can be run with a --debug flag that will make it
print a lot of information to the screen.
commit b0f13d08961c4ede554238567e9c7095300bd640
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Tue Jul 13 16:09:04 2010 -0400
Add a new feature so you can avoid adding users to a 'default' group
diff --git a/README b/README
index 2d741a5..fadc211 100644
--- a/README
+++ b/README
@@ -63,6 +63,9 @@ All new users will belong to the 'Imported from LDAP' group
You can change the name of this group using the $LDAPGroupName
variable
Set($LDAPGroupName,'Imported Users');
+If you would like to prevent users from being added to any
+additional groups, you can set this to true:
+ Set($LDAPSkipAutogeneratedGroup, 1);
Should we update existing users (optional)
By default, existing users are skipped. If you
diff --git a/lib/RT/Extension/LDAPImport.pm b/lib/RT/Extension/LDAPImport.pm
index 29d852b..d47318a 100644
--- a/lib/RT/Extension/LDAPImport.pm
+++ b/lib/RT/Extension/LDAPImport.pm
@@ -360,6 +360,8 @@ sub add_user_to_group {
my %args = @_;
my $user = $args{user};
+ return if $RT::LDAPSkipAutogeneratedGroup;
+
my $group = $self->_group||$self->setup_group;
my $principal = $user->PrincipalObj;
commit 32edc7060ecc1445995ac3132c2c2b12c7f044dc
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Tue Jul 13 16:18:52 2010 -0400
Handle updating only existing users
Needs better refactoring of the show/create methods now that
we have so many conditionals
diff --git a/README b/README
index fadc211..1684ba4 100644
--- a/README
+++ b/README
@@ -73,6 +73,13 @@ turn on LDAPUpdateUsers, we will clobber existing
data with data from LDAP.
Set($LDAPUpdateUsers,1);
+Should we import new users or just update existing ones?
+By default, we create users who don't exist in RT but do
+match your LDAP filter and obey $LDAPUpdateUsers for existing
+users. This setting overrides $LDAPUpdateUsers but skips users
+who can't be found in RT.
+ Set($LDAPUpdateOnly,1);
+
RUNNING THE IMPORT
If RT is not installed in /opt/rt3, you will need to change the
diff --git a/lib/RT/Extension/LDAPImport.pm b/lib/RT/Extension/LDAPImport.pm
index d47318a..6a5eaa1 100644
--- a/lib/RT/Extension/LDAPImport.pm
+++ b/lib/RT/Extension/LDAPImport.pm
@@ -177,6 +177,7 @@ sub _import_user {
$self->_debug("Processing user $user->{Name}");
my $user_obj = $self->create_rt_user( user => $user );
+ return unless $user_obj;
$self->add_user_to_group( user => $user_obj );
$self->add_custom_field_value( user => $user_obj, ldap_entry => $ldap_entry );
return;
@@ -194,8 +195,46 @@ sub _show_user {
my %args = @_;
my $user = $args{user};
- print "Found user $user->{Name}\n";
- $self->_debug(Dumper($user));
+ my $rt_user = $self->_load_rt_user(%args);
+
+ if ( $rt_user->Id ) {
+ if ( $RT::LDAPUpdateUsers || $RT::LDAPUpdateOnly ) {
+ print "Found existing user $user->{Name} to update\n";
+ $self->_show_user_info( %args, rt_user => $rt_user );
+ } else {
+ print "Found existing user $user->{Name} skipping\n";
+ }
+ } else {
+ if ( $RT::LDAPUpdateOnly ) {
+ print "$user->{Name} doesn't exist in RT, skipping\n";
+ } else {
+ print "Found new user $user->{Name} to create in RT\n";
+ $self->_show_user_info( %args );
+ }
+ }
+}
+
+sub _show_user_info {
+ my $self = shift;
+ my %args = @_;
+ my $user = $args{user};
+ my $rt_user = $args{rt_user};
+
+ return unless $self->screendebug;
+
+ print "\tRT Field\tRT Value -> LDAP Value\n";
+ foreach my $key (sort keys %$user) {
+ my $old_value;
+ if ($rt_user) {
+ eval { $old_value = $rt_user->$key() };
+ if ($user->{$key} && $old_value eq $user->{$key}) {
+ $old_value = 'unchanged';
+ }
+ }
+ $old_value ||= 'unset';
+ print "\t$key\t$old_value => $user->{$key}\n";
+ }
+ #$self->_debug(Dumper($user));
}
=head2 _check_ldap_mapping
@@ -298,6 +337,9 @@ If the $LDAPUpdateUsers variable is true, data in RT
will be clobbered with data in LDAP. Otherwise we
will skip to the next user.
+If $LDAPUpdateOnly is true, we will not create new users
+but we will update existing ones.
+
=cut
sub create_rt_user {
@@ -309,21 +351,28 @@ sub create_rt_user {
if ($user_obj->Id) {
my $message = "User $user->{Name} already exists as ".$user_obj->Id;
- if ($RT::LDAPUpdateUsers) {
+ if ($RT::LDAPUpdateUsers || $RT::LDAPUpdateOnly) {
$self->_debug("$message, updating their data");
my @results = $user_obj->Update( ARGSRef => $user, AttributesRef => [keys %$user] );
- $self->_debug(join(':', at results||'no change'));
+ $self->_debug(join("\n", at results)||'no change');
} else {
$self->_debug("$message, skipping");
}
- } else {
- my ($val, $msg) = $user_obj->Create( %$user, Privileged => 0 );
+ }
- unless ($val) {
- $self->_error("couldn't create user_obj for $user->{Name}: $msg");
+ if ( !$user_obj->Id ) {
+ if ( $RT::LDAPUpdateOnly ) {
+ $self->_debug("User $user->{Name} doesn't exist in RT, skipping");
return;
+ } else {
+ my ($val, $msg) = $user_obj->Create( %$user, Privileged => 0 );
+
+ unless ($val) {
+ $self->_error("couldn't create user_obj for $user->{Name}: $msg");
+ return;
+ }
+ $self->_debug("Created user for $user->{Name} with id ".$user_obj->Id);
}
- $self->_debug("Created user for $user->{Name} with id ".$user_obj->Id);
}
unless ($user_obj->Id) {
commit 4366979f4517df068c96f20ece9c6773a1d41c2b
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Tue Jul 13 16:25:15 2010 -0400
Rename to use a suffix
This makes it a lot easier to avoid shipping a substituted file
and makes git less angry about always-modified files
diff --git a/.gitignore b/.gitignore
index c224ce3..2e169e9 100644
--- a/.gitignore
+++ b/.gitignore
@@ -12,3 +12,5 @@ pod2htm*.tmp
RT-Extension-LDAPImport-*
META.yml
*.swp
+rtldapimport
+*.bak
diff --git a/INSTALL.SKIP b/INSTALL.SKIP
new file mode 100644
index 0000000..7db3e3a
--- /dev/null
+++ b/INSTALL.SKIP
@@ -0,0 +1 @@
+bin/rtldapimport.in
diff --git a/MANIFEST b/MANIFEST
index e5ccd41..5938f45 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1,4 +1,3 @@
-bin/rtldapimport
Changes
inc/Module/Install.pm
inc/Module/Install/Base.pm
@@ -10,9 +9,11 @@ inc/Module/Install/RTx.pm
inc/Module/Install/Substitute.pm
inc/Module/Install/Win32.pm
inc/Module/Install/WriteAll.pm
+INSTALL.SKIP
lib/RT/Extension/LDAPImport.pm
Makefile.PL
MANIFEST
+MANIFEST.SKIP
META.yml # Will be created by "make dist"
README
t/00.load.t
diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP
new file mode 100644
index 0000000..0dcad9d
--- /dev/null
+++ b/MANIFEST.SKIP
@@ -0,0 +1,37 @@
+
+#!start included /opt/local/lib/perl5/5.8.9/ExtUtils/MANIFEST.SKIP
+# Avoid version control files.
+\bRCS\b
+\bCVS\b
+\bSCCS\b
+,v$
+\B\.svn\b
+\B\.git\b
+\B\.gitignore\b
+\b_darcs\b
+
+# Avoid Makemaker generated and utility files.
+\bMANIFEST\.bak
+\bMakefile$
+\bblib/
+\bMakeMaker-\d
+\bpm_to_blib\.ts$
+\bpm_to_blib$
+\bblibdirs\.ts$ # 6.18 through 6.25 generated this
+
+# Avoid Module::Build generated and utility files.
+\bBuild$
+\b_build/
+
+# Avoid temp and backup files.
+~$
+\.old$
+\#$
+\b\.#
+\.bak$
+
+# Avoid Devel::Cover files.
+\bcover_db\b
+#!end included /opt/local/lib/perl5/5.8.9/ExtUtils/MANIFEST.SKIP
+
+bin/rtldapimport
diff --git a/Makefile.PL b/Makefile.PL
index b61e57d..6bb2942 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -17,6 +17,9 @@ substitute(
{
RT_LIB_PATH => $lib_path,
},
+ {
+ sufix => '.in'
+ },
qw(bin/rtldapimport),
);
diff --git a/bin/rtldapimport b/bin/rtldapimport.in
similarity index 100%
rename from bin/rtldapimport
rename to bin/rtldapimport.in
commit ce9afc8ebce993d0718ceebe03192351e2285973
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Tue Jul 13 16:20:45 2010 -0400
bump version
diff --git a/META.yml b/META.yml
index 8c8f13b..807c999 100644
--- a/META.yml
+++ b/META.yml
@@ -25,4 +25,4 @@ requires:
Test::More: 0
resources:
license: http://dev.perl.org/licenses/
-version: 0.07
+version: 0.20_01
diff --git a/lib/RT/Extension/LDAPImport.pm b/lib/RT/Extension/LDAPImport.pm
index 6a5eaa1..b31f6e1 100644
--- a/lib/RT/Extension/LDAPImport.pm
+++ b/lib/RT/Extension/LDAPImport.pm
@@ -1,6 +1,6 @@
package RT::Extension::LDAPImport;
-our $VERSION = '0.07';
+our $VERSION = '0.20_01';
use warnings;
use strict;
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list